diff options
Diffstat (limited to 'compiler')
187 files changed, 58769 insertions, 27928 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 f79210dd7..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, msgs + ast, astalgo, types, trees + +import std/intsets + +when defined(nimPreviewSlimSystem): + import std/assertions type TAnalysisResult* = enum @@ -22,17 +27,17 @@ proc isPartOfAux(n: PNode, b: PType, marker: var IntSet): TAnalysisResult = result = arNo case n.kind of nkRecList: - for i in countup(0, sonsLen(n) - 1): - result = isPartOfAux(n.sons[i], b, marker) + for i in 0..<n.len: + result = isPartOfAux(n[i], b, marker) if result == arYes: return of nkRecCase: - assert(n.sons[0].kind == nkSym) - result = isPartOfAux(n.sons[0], b, marker) + assert(n[0].kind == nkSym) + result = isPartOfAux(n[0], b, marker) if result == arYes: return - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind + for i in 1..<n.len: + case n[i].kind of nkOfBranch, nkElse: - result = isPartOfAux(lastSon(n.sons[i]), b, marker) + result = isPartOfAux(lastSon(n[i]), b, marker) if result == arYes: return else: discard "isPartOfAux(record case branch)" of nkSym: @@ -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.sons[0] != nil: - result = isPartOfAux(a.sons[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 countup(0, sonsLen(a) - 1): - result = isPartOfAux(a.sons[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,9 +118,11 @@ 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 len(a) >= 2 and len(b) >= 2: + if a.len >= 2 and b.len >= 2: # array accesses: if result == arYes and isDeepConstExpr(a[1]) and isDeepConstExpr(b[1]): # we know it's the same array and we have 2 constant indexes; @@ -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: @@ -186,4 +203,16 @@ proc isPartOf*(a, b: PNode): TAnalysisResult = if res != arNo: result = res if res == arYes: break - else: discard + of nkCallKinds: + result = arNo + for i in 1..<b.len: + let res = isPartOf(a, b[i]) + if res != arNo: + result = res + if res == arYes: break + of nkBracket: + if b.len > 0: + result = isPartOf(a, b[0]) + else: + result = arNo + else: result = arNo diff --git a/compiler/ast.nim b/compiler/ast.nim index 40c1b064d..a342e1ea7 100644 --- a/compiler/ast.nim +++ b/compiler/ast.nim @@ -10,224 +10,38 @@ # abstract syntax tree + symbol table import - lineinfos, hashes, nversion, options, strutils, std / sha1, ropes, idents, - intsets, idgen + lineinfos, options, ropes, idents, int128, wordrecg -type - TCallingConvention* = enum - ccDefault, # proc has no explicit calling convention - ccStdCall, # procedure is stdcall - ccCDecl, # cdecl - ccSafeCall, # safecall - ccSysCall, # system call - ccInline, # proc should be inlined - ccNoInline, # proc should not be inlined - ccFastCall, # fastcall (pass parameters in registers) - ccClosure, # proc has a closure - ccNoConvention # needed for generating proper C procs sometimes +import std/[tables, hashes] +from std/strutils import toLowerAscii -const - CallingConvToStr*: array[TCallingConvention, string] = ["", "stdcall", - "cdecl", "safecall", "syscall", "inline", "noinline", "fastcall", - "closure", "noconv"] +when defined(nimPreviewSlimSystem): + import std/assertions + +export int128 + +import nodekinds +export nodekinds 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 allowe 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 - nkReturnToken, # token used for interpretation - 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 + TCallingConvention* = enum + ccNimCall = "nimcall" # nimcall, also the default + ccStdCall = "stdcall" # procedure is stdcall + ccCDecl = "cdecl" # cdecl + ccSafeCall = "safecall" # safecall + ccSysCall = "syscall" # system call + ccInline = "inline" # proc should be inlined + ccNoInline = "noinline" # proc should not be inlined + ccFastCall = "fastcall" # fastcall (pass parameters in registers) + ccThisCall = "thiscall" # thiscall (parameters are pushed right-to-left) + ccClosure = "closure" # proc has a closure + ccNoConvention = "noconv" # needed for generating proper C procs sometimes + ccMember = "member" # proc is a (cpp) member TNodeKinds* = set[TNodeKind] type - TSymFlag* = enum # already 33 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 @@ -236,8 +50,11 @@ type sfGlobal, # symbol is at global scope sfForward, # symbol is forward declared + sfWasForwarded, # symbol had a forward declaration + # (implies it's too dangerous to patch its type signature) sfImportc, # symbol is external; imported sfExportc, # symbol is exported (under a specified name) + sfMangleCpp, # mangle as cpp (combines with `sfExportc`) sfVolatile, # variable is volatile sfRegister, # variable should be placed in a register sfPure, # object is "pure" that means it has no type-information @@ -252,14 +69,20 @@ 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 sfExplain, # provide more diagnostics when this symbol is used sfError, # usage of symbol should trigger a compile-time error sfShadowed, # a symbol that was shadowed in some inner scope sfThread, # proc will run as a thread # variable is a thread variable + sfCppNonPod, # tells compiler to treat such types as non-pod's, so that + # `thread_local` is used instead of `__thread` for + # {.threadvar.} + `--threads`. Only makes sense for importcpp types. + # This has a performance impact so isn't set by default. sfCompileTime, # proc can be evaluated at compile time sfConstructor, # proc is a C++ constructor sfDispatcher, # copied method symbol is the dispatcher @@ -270,29 +93,58 @@ 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 overriden + sfOverridden, # proc is overridden + sfCallsite # A flag for template symbols to tell the + # compiler it should use line information from + # the calling side of the macro, not from the + # implementation. sfGenSym # symbol is 'gensym'ed; do not add to symbol table + sfNonReloadable # symbol will be left as-is when hot code reloading is on - + # meaning that it won't be renamed and/or changed in any way + sfGeneratedOp # proc is a generated '='; do not inject destructors in it + # variable is generated closure environment; requires early + # destruction for --newruntime. + sfTemplateParam # symbol is a template parameter + sfCursor # variable/field is a cursor, see RFC 177 for details + sfInjectDestructors # whether the proc needs the 'injectdestructors' transformation + sfNeverRaises # proc can never raise an exception, not even OverflowDefect + # or out-of-memory + sfSystemRaisesDefect # proc in the system can raise defects + sfUsedInFinallyOrExcept # symbol is used inside an 'except' or 'finally' + sfSingleUsedTemp # For temporaries that we know will only be used once + sfNoalias # 'noalias' annotation, means C's 'restrict' + # for templates and macros, means cannot be called + # as a lone symbol (cannot use alias syntax) + sfEffectsDelayed # an 'effectsDelayed' parameter + sfGeneratedType # A anonymous generic type that is generated by the compiler for + # objects that do not have generic parameters in case one of the + # object fields has one. + # + # This is disallowed but can cause the typechecking to go into + # an infinite loop, this flag is used as a sentinel to stop it. + sfVirtual # proc is a C++ virtual function + sfByCopy # param is marked as pass bycopy + sfMember # proc is a C++ member of a type + sfCodegenDecl # type, proc, global or proc param is marked as codegenDecl + sfWasGenSym # symbol was 'gensym'ed + sfForceLift # variable has to be lifted into closure environment + + sfDirty # template is not hygienic (old styled template) module, + # compiled from a dirty-buffer + sfCustomPragma # symbol is custom pragma template + sfBase, # a base method + sfGoto # var is used for 'goto' code generation + sfAnon, # symbol name that was generated by the compiler + # the compiler will avoid printing such names + # in user messages. + sfAllUntyped # macro or template is immediately expanded in a generic context + sfTemplateRedefinition # symbol is a redefinition of an earlier template TSymFlags* = set[TSymFlag] const sfNoInit* = sfMainModule # don't generate code to init the variable - sfImmediate* = sfDispatcher - # macro or template is immediately expanded - # without considering any possible overloads - 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 @@ -300,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 @@ -315,10 +164,14 @@ const nkEffectList* = nkArgList # hacks ahead: an nkEffectList is a node with 4 children: exceptionEffects* = 0 # exceptions at position 0 - usesEffects* = 1 # read effects at position 1 - writeEffects* = 2 # write effects at position 2 + requiresEffects* = 1 # 'requires' annotation + ensuresEffects* = 2 # 'ensures' annotation tagEffects* = 3 # user defined tag ('gc', 'time' etc.) - effectListLen* = 4 # list of effects list + pragmasEffects* = 4 # not an effect, but a slot for pragmas in proc type + forbiddenEffects* = 5 # list of illegal effects + effectListLen* = 6 # list of effects list + nkLastBlockStmts* = {nkRaiseStmt, nkReturnStmt, nkBreakStmt, nkContinueStmt} + # these must be last statements in a block type TTypeKind* = enum # order is important! @@ -329,7 +182,7 @@ type # (apparently something with bootstrapping) # if you need to add a type, they can apparently be reused tyNone, tyBool, tyChar, - tyEmpty, tyAlias, tyNil, tyExpr, tyStmt, tyTypeDesc, + tyEmpty, tyAlias, tyNil, tyUntyped, tyTyped, tyTypeDesc, tyGenericInvocation, # ``T[a, b]`` for types to invoke tyGenericBody, # ``T[a, b, body]`` last parameter is the body tyGenericInst, # ``T[a, b, realInstance]`` instantiated generic type @@ -352,14 +205,17 @@ 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, - tyOptAsRef, tySink, tyLent, + tyOwned, tySink, tyLent, tyVarargs, - tyUnused, - tyProxy # used as errornous type (for idetools) + tyUncheckedArray + # An array with boundaries [0,+∞] + + tyError # used as erroneous type (for idetools) + # as an erroneous node should match everything tyBuiltInTypeClass # Type such as the catch-all object, tuple, seq, etc @@ -384,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 @@ -406,30 +262,33 @@ type # instantiation and prior to this it has the potential to # be any type. - tyOpt - # Builtin optional type + tyConcept + # new style concept. tyVoid # now different from tyEmpty, hurray! + tyIterable static: # remind us when TTypeKind stops to fit in a single 64-bit word - assert TTypeKind.high.ord <= 63 + # assert TTypeKind.high.ord <= 63 + discard const tyPureObject* = tyTuple GcTypeKinds* = {tyRef, tySequence, tyString} - tyError* = tyProxy # as an errornous node should match everything - tyUnknown* = tyFromExpr - - tyUnknownTypes* = {tyError, tyFromExpr} tyTypeClasses* = {tyBuiltInTypeClass, tyCompositeTypeClass, tyUserTypeClass, tyUserTypeClassInst, tyAnd, tyOr, tyNot, tyAnything} - tyMetaTypes* = {tyGenericParam, tyTypeDesc, tyExpr} + tyTypeClasses + tyMetaTypes* = {tyGenericParam, tyTypeDesc, tyUntyped} + tyTypeClasses tyUserTypeClasses* = {tyUserTypeClass, tyUserTypeClassInst} + # consider renaming as `tyAbstractVarRange` + abstractVarRange* = {tyGenericInst, tyRange, tyVar, tyDistinct, tyOrdinal, + tyTypeDesc, tyAlias, tyInferred, tySink, tyOwned} + abstractInst* = {tyGenericInst, tyDistinct, tyOrdinal, tyTypeDesc, tyAlias, + tyInferred, tySink, tyOwned} # xxx what about tyStatic? type TTypeKinds* = set[TTypeKind] @@ -451,18 +310,30 @@ type nfExplicitCall # x.y() was used instead of x.y nfExprCall # this is an attempt to call a regular expression nfIsRef # this node is a 'ref' node; used for the VM + nfIsPtr # this node is a 'ptr' node; used for the VM nfPreventCg # this node should be ignored by the codegen nfBlockArg # this a stmtlist appearing in a call (e.g. a do block) nfFromTemplate # a top-level node returned from a template + nfDefaultParam # an automatically inserter default parameter + nfDefaultRefsParam # a default param value references another parameter + # the flag is applied to proc default values and to calls + nfExecuteOnReload # A top-level statement that will be executed during reloads + nfLastRead # this node is a last read + nfFirstWrite # this node is a first write + nfHasComment # node has a comment + nfSkipFieldChecking # node skips field visable checking + nfDisabledOpenSym # temporary: node should be nkOpenSym but cannot + # because openSym experimental switch is disabled + # gives warning instead TNodeFlags* = set[TNodeFlag] - TTypeFlag* = enum # keep below 32 for efficiency reasons (now: beyond that) + TTypeFlag* = enum # keep below 32 for efficiency reasons (now: 47) tfVarargs, # procedure has C styled varargs # tyArray type represeting a varargs list tfNoSideEffect, # procedure type does not allow side effects tfFinal, # is the object final? tfInheritable, # is the object inheritable? - tfAcyclic, # type is acyclic (for GC optimization) + tfHasOwned, # type contains an 'owned' type and must be moved tfEnumHasHoles, # enum cannot be mapped into a range tfShallow, # type can be shallow copied on assignment tfThread, # proc type is marked as ``thread``; alias for ``gcsafe`` @@ -486,9 +357,11 @@ type tfIterator, # type is really an iterator, not a tyProc tfPartial, # type is declared as 'partial' tfNotNil, # type cannot be 'nil' - - tfNeedsInit, # type constains a "not nil" constraint somewhere or some - # other type so that it requires initialization + tfRequiresInit, # type contains a "not nil" constraint somewhere or + # a `requiresInit` field, so the default zero init + # is not appropriate + tfNeedsFullInit, # object type marked with {.requiresInit.} + # all fields must be initialized tfVarIsPtr, # 'var' type is translated like 'ptr' even in C++ mode tfHasMeta, # type contains "wildcard" sub-types such as generic params # or other type classes @@ -498,6 +371,7 @@ type tfGenericTypeParam tfImplicitTypeParam tfInferrableStatic + tfConceptMatchedTypeSym tfExplicit # for typedescs, marks types explicitly prefixed with the # `type` operator (e.g. type int) tfWildcard # consider a proc like foo[T, I](x: Type[T, I]) @@ -509,9 +383,22 @@ type tfTriggersCompileTime # uses the NimNode type which make the proc # implicitly '.compiletime' tfRefsAnonObj # used for 'ref object' and 'ptr object' - tfCovariant # covariant generic param mimicing a ptr type - tfWeakCovariant # covariant generic param mimicing a seq/array type + tfCovariant # covariant generic param mimicking a ptr type + tfWeakCovariant # covariant generic param mimicking a seq/array type tfContravariant # contravariant generic param + tfCheckedForDestructor # type was checked for having a destructor. + # If it has one, t.destructor is not nil. + tfAcyclic # object type was annotated as .acyclic + tfIncompleteStruct # treat this type as if it had sizeof(pointer) + tfCompleteStruct + # (for importc types); type is fully specified, allowing to compute + # sizeof, alignof, offsetof at CT + tfExplicitCallConv + tfIsConstructor + tfEffectSystemWorkaround + tfIsOutParam + tfSendable + tfImplicitStatic TTypeFlags* = set[TTypeFlag] @@ -547,91 +434,86 @@ 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} - tfIncompleteStruct* = tfVarargs - tfUncheckedArray* = tfVarargs + ExportableSymKinds* = {skVar, skLet, skConst, skType, skEnumField, skStub} + routineKinds + tfUnion* = tfNoSideEffect tfGcSafe* = tfThread tfObjHasKids* = tfEnumHasHoles - tfOldSchoolExprStmt* = tfVarargs # for now used to distinguish \ - # 'varargs[expr]' from 'varargs[untyped]'. Eventually 'expr' will be - # deprecated and this mess can be cleaned up. tfReturnsNew* = tfInheritable + tfNonConstExpr* = tfExplicitCallConv + ## tyFromExpr where the expression shouldn't be evaluated as a static value skError* = skUnknown - # type flags that are essential for type equality: - eqTypeFlags* = {tfIterator, tfNotNil, tfVarIsPtr} +var + eqTypeFlags* = {tfIterator, tfNotNil, tfVarIsPtr, tfGcSafe, tfNoSideEffect, tfIsOutParam} + ## type flags that are essential for type equality. + ## This is now a variable because for emulation of version:1.0 we + ## might exclude {tfGcSafe, tfNoSideEffect}. type TMagic* = enum # symbols that require compiler magic: mNone, - mDefined, mDefinedInScope, mCompiles, mArrGet, mArrPut, mAsgn, - mLow, mHigh, mSizeOf, mTypeTrait, mIs, mOf, mAddr, mTypeOf, mRoof, mPlugin, - mEcho, mShallowCopy, mSlurp, mStaticExec, + mDefined, mDeclared, mDeclaredInScope, mCompiles, mArrGet, mArrPut, mAsgn, + mLow, mHigh, mSizeOf, mAlignOf, mOffsetOf, mTypeTrait, + mIs, mOf, mAddr, mType, mTypeOf, + mPlugin, mEcho, mShallowCopy, mSlurp, mStaticExec, mStatic, mParseExprToAst, mParseStmtToAst, mExpandToAst, mQuoteAst, - mUnaryLt, mInc, mDec, mOrd, + mInc, mDec, mOrd, mNew, mNewFinalize, mNewSeq, mNewSeqOfCap, mLengthOpenArray, mLengthStr, mLengthArray, mLengthSeq, - mXLenStr, mXLenSeq, mIncl, mExcl, mCard, mChr, mGCref, mGCunref, mAddI, mSubI, mMulI, mDivI, mModI, mSucc, mPred, mAddF64, mSubF64, mMulF64, mDivF64, - mShrI, mShlI, mBitandI, mBitorI, mBitxorI, + mShrI, mShlI, mAshrI, mBitandI, mBitorI, mBitxorI, mMinI, mMaxI, - mMinF64, mMaxF64, mAddU, mSubU, mMulU, mDivU, mModU, mEqI, mLeI, mLtI, mEqF64, mLeF64, mLtF64, mLeU, mLtU, - mLeU64, mLtU64, mEqEnum, mLeEnum, mLtEnum, mEqCh, mLeCh, mLtCh, mEqB, mLeB, mLtB, - mEqRef, mEqUntracedRef, mLePtr, mLtPtr, + mEqRef, mLePtr, mLtPtr, mXor, mEqCString, mEqProc, mUnaryMinusI, mUnaryMinusI64, mAbsI, mNot, mUnaryPlusI, mBitnotI, - mUnaryPlusF64, mUnaryMinusF64, mAbsF64, - mZe8ToI, mZe8ToI64, - mZe16ToI, mZe16ToI64, - mZe32ToI64, mZeIToI64, - mToU8, mToU16, mToU32, - mToFloat, mToBiggestFloat, - mToInt, mToBiggestInt, - mCharToStr, mBoolToStr, mIntToStr, mInt64ToStr, mFloatToStr, mCStrToStr, + mUnaryPlusF64, mUnaryMinusF64, + mCharToStr, mBoolToStr, + mCStrToStr, mStrToStr, mEnumToStr, mAnd, mOr, + mImplies, mIff, mExists, mForall, mOld, mEqStr, mLeStr, mLtStr, - mEqSet, mLeSet, mLtSet, mMulSet, mPlusSet, mMinusSet, mSymDiffSet, + mEqSet, mLeSet, mLtSet, mMulSet, mPlusSet, mMinusSet, mConStrStr, mSlice, mDotDot, # this one is only necessary to give nice compile time warnings mFields, mFieldPairs, mOmpParFor, mAppendStrCh, mAppendStrStr, mAppendSeqElem, - mInRange, mInSet, mRepr, mExit, + mInSet, mRepr, mExit, mSetLengthStr, mSetLengthSeq, mIsPartOf, mAstToStr, mParallel, - mSwap, mIsNil, mArrToSeq, mCopyStr, mCopyStrLast, + mSwap, mIsNil, mArrToSeq, mOpenArrayToSeq, mNewString, mNewStringOfCap, mParseBiggestFloat, - mReset, - mArray, mOpenArray, mRange, mSet, mSeq, mOpt, mVarargs, + 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, mBool, mChar, mString, mCstring, - mPointer, mEmptySet, mIntSetBaseType, mNil, mExpr, mStmt, mTypeDesc, - mVoidType, mPNimrodNode, mShared, mGuarded, mLock, mSpawn, mDeepCopy, + mPointer, mNil, mExpr, mStmt, mTypeDesc, + mVoidType, mPNimrodNode, mSpawn, mDeepCopy, mIsMainModule, mCompileDate, mCompileTime, mProcCall, mCpuEndian, mHostOS, mHostCPU, mBuildOS, mBuildCPU, mAppType, - mNaN, mInf, mNegInf, mCompileOption, mCompileOptionArg, mNLen, mNChild, mNSetChild, mNAdd, mNAddMultiple, mNDel, mNKind, mNSymKind, @@ -640,57 +522,66 @@ type mNctPut, mNctLen, mNctGet, mNctHasNext, mNctNext, mNIntVal, mNFloatVal, mNSymbol, mNIdent, mNGetType, mNStrVal, mNSetIntVal, - mNSetFloatVal, mNSetSymbol, mNSetIdent, mNSetType, mNSetStrVal, mNLineInfo, - mNNewNimNode, mNCopyNimNode, mNCopyNimTree, mStrToIdent, - mNBindSym, mLocals, mNCallSite, + mNSetFloatVal, mNSetSymbol, mNSetIdent, mNSetStrVal, mNLineInfo, + mNNewNimNode, mNCopyNimNode, mNCopyNimTree, mStrToIdent, mNSigHash, mNSizeOf, + mNBindSym, mNCallSite, mEqIdent, mEqNimrodNode, mSameNodeType, mGetImpl, mNGenSym, mNHint, mNWarning, mNError, - mInstantiationInfo, mGetTypeInfo, - mNimvm, mIntDefine, mStrDefine, mRunnableExamples, - mException, mBuiltinType + mInstantiationInfo, mGetTypeInfo, mGetTypeInfoV2, + mNimvm, mIntDefine, mStrDefine, mBoolDefine, mGenericDefine, mRunnableExamples, + mException, mBuiltinType, mSymOwner, mUncheckedArray, mGetImplTransf, + mSymIsInstantiationOf, mNodeId, mPrivateAccess, mZeroDefault + -# things that we can evaluate safely at compile time, even if not asked for it: const - ctfeWhitelist* = {mNone, mUnaryLt, mSucc, + # 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, mXLenStr, mXLenSeq, - mArrGet, mArrPut, mAsgn, + mLengthStr, mLengthArray, mLengthSeq, + mArrGet, mArrPut, mAsgn, mDestroy, mIncl, mExcl, mCard, mChr, mAddI, mSubI, mMulI, mDivI, mModI, mAddF64, mSubF64, mMulF64, mDivF64, mShrI, mShlI, mBitandI, mBitorI, mBitxorI, mMinI, mMaxI, - mMinF64, mMaxF64, mAddU, mSubU, mMulU, mDivU, mModU, mEqI, mLeI, mLtI, mEqF64, mLeF64, mLtF64, mLeU, mLtU, - mLeU64, mLtU64, mEqEnum, mLeEnum, mLtEnum, mEqCh, mLeCh, mLtCh, mEqB, mLeB, mLtB, - mEqRef, mEqProc, mEqUntracedRef, mLePtr, mLtPtr, mEqCString, mXor, + mEqRef, mEqProc, mLePtr, mLtPtr, mEqCString, mXor, mUnaryMinusI, mUnaryMinusI64, mAbsI, mNot, mUnaryPlusI, mBitnotI, - mUnaryPlusF64, mUnaryMinusF64, mAbsF64, - mZe8ToI, mZe8ToI64, - mZe16ToI, mZe16ToI64, - mZe32ToI64, mZeIToI64, - mToU8, mToU16, mToU32, - mToFloat, mToBiggestFloat, - mToInt, mToBiggestInt, - mCharToStr, mBoolToStr, mIntToStr, mInt64ToStr, mFloatToStr, mCStrToStr, + mUnaryPlusF64, mUnaryMinusF64, + mCharToStr, mBoolToStr, + mCStrToStr, mStrToStr, mEnumToStr, mAnd, mOr, mEqStr, mLeStr, mLtStr, - mEqSet, mLeSet, mLtSet, mMulSet, mPlusSet, mMinusSet, mSymDiffSet, + mEqSet, mLeSet, mLtSet, mMulSet, mPlusSet, mMinusSet, mConStrStr, mAppendStrCh, mAppendStrStr, mAppendSeqElem, - mInRange, mInSet, mRepr, - mCopyStr, mCopyStrLast} - # magics that require special semantic checking and - # thus cannot be overloaded (also documented in the spec!): - SpecialSemMagics* = { - mDefined, mDefinedInScope, mCompiles, mLow, mHigh, mSizeOf, mIs, mOf, - mShallowCopy, mExpandToAst, mParallel, mSpawn, mAstToStr} + mInSet, mRepr, mOpenArrayToSeq} + + generatedMagics* = {mNone, mIsolate, mFinished, mOpenArrayToSeq} + ## magics that are generated as normal procs in the backend + +type + ItemId* = object + module*: int32 + item*: int32 + +proc `$`*(x: ItemId): string = + "(module: " & $x.module & ", item: " & $x.item & ")" + +proc `==`*(a, b: ItemId): bool {.inline.} = + a.item == b.item and a.module == b.module + +proc hash*(x: ItemId): Hash = + var h: Hash = hash(x.module) + h = h !& hash(x.item) + result = !$h + type PNode* = ref TNode @@ -716,12 +607,12 @@ type ident*: PIdent else: sons*: TNodeSeq - comment*: string + when defined(nimsuggest): + endInfo*: TLineInfo - TSymSeq* = seq[PSym] TStrTable* = object # a table[PIdent] of PSym counter*: int - data*: TSymSeq + data*: seq[PSym] # -------------- backend information ------------------------------- TLocKind* = enum @@ -738,9 +629,6 @@ type locOther # location is something other TLocFlag* = enum lfIndirect, # backend introduced a pointer - lfFullExternalName, # only used when 'conf.cmd == cmdPretty': 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 @@ -748,12 +636,14 @@ type lfHeader, # include header file for symbol lfImportCompilerProc, # ``importc`` of a compilerproc lfSingleUse # no location yet and will only be used once + lfEnforceDeref # a copyMem is required to dereference if this a + # ptr array due to C array limitations. + # See #1181, #6422, #11171 + lfPrepareForMutation # string location is about to be mutated (V2) TStorageLoc* = enum OnUnknown, # location is unknown (stack, heap or static) OnStatic, # in a static section OnStack, # location is on hardware stack - OnStackShadowDup, # location is on the stack but also replicated - # on the shadow stack OnHeap # location is on heap or global # (reference counting needed) TLocFlags* = set[TLocFlag] @@ -762,8 +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) - dup*: Rope # duplicated location for precise stack scans + snippet*: Rope # C code snippet of location (code generators) # ---------------- end of backend information ------------------------------ @@ -771,9 +660,10 @@ type libHeader, libDynamic TLib* = object # also misused for headers! + # 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! @@ -787,43 +677,35 @@ 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 + TSym* {.acyclic.} = object # Keep in sync with PackedSym + itemId*: ItemId # proc and type instantiations are cached in the generic symbol case kind*: TSymKind - of skType, skGenericParam: - typeInstCache*: seq[PType] of routineKinds: - procInstCache*: seq[PInstantiation] - gcUnsafetyReason*: PSym # for better error messages wrt gcsafe - #scope*: PScope # the scope where the proc was defined - of skModule, skPackage: - # modules keep track of the generic symbols they use from other modules. - # this is because in incremental compilation, when a module is about to - # be replaced with a newer version, we must decrement the usage count - # of all previously used generics. - # For 'import as' we copy the module symbol but shallowCopy the 'tab' - # and set the 'usedGenerics' to ... XXX gah! Better set module.name - # instead? But this doesn't work either. --> We need an skModuleAlias? - # No need, just leave it as skModule but set the owner accordingly and - # check for the owner when touching 'usedGenerics'. - usedGenerics*: seq[PInstantiation] - tab*: TStrTable # interface table for modules + #procInstCache*: seq[PInstantiation] + gcUnsafetyReason*: PSym # for better error messages regarding gcsafe + transformedBody*: PNode # cached body after transf pass of skLet, skVar, skField, skForVar: guard*: PSym bitsize*: int + alignment*: int # for alignment else: nil magic*: TMagic typ*: PType name*: PIdent info*: TLineInfo + when defined(nimsuggest): + endInfo*: TLineInfo + hasUserSpecifiedType*: bool # used for determining whether to display inlay type hints owner*: PSym flags*: TSymFlags ast*: PNode # syntax tree of proc, iterator, etc.: @@ -838,41 +720,57 @@ type position*: int # used for many different things: # for enum fields its position; # for fields its offset - # for parameters its position + # for parameters its position (starting with 0) # for a conditional: # 1 iff the symbol is defined, else 0 # (or not in symbol table) # for modules, an unique index corresponding # to the module's fileIdx # for variables a slot index for the evaluator - # for routines a superop-ID - 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 safe space) + # reference to another object to save space) + when hasFFI: + cname*: string # resolved C declaration name in importc decl, e.g.: + # proc fun() {.importc: "$1aux".} => cname = funaux constraint*: PNode # additional constraints like 'lit|result'; also - # misused for the codegenDecl pragma in the hope + # 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 - TType* {.acyclic.} = object of TIdObj # \ + + TTypeAttachedOp* = enum ## as usual, order is important here + attachedWasMoved, + attachedDestructor, + attachedAsgn, + attachedDup, + attachedSink, + attachedTrace, + attachedDeepCopy + + TType* {.acyclic.} = object # \ # types are identical iff they have the # same id; there may be multiple copies of a type # in memory! + # Keep in sync with PackedType + itemId*: ItemId kind*: TTypeKind # kind of type callConv*: TCallingConvention # for procs flags*: TTypeFlags # flags of the type - sons*: TTypeSeq # base types, etc. + sons: TTypeSeq # base types, etc. n*: PNode # node for types: # for range types a nkRange node # for record types a nkRecord node # for enum types a list of symbols - # for tyInt it can be the int literal + # if kind == tyInt: it is an 'int literal(x)' type # for procs and tyGenericBody, it's the # formal param list # for concepts, the concept body @@ -880,44 +778,21 @@ type owner*: PSym # the 'owner' of the type sym*: PSym # types have the sym associated with them # it is used for converting types to strings - destructor*: PSym # destructor. warning: nil here may not necessary - # mean that there is no destructor. - # see instantiateDestructor in semdestruct.nim - deepCopy*: PSym # overriden 'deepCopy' operation - assignment*: PSym # overriden '=' operation - sink*: PSym # overriden '=sink' operation - methods*: seq[(int,PSym)] # attached methods size*: BiggestInt # the size of the type in bytes # -1 means that the size is unkwown align*: int16 # the type's alignment requirements - lockLevel*: TLockLevel # lock level as required for deadlock checking + paddingAtEnd*: int16 # loc*: TLoc typeInst*: PType # for generic instantiations the tyGenericInst that led to this # type. + uniqueId*: ItemId # due to a design mistake, we need to keep the real ID here as it + # is required by the --incremental:on mode. TPair* = object key*, val*: RootRef TPairSeq* = seq[TPair] - TIdPair* = 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 @@ -937,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} @@ -957,21 +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} + tyFloat..tyFloat128, tyUInt..tyUInt64} # weird name because it contains tyFloat ConstantDataTypes*: TTypeKinds = {tyArray, tySet, tyTuple, tySequence} - NilableTypes*: TTypeKinds = {tyPointer, tyCString, tyRef, tyPtr, tySequence, - tyProc, tyString, tyError} - ExportableSymKinds* = {skVar, skConst, skProc, skFunc, skMethod, skType, - skIterator, - skMacro, skTemplate, skConverter, skEnumField, skLet, skStub, skAlias} + NilableTypes*: TTypeKinds = {tyPointer, tyCstring, tyRef, tyPtr, + tyProc, tyError} # TODO + PtrLikeKinds*: TTypeKinds = {tyPointer, tyPtr} # for VM PersistentNodeFlags*: TNodeFlags = {nfBase2, nfBase8, nfBase16, nfDotSetter, nfDotField, - nfIsRef, nfPreventCg, nfLL, - nfFromTemplate} + nfIsRef, nfIsPtr, nfPreventCg, nfLL, + nfFromTemplate, nfDefaultRefsParam, + nfExecuteOnReload, nfLastRead, + nfFirstWrite, nfSkipFieldChecking, + nfDisabledOpenSym} namePos* = 0 patternPos* = 1 # empty except for term rewriting macros genericParamsPos* = 2 @@ -980,19 +890,21 @@ const miscPos* = 5 # used for undocumented and hacky stuff bodyPos* = 6 # position of body; use rodread.getBody() instead! resultPos* = 7 - dispatcherPos* = 8 # caution: if method has no 'result' it can be position 7! + dispatcherPos* = 8 + + 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} nkFloatLiterals* = {nkFloatLit..nkFloat128Lit} nkLambdaKinds* = {nkLambda, nkDo} declarativeDefs* = {nkProcDef, nkFuncDef, nkMethodDef, nkIteratorDef, nkConverterDef} + routineDefs* = declarativeDefs + {nkMacroDef, nkTemplateDef} procDefs* = nkLambdaKinds + declarativeDefs + callableDefs* = nkLambdaKinds + routineDefs nkSymChoices* = {nkClosedSymChoice, nkOpenSymChoice} nkStrKinds* = {nkStrLit..nkTripleStrLit} @@ -1001,9 +913,68 @@ const skProcKinds* = {skProc, skFunc, skTemplate, skMacro, skIterator, skMethod, skConverter} + defaultSize = -1 + defaultAlignment = -1 + defaultOffset* = -1 + +proc getPIdent*(a: PNode): PIdent {.inline.} = + ## Returns underlying `PIdent` for `{nkSym, nkIdent}`, or `nil`. + case a.kind + 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: PType | PSym): int = + let x = a + (x.itemId.module.int shl moduleShift) + x.itemId.item.int + +type + IdGenerator* = ref object # unfortunately, we really need the 'shared mutable' aspect here. + module*: int32 + 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, 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.} = + assert(not x.sealed) + inc x.symId + result = ItemId(module: x.module, item: x.symId) + +proc nextTypeId*(x: IdGenerator): ItemId {.inline.} = + assert(not x.sealed) + inc x.typeId + result = ItemId(module: x.module, item: x.typeId) + +when false: + proc nextId*(x: IdGenerator): ItemId {.inline.} = + inc x.item + result = x[] + +when false: + proc storeBack*(dest: var IdGenerator; src: IdGenerator) {.inline.} = + assert dest.ItemId.module == src.ItemId.module + if dest.ItemId.item > src.ItemId.item: + echo dest.ItemId.item, " ", src.ItemId.item, " ", src.ItemId.module + assert dest.ItemId.item <= src.ItemId.item + dest = src + var ggDebug* {.deprecated.}: bool ## convenience switch for trying out things -#var -# gMainPackageId*: int proc isCallExpr*(n: PNode): bool = result = n.kind in nkCallKinds @@ -1011,44 +982,128 @@ proc isCallExpr*(n: PNode): bool = proc discardSons*(father: PNode) proc len*(n: PNode): int {.inline.} = - if isNil(n.sons): result = 0 - else: result = len(n.sons) + result = n.sons.len proc safeLen*(n: PNode): int {.inline.} = ## works even for leaves. - if n.kind in {nkNone..nkNilLit} or isNil(n.sons): result = 0 - else: result = len(n.sons) + if n.kind in {nkNone..nkNilLit}: result = 0 + else: result = n.len proc safeArrLen*(n: PNode): int {.inline.} = ## works for array-like objects (strings passed as openArray in VM). - if n.kind in {nkStrLit..nkTripleStrLit}:result = len(n.strVal) + if n.kind in {nkStrLit..nkTripleStrLit}: result = n.strVal.len elif n.kind in {nkNone..nkFloat128Lit}: result = 0 - else: result = len(n) + else: result = n.len proc add*(father, son: PNode) = assert son != nil - if isNil(father.sons): father.sons = @[] - add(father.sons, son) + father.sons.add(son) + +proc addAllowNil*(father, son: PNode) {.inline.} = + father.sons.add(son) + +template `[]`*(n: PNode, i: int): PNode = n.sons[i] +template `[]=`*(n: PNode, i: int; x: PNode) = n.sons[i] = x + +template `[]`*(n: PNode, i: BackwardsIndex): PNode = n[n.len - i.int] +template `[]=`*(n: PNode, i: BackwardsIndex; x: PNode) = n[n.len - i.int] = x + +proc add*(father, son: PType) = + assert son != nil + father.sons.add(son) -type Indexable = PNode | PType +proc addAllowNil*(father, son: PType) {.inline.} = + father.sons.add(son) -template `[]`*(n: Indexable, i: int): Indexable = n.sons[i] -template `[]=`*(n: Indexable, i: int; x: Indexable) = n.sons[i] = x +template `[]`*(n: PType, i: int): PType = n.sons[i] +template `[]=`*(n: PType, i: int; x: PType) = n.sons[i] = x -template `[]`*(n: Indexable, i: BackwardsIndex): Indexable = n[n.len - i.int] -template `[]=`*(n: Indexable, i: BackwardsIndex; x: Indexable) = n[n.len - i.int] = x +template `[]`*(n: PType, i: BackwardsIndex): PType = n[n.len - i.int] +template `[]=`*(n: PType, i: BackwardsIndex; x: PType) = n[n.len - i.int] = x + +proc getDeclPragma*(n: PNode): PNode = + ## return the `nkPragma` node for declaration `n`, or `nil` if no pragma was found. + ## 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 # 299750 # 300761 #300863 # 300879 + const nodeIdToDebug* = -1 # 2322968 var gNodeId: int -proc newNode*(kind: TNodeKind): PNode = - new(result) - result.kind = kind - #result.info = UnknownLineInfo() inlined: - result.info.fileIndex = InvalidFileIdx - result.info.col = int16(-1) - result.info.line = uint16(0) +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: @@ -1056,32 +1111,107 @@ 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 = + ## new node with line info, no type, and no children + newNodeImpl(info) + setIdMaybe() + +proc newNodeI*(kind: TNodeKind, info: TLineInfo, children: int): PNode = + ## new node with line info, type, and children + newNodeImpl(info) + if children > 0: + newSeq(result.sons, children) + setIdMaybe() + +proc newNodeIT*(kind: TNodeKind, info: TLineInfo, typ: PType): PNode = + ## new node with line info, type, and no children + result = newNode(kind) + result.info = info + result.typ = typ + +proc newNode*(kind: TNodeKind, info: TLineInfo): PNode = + ## new node with line info, no type, and no children + newNodeImpl(info) + setIdMaybe() + +proc newAtom*(ident: PIdent, info: TLineInfo): PNode = + result = newNode(nkIdent, info) + result.ident = ident + +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: result.info = children[0].info result.sons = @children +proc newTreeI*(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 newTreeIT*(kind: TNodeKind; info: TLineInfo; typ: PType; children: varargs[PNode]): PNode = + result = newNodeIT(kind, info, typ) + if children.len > 0: + result.info = children[0].info + 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 -proc newSym*(symKind: TSymKind, name: PIdent, owner: PSym, +when false: + import tables, strutils + var x: CountTable[string] + + addQuitProc proc () {.noconv.} = + for k, v in pairs(x): + echo k + echo v + +proc newSym*(symKind: TSymKind, name: PIdent, idgen: IdGenerator; owner: PSym, info: TLineInfo; options: TOptions = {}): PSym = # generates a symbol and initializes the hash field too - new(result) - result.name = name - result.kind = symKind - result.flags = {} - result.info = info - result.options = options - result.owner = owner - result.offset = -1 - result.id = getID() - when debugIds: - registerId(result) - #if result.id == 93289: - # writeStacktrace() - # MessageOut(name.s & " has id: " & toString(result.id)) + 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, + disamb: getOrDefault(idgen.disambTable, name).int32) + idgen.disambTable.inc name + when false: + if id.module == 48 and id.item == 39: + writeStackTrace() + echo "kind ", symKind, " ", name.s + if owner != nil: echo owner.name.s + +proc astdef*(s: PSym): PNode = + # get only the definition (initializer) portion of the ast + if s.ast != nil and s.ast.kind in {nkIdentDefs, nkConstDef}: + s.ast[2] + else: + s.ast proc isMetaType*(t: PType): bool = return t.kind in tyMetaTypes or @@ -1125,24 +1255,16 @@ const # for all kind of hash tables: proc copyStrTable*(dest: var TStrTable, src: TStrTable) = dest.counter = src.counter - if isNil(src.data): return - setLen(dest.data, len(src.data)) - for i in countup(0, high(src.data)): dest.data[i] = src.data[i] - -proc copyIdTable*(dest: var TIdTable, src: TIdTable) = - dest.counter = src.counter - if isNil(src.data): return - newSeq(dest.data, len(src.data)) - for i in countup(0, high(src.data)): dest.data[i] = src.data[i] + setLen(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 - if isNil(src.data): return - setLen(dest.data, len(src.data)) - for i in countup(0, high(src.data)): dest.data[i] = src.data[i] + setLen(dest.data, src.data.len) + for i in 0..high(src.data): dest.data[i] = src.data[i] proc discardSons*(father: PNode) = - father.sons = nil + father.sons = @[] proc withInfo*(n: PNode, info: TLineInfo): PNode = n.info = info @@ -1165,58 +1287,89 @@ proc newSymNode*(sym: PSym, info: TLineInfo): PNode = result.typ = sym.typ result.info = info -proc newNodeI*(kind: TNodeKind, info: TLineInfo): PNode = - new(result) - result.kind = kind - result.info = info - when defined(useNodeIds): - result.id = gNodeId - if result.id == nodeIdToDebug: - echo "KIND ", result.kind - writeStackTrace() - inc gNodeId - -proc newNodeI*(kind: TNodeKind, info: TLineInfo, children: int): PNode = - new(result) - result.kind = kind - result.info = 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 - -proc newNode*(kind: TNodeKind, info: TLineInfo, sons: TNodeSeq = @[], - typ: PType = nil): PNode = - new(result) - result.kind = kind - result.info = info - result.typ = typ - # XXX use shallowCopy here for ownership transfer: - result.sons = sons - when defined(useNodeIds): - result.id = gNodeId - if result.id == nodeIdToDebug: - echo "KIND ", result.kind - writeStackTrace() - inc gNodeId - -proc newNodeIT*(kind: TNodeKind, info: TLineInfo, typ: PType): PNode = - result = newNode(kind) - result.info = info - result.typ = typ +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 -proc newIntTypeNode*(kind: TNodeKind, intVal: BiggestInt, typ: PType): PNode = - result = newIntNode(kind, intVal) +proc newIntNode*(kind: TNodeKind, intVal: Int128): PNode = + result = newNode(kind) + result.intVal = castToInt64(intVal) + +proc lastSon*(n: PNode): PNode {.inline.} = n.sons[^1] +template setLastSon*(n: PNode, s: PNode) = n.sons[^1] = s + +template firstSon*(n: PNode): PNode = n.sons[0] +template secondSon*(n: PNode): PNode = n.sons[1] + +template hasSon*(n: PNode): bool = n.len > 0 +template has2Sons*(n: PNode): bool = n.len > 1 + +proc replaceFirstSon*(n, newson: PNode) {.inline.} = + n.sons[0] = newson + +proc replaceSon*(n: PNode; i: int; newson: PNode) {.inline.} = + n.sons[i] = newson + +proc last*(n: PType): PType {.inline.} = n.sons[^1] + +proc elementType*(n: PType): PType {.inline.} = n.sons[^1] +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 + ## doesn't contain a specific type/types - it is often the case that only the + ## 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 = last(result) + +proc newIntTypeNode*(intVal: BiggestInt, typ: PType): PNode = + let kind = skipTypes(typ, abstractVarRange).kind + case kind + of tyInt: result = newNode(nkIntLit) + of tyInt8: result = newNode(nkInt8Lit) + of tyInt16: result = newNode(nkInt16Lit) + of tyInt32: result = newNode(nkInt32Lit) + of tyInt64: result = newNode(nkInt64Lit) + of tyChar: result = newNode(nkCharLit) + of tyUInt: result = newNode(nkUIntLit) + of tyUInt8: result = newNode(nkUInt8Lit) + of tyUInt16: result = newNode(nkUInt16Lit) + of tyUInt32: result = newNode(nkUInt32Lit) + of tyUInt64: result = newNode(nkUInt64Lit) + of tyBool, tyEnum: + # XXX: does this really need to be the kind nkIntLit? + result = newNode(nkIntLit) + of tyStatic: # that's a pre-existing bug, will fix in another PR + result = newNode(nkIntLit) + else: raiseAssert $kind + result.intVal = intVal result.typ = typ +proc newIntTypeNode*(intVal: Int128, typ: PType): PNode = + # XXX: introduce range check + newIntTypeNode(castToInt64(intVal), typ) + proc newFloatNode*(kind: TNodeKind, floatVal: BiggestFloat): PNode = result = newNode(kind) result.floatVal = floatVal @@ -1229,11 +1382,6 @@ proc newStrNode*(strVal: string; info: TLineInfo): PNode = result = newNodeI(nkStrLit, info) result.strVal = strVal -proc addSon*(father, son: PNode) = - assert son != nil - if isNil(father.sons): father.sons = @[] - add(father.sons, son) - proc newProcNode*(kind: TNodeKind, info: TLineInfo, body: PNode, params, name, pattern, genericParams, @@ -1243,54 +1391,148 @@ proc newProcNode*(kind: TNodeKind, info: TLineInfo, body: PNode, pragmas, exceptions, body] const - UnspecifiedLockLevel* = TLockLevel(-1'i16) - MaxLockLevel* = 1000'i16 - UnknownLockLevel* = TLockLevel(1001'i16) - -proc `$`*(x: TLockLevel): string = - if x.ord == UnspecifiedLockLevel.ord: result = "<unspecified>" - elif x.ord == UnknownLockLevel.ord: result = "<unknown>" - else: result = $int16(x) - -proc newType*(kind: TTypeKind, owner: PSym): PType = - new(result) - result.kind = kind - result.owner = owner - result.size = - 1 - result.align = 2 # default alignment - result.id = getID() - result.lockLevel = UnspecifiedLockLevel - when debugIds: - registerId(result) + AttachedOpToStr*: array[TTypeAttachedOp, string] = [ + "=wasMoved", "=destroy", "=copy", "=dup", "=sink", "=trace", "=deepcopy"] + +proc `$`*(s: PSym): string = + if s != nil: + result = s.name.s & "@" & $s.id + else: + result = "<nil>" + +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, + uniqueId: id, sons: @[]) + if son != nil: result.sons.add son when false: - if result.id == 205734: + 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(a.k): a.k = b.k - if a.storage == low(a.storage): a.storage = b.storage - a.flags = a.flags + b.flags + 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: PNode, length: int) = - if isNil(father.sons): - newSeq(father.sons, length) - else: - setLen(father.sons, length) + setLen(father.sons, length) proc newSons*(father: PType, length: int) = - if isNil(father.sons): - newSeq(father.sons, length) - else: - setLen(father.sons, length) + setLen(father.sons, length) -proc sonsLen*(n: PType): int = n.sons.len -proc len*(n: PType): int = n.sons.len -proc sonsLen*(n: PNode): int = n.sons.len -proc lastSon*(n: PNode): PNode = n.sons[^1] -proc lastSon*(n: PType): PType = n.sons[^1] +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 @@ -1299,113 +1541,74 @@ proc assignType*(dest, src: PType) = dest.n = src.n dest.size = src.size dest.align = src.align - dest.destructor = src.destructor - dest.deepCopy = src.deepCopy - dest.sink = src.sink - dest.assignment = src.assignment - dest.lockLevel = src.lockLevel # this fixes 'type TLock = TSysLock': if src.sym != nil: if dest.sym != nil: - dest.sym.flags = dest.sym.flags + (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, sonsLen(src)) - for i in countup(0, sonsLen(src) - 1): dest.sons[i] = src.sons[i] + newSons(dest, src.sons.len) + for i in 0..<src.sons.len: dest[i] = src[i] -proc copyType*(t: PType, owner: PSym, keepId: bool): PType = - result = newType(t.kind, owner) +proc copyType*(t: PType, idgen: IdGenerator, owner: PSym): PType = + result = newType(t.kind, idgen, owner) assignType(result, t) - if keepId: - result.id = t.id - else: - when debugIds: registerId(result) result.sym = t.sym # backend-info should not be copied -proc exactReplica*(t: PType): PType = copyType(t, t.owner, true) +proc exactReplica*(t: PType): PType = + 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, keepId: bool = false): PSym = - result = newSym(s.kind, s.name, 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 - if keepId: - result.id = s.id - else: - result.id = getID() - when debugIds: registerId(result) result.flags = s.flags result.magic = s.magic - if s.kind == skModule: - copyStrTable(result.tab, s.tab) result.options = s.options result.position = s.position result.loc = s.loc result.annex = s.annex # BUGFIX + result.constraint = s.constraint if result.kind in {skVar, skLet, skField}: result.guard = s.guard + result.bitsize = s.bitsize + result.alignment = s.alignment -proc createModuleAlias*(s: PSym, newIdent: PIdent, info: TLineInfo; +proc createModuleAlias*(s: PSym, idgen: IdGenerator, newIdent: PIdent, info: TLineInfo; options: TOptions): PSym = - result = newSym(s.kind, newIdent, s.owner, info, options) + result = newSym(s.kind, newIdent, idgen, s.owner, info, options) # keep ID! result.ast = s.ast - result.id = s.id + #result.id = s.id # XXX figure out what to do with the ID. result.flags = s.flags - system.shallowCopy(result.tab, s.tab) result.options = s.options result.position = s.position result.loc = s.loc result.annex = s.annex - # XXX once usedGenerics is used, ensure module aliases keep working! - assert s.usedGenerics == nil - -proc initStrTable*(x: var TStrTable) = - x.counter = 0 - newSeq(x.data, StartSize) - -proc newStrTable*: TStrTable = - initStrTable(result) - -proc initIdTable*(x: var TIdTable) = - x.counter = 0 - newSeq(x.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 initStrTable*(): TStrTable = + result = TStrTable(counter: 0) + newSeq(result.data, StartSize) -proc initObjectSet*(x: var TObjectSet) = - x.counter = 0 - newSeq(x.data, StartSize) +proc initObjectSet*(): TObjectSet = + result = TObjectSet(counter: 0) + newSeq(result.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 skipTypes*(t: PType, kinds: TTypeKinds): PType = - ## Used throughout the compiler code to test whether a type tree contains or - ## doesn't contain a specific type/types - it is often the case that only the - ## 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) +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 @@ -1413,35 +1616,29 @@ 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 t.kind == tyProc and t.callConv == ccClosure -proc propagateToOwner*(owner, elem: PType) = - const HaveTheirOwnEmpty = {tySequence, tyOpt, tySet, tyPtr, tyRef, tyProc} - owner.flags = owner.flags + (elem.flags * {tfHasMeta, tfTriggersCompileTime}) +proc propagateToOwner*(owner, elem: PType; propagateHasAsgn = true) = + owner.flags.incl elem.flags * {tfHasMeta, tfTriggersCompileTime} if tfNotNil in elem.flags: if owner.kind in {tyGenericInst, tyGenericBody, tyGenericInvocation}: owner.flags.incl tfNotNil - elif owner.kind notin HaveTheirOwnEmpty: - owner.flags.incl tfNeedsInit - - if tfNeedsInit in elem.flags: - if owner.kind in HaveTheirOwnEmpty: discard - else: owner.flags.incl tfNeedsInit if elem.isMetaType: owner.flags.incl tfHasMeta - if tfHasAsgn in elem.flags: + let mask = elem.flags * {tfHasAsgn, tfHasOwned} + if mask != {} and propagateHasAsgn: let o2 = owner.skipTypes({tyGenericInst, tyAlias, tySink}) if o2.kind in {tyTuple, tyObject, tyArray, - tySequence, tyOpt, tySet, tyDistinct}: - o2.flags.incl tfHasAsgn - owner.flags.incl tfHasAsgn + tySequence, tySet, tyDistinct}: + o2.flags.incl mask + owner.flags.incl mask if owner.kind notin {tyProc, tyGenericInst, tyGenericBody, tyGenericInvocation, tyPtr}: @@ -1451,24 +1648,17 @@ proc propagateToOwner*(owner, elem: PType) = # ensure this doesn't bite us in sempass2. owner.flags.incl tfHasGCedMem -proc rawAddSon*(father, son: PType) = - if isNil(father.sons): father.sons = @[] - add(father.sons, son) - if not son.isNil: propagateToOwner(father, son) - -proc rawAddSonNoPropagationOfTypeFlags*(father, son: PType) = - if isNil(father.sons): father.sons = @[] - add(father.sons, son) +proc rawAddSon*(father, son: PType; propagateHasAsgn = true) = + father.sons.add(son) + if not son.isNil: propagateToOwner(father, son, propagateHasAsgn) proc addSonNilAllowed*(father, son: PNode) = - if isNil(father.sons): father.sons = @[] - add(father.sons, son) + father.sons.add(son) proc delSon*(father: PNode, idx: int) = - if isNil(father.sons): return - var length = sonsLen(father) - for i in countup(idx, length - 2): father.sons[i] = father.sons[i + 1] - setLen(father.sons, length - 1) + if father.len == 0: return + for i in idx..<father.len - 1: father[i] = father[i + 1] + father.sons.setLen(father.len - 1) proc copyNode*(src: PNode): PNode = # does not copy its sons! @@ -1489,93 +1679,155 @@ 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 -proc shallowCopy*(src: PNode): PNode = - # does not copy its sons, but provides space for them: - if src == nil: return nil - result = newNode(src.kind) - result.info = src.info - result.typ = src.typ - result.flags = src.flags * PersistentNodeFlags - result.comment = src.comment +template transitionNodeKindCommon(k: TNodeKind) = + let obj {.inject.} = n[] + 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): - if result.id == nodeIdToDebug: + n.id = obj.id + +proc transitionSonsKind*(n: PNode, kind: range[nkComesFrom..nkTupleConstr]) = + transitionNodeKindCommon(kind) + n.sons = obj.sons + +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) + +template transitionSymKindCommon*(k: TSymKind) = + let obj {.inject.} = s[] + s[] = TSym(kind: k, itemId: obj.itemId, magic: obj.magic, typ: obj.typ, name: obj.name, + info: obj.info, owner: obj.owner, flags: obj.flags, ast: obj.ast, + options: obj.options, position: obj.position, offset: obj.offset, + loc: obj.loc, annex: obj.annex, constraint: obj.constraint) + when hasFFI: + s.cname = obj.cname + when defined(nimsuggest): + s.allUsages = obj.allUsages + +proc transitionGenericParamToType*(s: PSym) = + transitionSymKindCommon(skType) + +proc transitionRoutineSymKind*(s: PSym, kind: range[skProc..skTemplate]) = + transitionSymKindCommon(kind) + s.gcUnsafetyReason = obj.gcUnsafetyReason + s.transformedBody = obj.transformedBody + +proc transitionToLet*(s: PSym) = + transitionSymKindCommon(skLet) + s.guard = obj.guard + s.bitsize = obj.bitsize + s.alignment = obj.alignment + +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 + when defined(useNodeIds): + if dst.id == nodeIdToDebug: echo "COMES FROM ", src.id case src.kind - of nkCharLit..nkUInt64Lit: result.intVal = src.intVal - of nkFloatLiterals: result.floatVal = src.floatVal - of nkSym: result.sym = src.sym - of nkIdent: result.ident = src.ident - of nkStrLit..nkTripleStrLit: result.strVal = src.strVal - else: newSeq(result.sons, sonsLen(src)) + of nkCharLit..nkUInt64Lit: dst.intVal = src.intVal + of nkFloatLiterals: dst.floatVal = src.floatVal + of nkSym: dst.sym = src.sym + of nkIdent: dst.ident = src.ident + of nkStrLit..nkTripleStrLit: dst.strVal = src.strVal + else: processSonsStmt + +proc shallowCopy*(src: PNode): PNode = + # does not copy its sons, but provides space for them: + copyNodeImpl(result, src): + newSeq(result.sons, src.len) proc copyTree*(src: PNode): PNode = # copy a whole syntax tree; performs deep copying - if src == nil: - return nil - result = newNode(src.kind) - result.info = src.info - result.typ = src.typ - result.flags = src.flags * PersistentNodeFlags - result.comment = src.comment - when defined(useNodeIds): - if result.id == nodeIdToDebug: - echo "COMES FROM ", src.id - case src.kind - of nkCharLit..nkUInt64Lit: result.intVal = src.intVal - of nkFloatLiterals: result.floatVal = src.floatVal - of nkSym: result.sym = src.sym - of nkIdent: result.ident = src.ident - of nkStrLit..nkTripleStrLit: result.strVal = src.strVal - else: - newSeq(result.sons, sonsLen(src)) - for i in countup(0, sonsLen(src) - 1): - result.sons[i] = copyTree(src.sons[i]) + copyNodeImpl(result, src): + newSeq(result.sons, src.len) + for i in 0..<src.len: + result[i] = copyTree(src[i]) + +proc copyTreeWithoutNode*(src, skippedNode: PNode): PNode = + copyNodeImpl(result, src): + result.sons = newSeqOfCap[PNode](src.len) + for n in src.sons: + if n != skippedNode: + result.sons.add copyTreeWithoutNode(n, skippedNode) proc hasSonWith*(n: PNode, kind: TNodeKind): bool = - for i in countup(0, sonsLen(n) - 1): - if n.sons[i].kind == kind: + for i in 0..<n.len: + if n[i].kind == kind: return true result = false proc hasNilSon*(n: PNode): bool = - for i in countup(0, safeLen(n) - 1): - if n.sons[i] == nil: + for i in 0..<n.safeLen: + if n[i] == nil: return true - elif hasNilSon(n.sons[i]): + elif hasNilSon(n[i]): return true 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 else: - for i in countup(0, sonsLen(n) - 1): - if n.kind in kinds or containsNode(n.sons[i], kinds): return true + for i in 0..<n.len: + if n.kind in kinds or containsNode(n[i], kinds): return true 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 countup(0, sonsLen(n) - 1): - if (n.sons[i].kind == kind) or hasSubnodeWith(n.sons[i], kind): + for i in 0..<n.len: + if (n[i].kind == kind) or hasSubnodeWith(n[i], kind): return true result = false -proc getInt*(a: PNode): BiggestInt = +proc getInt*(a: PNode): Int128 = + case a.kind + of nkCharLit, nkUIntLit..nkUInt64Lit: + result = toInt128(cast[uint64](a.intVal)) + of nkInt8Lit..nkInt64Lit: + result = toInt128(a.intVal) + of nkIntLit: + # XXX: enable this assert + # assert a.typ.kind notin {tyChar, tyUint..tyUInt64} + result = toInt128(a.intVal) + else: + raiseRecoverableError("cannot extract number from invalid AST node") + +proc getInt64*(a: PNode): int64 {.deprecated: "use getInt".} = case a.kind - of nkCharLit..nkUInt64Lit: result = a.intVal + of nkCharLit, nkUIntLit..nkUInt64Lit, nkIntLit..nkInt64Lit: + result = a.intVal else: - #internalError(a.info, "getInt") - doAssert false, "getInt" - #result = 0 + raiseRecoverableError("cannot extract number from invalid AST node") proc getFloat*(a: PNode): BiggestFloat = case a.kind of nkFloatLiterals: result = a.floatVal + of nkCharLit, nkUIntLit..nkUInt64Lit, nkIntLit..nkInt64Lit: + result = BiggestFloat a.intVal else: - doAssert false, "getFloat" + raiseRecoverableError("cannot extract number from invalid AST node") + #doAssert false, "getFloat" #internalError(a.info, "getFloat") #result = 0.0 @@ -1584,9 +1836,10 @@ proc getStr*(a: PNode): string = of nkStrLit..nkTripleStrLit: result = a.strVal of nkNilLit: # let's hope this fixes more problems than it creates: - result = nil + result = "" else: - doAssert false, "getStr" + raiseRecoverableError("cannot extract string from invalid AST node") + #doAssert false, "getStr" #internalError(a.info, "getStr") #result = "" @@ -1595,28 +1848,51 @@ proc getStrOrChar*(a: PNode): string = of nkStrLit..nkTripleStrLit: result = a.strVal of nkCharLit..nkUInt64Lit: result = $chr(int(a.intVal)) else: - doAssert false, "getStrOrChar" + raiseRecoverableError("cannot extract string from invalid AST node") + #doAssert false, "getStrOrChar" #internalError(a.info, "getStrOrChar") #result = "" -proc isGenericRoutine*(s: PSym): bool = - case s.kind - of skProcKinds: - result = sfFromGeneric in s.flags or - (s.ast != nil and s.ast[genericParamsPos].kind != nkEmpty) - else: discard +proc isGenericParams*(n: PNode): bool {.inline.} = + ## used to judge whether a node is generic params. + n != nil and n.kind == nkGenericParams + +proc isGenericRoutine*(n: PNode): bool {.inline.} = + n != nil and n.kind in callableDefs and n[genericParamsPos].isGenericParams + +proc isGenericRoutineStrict*(s: PSym): bool {.inline.} = + ## determines if this symbol represents a generic routine + ## the unusual name is so it doesn't collide and eventually replaces + ## `isGenericRoutine` + s.kind in skProcKinds and s.ast.isGenericRoutine + +proc isGenericRoutine*(s: PSym): bool {.inline.} = + ## determines if this symbol represents a generic routine or an instance of + ## one. This should be renamed accordingly and `isGenericRoutineStrict` + ## should take this name instead. + ## + ## Warning/XXX: Unfortunately, it considers a proc kind symbol flagged with + ## sfFromGeneric as a generic routine. Instead this should likely not be the + ## case and the concepts should be teased apart: + ## - generic definition + ## - generic instance + ## - either generic definition or instance + s.kind in skProcKinds and (sfFromGeneric in s.flags or + s.ast.isGenericRoutine) 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.} = @@ -1624,32 +1900,23 @@ proc isRoutine*(s: PSym): bool {.inline.} = proc isCompileTimeProc*(s: PSym): bool {.inline.} = result = s.kind == skMacro or - s.kind == skProc and sfCompileTime in s.flags - -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 + s.kind in {skProc, skFunc} and sfCompileTime in s.flags proc hasPattern*(s: PSym): bool {.inline.} = - result = isRoutine(s) and s.ast.sons[patternPos].kind != nkEmpty + result = isRoutine(s) and s.ast[patternPos].kind != nkEmpty iterator items*(n: PNode): PNode = - for i in 0..<n.safeLen: yield n.sons[i] + for i in 0..<n.safeLen: yield n[i] iterator pairs*(n: PNode): tuple[i: int, n: PNode] = - for i in 0..<n.safeLen: yield (i, n.sons[i]) + for i in 0..<n.safeLen: yield (i, n[i]) proc isAtom*(n: PNode): bool {.inline.} = result = n.kind >= nkNone and n.kind <= nkNilLit proc isEmptyType*(t: PType): bool {.inline.} = - ## 'void' and 'stmt' types are often equivalent to 'nil' these days: - result = t == nil or t.kind in {tyVoid, tyStmt} + ## 'void' and 'typed' types are often equivalent to 'nil' these days: + result = t == nil or t.kind in {tyVoid, tyTyped} proc makeStmtList*(n: PNode): PNode = if n.kind == nkStmtList: @@ -1660,59 +1927,78 @@ proc makeStmtList*(n: PNode): PNode = proc skipStmtList*(n: PNode): PNode = if n.kind in {nkStmtList, nkStmtListExpr}: - for i in 0 .. n.len-2: + for i in 0..<n.len-1: if n[i].kind notin {nkEmpty, nkCommentStmt}: return n result = n.lastSon else: result = n -proc toRef*(typ: PType): PType = +proc toVar*(typ: PType; kind: TTypeKind; idgen: IdGenerator): PType = + ## If ``typ`` is not a tyVar then it is converted into a `var <typ>` and + ## returned. Otherwise ``typ`` is simply returned as-is. + result = typ + if typ.kind != kind: + 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.kind == tyObject: - result = newType(tyRef, typ.owner) - rawAddSon(result, typ) + if typ.skipTypes({tyAlias, tyGenericInst}).kind == tyObject: + 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.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 - if result.kind == tyRef: - result = result.lastSon - -proc isException*(t: PType): bool = - # check if `y` is object type and it inherits from Exception - assert(t != nil) - - if t.kind != tyObject: - return false - - var base = t - while base != nil: - if base.sym != nil and base.sym.magic == mException: - return true - base = base.lastSon - return false + 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) - if optNoCppExceptions in conf.globalOptions: + assert t != nil + + if conf.exc != excCpp: return false let base = t.skipTypes({tyAlias, tyPtr, tyDistinct, tyGenericInst}) - - if base.sym != nil and sfCompileToCpp in 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 + if n.kind == nkExprColonExpr: + result = n[1] proc findUnresolvedStatic*(n: PNode): PNode = - if n.kind == nkSym and n.typ.kind == tyStatic and n.typ.n == nil: + 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 @@ -1723,14 +2009,127 @@ when false: proc containsNil*(n: PNode): bool = # only for debugging if n.isNil: return true - for i in 0 ..< n.safeLen: + for i in 0..<n.safeLen: if n[i].containsNil: return true -template hasDestructor*(t: PType): bool = tfHasAsgn in t.flags + +template hasDestructor*(t: PType): bool = {tfHasAsgn, tfHasOwned} * t.flags != {} + template incompleteType*(t: PType): bool = t.sym != nil and {sfForward, sfNoForward} * t.sym.flags == {sfForward} template typeCompleted*(s: PSym) = incl s.flags, sfNoForward -template getBody*(s: PSym): PNode = s.ast[bodyPos] +template detailedInfo*(sym: PSym): string = + sym.name.s + +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; 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 + # the effects are now stored in there too ... this is a bit hacky, but as + # usual we desperately try to save memory: + result.n.add newNodeI(nkEffectList, info) + +proc addParam*(procType: PType; param: PSym) = + param.position = procType.sons.len-1 + procType.n.add newSymNode(param) + rawAddSon(procType, param.typ) + +const magicsThatCanRaise = { + mNone, mSlurp, mStaticExec, mParseExprToAst, mParseStmtToAst, mEcho} + +proc canRaiseConservative*(fn: PNode): bool = + if fn.kind == nkSym and fn.sym.magic notin magicsThatCanRaise: + result = false + else: + result = true + +proc canRaise*(fn: PNode): bool = + if fn.kind == nkSym and (fn.sym.magic notin magicsThatCanRaise or + {sfImportc, sfInfixCall} * fn.sym.flags == {sfImportc} or + sfGeneratedOp in fn.sym.flags): + result = false + elif fn.kind == nkSym and fn.sym.magic == mEcho: + result = true + else: + # TODO check for n having sons? or just return false for now if not + if fn.typ != nil and fn.typ.n != nil and fn.typ.n[0].kind == nkSym: + result = false + else: + result = fn.typ != nil and fn.typ.n != nil and ((fn.typ.n[0].len < effectListLen) or + (fn.typ.n[0][exceptionEffects] != nil and + fn.typ.n[0][exceptionEffects].safeLen > 0)) + +proc toHumanStrImpl[T](kind: T, num: static int): string = + result = $kind + result = result[num..^1] + result[0] = result[0].toLowerAscii + +proc toHumanStr*(kind: TSymKind): string = + ## strips leading `sk` + result = toHumanStrImpl(kind, 2) + +proc toHumanStr*(kind: TTypeKind): string = + ## strips leading `tk` + result = toHumanStrImpl(kind, 2) + +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 0afe56bb7..7a9892f78 100644 --- a/compiler/astalgo.nim +++ b/compiler/astalgo.nim @@ -12,27 +12,40 @@ # 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 +import std/[hashes, intsets] +import std/strutils except addf + +export astyaml.treeToYaml, astyaml.typeToYaml, astyaml.symToYaml, astyaml.lineInfoToStr + +when defined(nimPreviewSlimSystem): + import std/assertions + proc hashNode*(p: RootRef): Hash -proc treeToYaml*(conf: ConfigRef; n: PNode, indent: int = 0, maxRecDepth: int = - 1): Rope - # Convert a tree into its YAML representation; this is used by the - # YAML code generator and it is invaluable for debugging purposes. - # If maxRecDepht <> -1 then it won't print the whole graph. -proc typeToYaml*(conf: ConfigRef; n: PType, indent: int = 0, maxRecDepth: int = - 1): Rope -proc symToYaml*(conf: ConfigRef; n: PSym, indent: int = 0, maxRecDepth: int = - 1): Rope -proc lineInfoToStr*(conf: ConfigRef; info: TLineInfo): Rope - -when declared(echo): - # these are for debugging only: They are not really deprecated, but I want - # the warning so that release versions do not contain debugging statements: - proc debug*(conf: ConfigRef; n: PSym) {.deprecated.} - proc debug*(conf: ConfigRef; n: PType) {.deprecated.} - proc debug*(conf: ConfigRef; n: PNode) {.deprecated.} - -template mdbg*: bool {.dirty.} = - when compiles(c.module): + +# these are for debugging only: They are not really deprecated, but I want +# the warning so that release versions do not contain debugging statements: +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.} + +template debug*(x: PSym|PType|PNode) {.deprecated.} = + when compiles(c.config): + debug(c.config, x) + elif compiles(c.graph.config): + debug(c.graph.config, x) + else: + error() + +template debug*(x: auto) {.deprecated.} = + echo x + +template mdbg*: bool {.deprecated.} = + when compiles(c.graph): + c.module.fileIdx == c.graph.config.projectMainIdx + elif compiles(c.module): c.module.fileIdx == c.config.projectMainIdx elif compiles(c.c.module): c.c.module.fileIdx == c.c.config.projectMainIdx @@ -52,19 +65,8 @@ template mdbg*: bool {.dirty.} = 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 getSymFromList*(list: PNode, ident: PIdent, start: int = 0): PSym proc lookupInRecord*(n: PNode, field: PIdent): PSym proc mustRehash*(length, counter: int): bool proc nextTry*(h, maxHash: Hash): Hash {.inline.} @@ -83,28 +85,28 @@ 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) # implementation -proc skipConvAndClosure*(n: PNode): PNode = +proc skipConvCastAndClosure*(n: PNode): PNode = result = n while true: case result.kind of nkObjUpConv, nkObjDownConv, nkChckRange, nkChckRangeF, nkChckRange64, nkClosure: - result = result.sons[0] - of nkHiddenStdConv, nkHiddenSubConv, nkConv: - result = result.sons[1] + result = result[0] + of nkHiddenStdConv, nkHiddenSubConv, nkConv, nkCast: + result = result[1] else: break proc sameValue*(a, b: PNode): bool = result = false case a.kind of nkCharLit..nkUInt64Lit: - if b.kind in {nkCharLit..nkUInt64Lit}: result = a.intVal == b.intVal + if b.kind in {nkCharLit..nkUInt64Lit}: result = getInt(a) == getInt(b) of nkFloatLit..nkFloat64Lit: if b.kind in {nkFloatLit..nkFloat64Lit}: result = a.floatVal == b.floatVal of nkStrLit..nkTripleStrLit: @@ -118,8 +120,8 @@ proc leValue*(a, b: PNode): bool = # a <= b? result = false case a.kind - of nkCharLit..nkUInt32Lit: - if b.kind in {nkCharLit..nkUInt32Lit}: result = a.intVal <= b.intVal + of nkCharLit..nkUInt64Lit: + if b.kind in {nkCharLit..nkUInt64Lit}: result = getInt(a) <= getInt(b) of nkFloatLit..nkFloat64Lit: if b.kind in {nkFloatLit..nkFloat64Lit}: result = a.floatVal <= b.floatVal of nkStrLit..nkTripleStrLit: @@ -139,17 +141,17 @@ proc lookupInRecord(n: PNode, field: PIdent): PSym = result = nil case n.kind of nkRecList: - for i in countup(0, sonsLen(n) - 1): - result = lookupInRecord(n.sons[i], field) + for i in 0..<n.len: + result = lookupInRecord(n[i], field) if result != nil: return of nkRecCase: - if (n.sons[0].kind != nkSym): return nil - result = lookupInRecord(n.sons[0], field) + if (n[0].kind != nkSym): return nil + result = lookupInRecord(n[0], field) if result != nil: return - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind + for i in 1..<n.len: + case n[i].kind of nkOfBranch, nkElse: - result = lookupInRecord(lastSon(n.sons[i]), field) + result = lookupInRecord(lastSon(n[i]), field) if result != nil: return else: return nil of nkSym: @@ -161,14 +163,56 @@ proc getModule*(s: PSym): PSym = assert((result.kind == skModule) or (result.owner != result)) while result != nil and result.kind != skModule: result = result.owner -proc getSymFromList(list: PNode, ident: PIdent, start: int = 0): PSym = - for i in countup(start, sonsLen(list) - 1): - if list.sons[i].kind == nkSym: - result = list.sons[i].sym +proc fromSystem*(op: PSym): bool {.inline.} = sfSystemModule in getModule(op).flags +proc getSymFromList*(list: PNode, ident: PIdent, start: int = 0): PSym = + for i in start..<list.len: + if list[i].kind == nkSym: + result = list[i].sym if result.name.id == ident.id: return else: return nil 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) + if alen <= 0: alen = a.len + + var i = 1 + var j = 1 + while true: + while i < alen and a[i] == '_': inc i + while j < b.len and b[j] == '_': inc j + var aa = if i < alen: toLowerAscii(a[i]) else: '\0' + var bb = if j < b.len: toLowerAscii(b[j]) else: '\0' + if aa != bb: return false + + # the characters are identical: + if i >= alen: + # both cursors at the end: + if j >= b.len: return true + # not yet at the end of 'b': + return false + elif j >= b.len: + return false + inc i + inc j + +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: + ## ```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 + sameIgnoreBacktickGensymInfo(it.name.s, ident.s): return it + proc hashNode(p: RootRef): Hash = result = hash(cast[pointer](p)) @@ -176,257 +220,271 @@ 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 countup(0, if s.isNil: -1 else: (len(s)-1)): - if (i + 1) mod MaxLineLength == 0: - add(res, '\"') - add(res, "\n") - add(result, rope(res)) - res = "\"" # reset - add(res, toYamlChar(s[i])) - add(res, '\"') - add(result, rope(res)) - -proc flagsToStr[T](flags: set[T]): Rope = - if flags == {}: - result = rope("[]") - else: - result = nil - for x in items(flags): - if result != nil: add(result, ", ") - add(result, 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 ropeConstr(indent: int, c: openArray[Rope]): Rope = - # array of (name, value) pairs - var istr = rspaces(indent + 2) - result = rope("{") +import std/tables + +const backrefStyle = "\e[90m" +const enumStyle = "\e[34m" +const numberStyle = "\e[33m" +const stringStyle = "\e[32m" +const resetStyle = "\e[0m" + +type + DebugPrinter = object + conf: ConfigRef + visited: Table[pointer, int] + renderSymType: bool + indent: int + currentLine: int + firstItem: bool + useColor: bool + res: string + +proc indentMore(this: var DebugPrinter) = + this.indent += 2 + +proc indentLess(this: var DebugPrinter) = + this.indent -= 2 + +proc newlineAndIndent(this: var DebugPrinter) = + this.res.add "\n" + this.currentLine += 1 + for i in 0..<this.indent: + this.res.add ' ' + +proc openCurly(this: var DebugPrinter) = + this.res.add "{" + this.indentMore + this.firstItem = true + +proc closeCurly(this: var DebugPrinter) = + this.indentLess + this.newlineAndIndent + this.res.add "}" + +proc comma(this: var DebugPrinter) = + this.res.add ", " + +proc openBracket(this: var DebugPrinter) = + this.res.add "[" + #this.indentMore + +proc closeBracket(this: var DebugPrinter) = + #this.indentLess + this.res.add "]" + +proc key(this: var DebugPrinter; key: string) = + if not this.firstItem: + this.res.add "," + this.firstItem = false + + this.newlineAndIndent + this.res.add "\"" + this.res.add key + this.res.add "\": " + +proc value(this: var DebugPrinter; value: string) = + if this.useColor: + this.res.add stringStyle + this.res.add "\"" + this.res.add value + this.res.add "\"" + if this.useColor: + this.res.add resetStyle + +proc value(this: var DebugPrinter; value: BiggestInt) = + if this.useColor: + this.res.add numberStyle + this.res.addInt value + if this.useColor: + this.res.add resetStyle + +proc value[T: enum](this: var DebugPrinter; value: T) = + if this.useColor: + this.res.add enumStyle + this.res.add "\"" + this.res.add $value + this.res.add "\"" + if this.useColor: + this.res.add resetStyle + +proc value[T: enum](this: var DebugPrinter; value: set[T]) = + this.openBracket + let high = card(value)-1 var i = 0 - while i <= high(c): - if i > 0: add(result, ",") - addf(result, "$N$1\"$2\": $3", [istr, c[i], c[i + 1]]) - inc(i, 2) - addf(result, "$N$1}", [rspaces(indent)]) - -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 @$2\"" % [rope(n.name.s), rope( - strutils.toHex(cast[ByteAddress](n), sizeof(n) * 2))] - else: - var ast = treeToYamlAux(conf, n.ast, marker, indent + 2, maxRecDepth - 1) - result = ropeConstr(indent, [rope("kind"), - makeYamlString($n.kind), - rope("name"), makeYamlString(n.name.s), - rope("typ"), typeToYamlAux(conf, n.typ, marker, - indent + 2, maxRecDepth - 1), - rope("info"), lineInfoToStr(conf, n.info), - rope("flags"), flagsToStr(n.flags), - rope("magic"), makeYamlString($n.magic), - rope("ast"), ast, rope("options"), - flagsToStr(n.options), rope("position"), - rope(n.position)]) - -proc typeToYamlAux(conf: ConfigRef; n: PType, marker: var IntSet, indent: int, - maxRecDepth: int): Rope = - if n == nil: - result = rope("null") - elif containsOrIncl(marker, n.id): - result = "\"$1 @$2\"" % [rope($n.kind), rope( - strutils.toHex(cast[ByteAddress](n), sizeof(n) * 2))] - else: - if sonsLen(n) > 0: - result = rope("[") - for i in countup(0, sonsLen(n) - 1): - if i > 0: add(result, ",") - addf(result, "$N$1$2", [rspaces(indent + 4), typeToYamlAux(conf, n.sons[i], - marker, indent + 4, maxRecDepth - 1)]) - addf(result, "$N$1]", [rspaces(indent + 2)]) - else: - result = rope("null") - result = ropeConstr(indent, [rope("kind"), - makeYamlString($n.kind), - rope("sym"), symToYamlAux(conf, n.sym, marker, - indent + 2, maxRecDepth - 1), rope("n"), treeToYamlAux(conf, n.n, marker, - indent + 2, maxRecDepth - 1), rope("flags"), flagsToStr(n.flags), - rope("callconv"), - makeYamlString(CallingConvToStr[n.callConv]), - rope("size"), rope(n.size), - rope("align"), rope(n.align), - rope("sons"), result]) - -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: - addf(result, ",$N$1\"info\": $2", [istr, lineInfoToStr(conf, n.info)]) - case n.kind - of nkCharLit..nkInt64Lit: - addf(result, ",$N$1\"intVal\": $2", [istr, rope(n.intVal)]) - of nkFloatLit, nkFloat32Lit, nkFloat64Lit: - addf(result, ",$N$1\"floatVal\": $2", - [istr, rope(n.floatVal.toStrMaxPrecision)]) - of nkStrLit..nkTripleStrLit: - if n.strVal.isNil: - addf(result, ",$N$1\"strVal\": null", [istr]) - else: - addf(result, ",$N$1\"strVal\": $2", [istr, makeYamlString(n.strVal)]) - of nkSym: - addf(result, ",$N$1\"sym\": $2", - [istr, symToYamlAux(conf, n.sym, marker, indent + 2, maxRecDepth)]) - of nkIdent: - if n.ident != nil: - addf(result, ",$N$1\"ident\": $2", [istr, makeYamlString(n.ident.s)]) - else: - addf(result, ",$N$1\"ident\": null", [istr]) - else: - if sonsLen(n) > 0: - addf(result, ",$N$1\"sons\": [", [istr]) - for i in countup(0, sonsLen(n) - 1): - if i > 0: add(result, ",") - addf(result, "$N$1$2", [rspaces(indent + 4), treeToYamlAux(conf, n.sons[i], - marker, indent + 4, maxRecDepth - 1)]) - addf(result, "$N$1]", [istr]) - addf(result, ",$N$1\"typ\": $2", - [istr, typeToYamlAux(conf, n.typ, marker, indent + 2, maxRecDepth)]) - addf(result, "$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) - -proc debugTree*(conf: ConfigRef; n: PNode, indent: int, maxRecDepth: int; renderType=false): Rope -proc debugType(conf: ConfigRef; n: PType, maxRecDepth=100): Rope = + for v in value: + this.value v + if i != high: + this.comma + inc i + this.closeBracket + +template earlyExit(this: var DebugPrinter; n: PType | PNode | PSym) = if n == nil: - result = rope("null") + this.res.add "null" + return + let index = this.visited.getOrDefault(cast[pointer](n), -1) + if index < 0: + this.visited[cast[pointer](n)] = this.currentLine else: - result = rope($n.kind) - if n.sym != nil: - add(result, " ") - add(result, n.sym.name.s) - if n.kind in IntegralTypes and n.n != nil: - add(result, ", node: ") - add(result, debugTree(conf, n.n, 2, maxRecDepth-1, renderType=true)) - if (n.kind != tyString) and (sonsLen(n) > 0) and maxRecDepth != 0: - add(result, "(") - for i in countup(0, sonsLen(n) - 1): - if i > 0: add(result, ", ") - if n.sons[i] == nil: - add(result, "null") - else: - add(result, debugType(conf, n.sons[i], maxRecDepth-1)) - if n.kind == tyObject and n.n != nil: - add(result, ", node: ") - add(result, debugTree(conf, n.n, 2, maxRecDepth-1, renderType=true)) - add(result, ")") - -proc debugTree(conf: ConfigRef; n: PNode, indent: int, maxRecDepth: int; - renderType=false): Rope = - if n == nil: - result = rope("null") + if this.useColor: + this.res.add backrefStyle + this.res.add "<defined " + this.res.addInt(this.currentLine - index) + this.res.add " lines upwards>" + if this.useColor: + this.res.add resetStyle + return + +proc value(this: var DebugPrinter; value: PType) +proc value(this: var DebugPrinter; value: PNode) +proc value(this: var DebugPrinter; value: PSym) = + earlyExit(this, value) + + this.openCurly + this.key("kind") + this.value(value.kind) + this.key("name") + this.value(value.name.s) + this.key("id") + this.value(value.id) + if value.kind in {skField, skEnumField, skParam}: + this.key("position") + this.value(value.position) + + if card(value.flags) > 0: + this.key("flags") + this.value(value.flags) + + if this.renderSymType and value.typ != nil: + this.key "typ" + this.value(value.typ) + + this.closeCurly + +proc value(this: var DebugPrinter; value: PType) = + earlyExit(this, value) + + this.openCurly + this.key "kind" + this.value value.kind + + this.key "id" + this.value value.id + + if value.sym != nil: + this.key "sym" + this.value value.sym + #this.value value.sym.name.s + + if card(value.flags) > 0: + this.key "flags" + this.value value.flags + + if value.kind in IntegralTypes and value.n != nil: + this.key "n" + this.value value.n + + 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" + this.value value.n + + this.closeCurly + +proc value(this: var DebugPrinter; value: PNode) = + earlyExit(this, value) + + 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 + if this.conf != nil: + this.key "info" + this.value $lineInfoToStr(this.conf, value.info) + if value.flags != {}: + this.key "flags" + this.value value.flags + + if value.typ != nil: + this.key "typ" + this.value value.typ.kind else: - var istr = rspaces(indent + 2) - result = "{$N$1\"kind\": $2" % - [istr, makeYamlString($n.kind)] - when defined(useNodeIds): - addf(result, ",$N$1\"id\": $2", [istr, rope(n.id)]) - addf(result, ",$N$1\"info\": $2", [istr, lineInfoToStr(conf, n.info)]) - if maxRecDepth != 0: - addf(result, ",$N$1\"flags\": $2", [istr, rope($n.flags)]) - case n.kind - of nkCharLit..nkUInt64Lit: - addf(result, ",$N$1\"intVal\": $2", [istr, rope(n.intVal)]) - of nkFloatLit, nkFloat32Lit, nkFloat64Lit: - addf(result, ",$N$1\"floatVal\": $2", - [istr, rope(n.floatVal.toStrMaxPrecision)]) - of nkStrLit..nkTripleStrLit: - if n.strVal.isNil: - addf(result, ",$N$1\"strVal\": null", [istr]) - else: - addf(result, ",$N$1\"strVal\": $2", [istr, makeYamlString(n.strVal)]) - of nkSym: - addf(result, ",$N$1\"sym\": $2_$3", - [istr, rope(n.sym.name.s), rope(n.sym.id)]) - # [istr, symToYaml(n.sym, indent, maxRecDepth), - # rope(n.sym.id)]) - if renderType and n.sym.typ != nil: - addf(result, ",$N$1\"typ\": $2", [istr, debugType(conf, n.sym.typ, 2)]) - of nkIdent: - if n.ident != nil: - addf(result, ",$N$1\"ident\": $2", [istr, makeYamlString(n.ident.s)]) - else: - addf(result, ",$N$1\"ident\": null", [istr]) - else: - if sonsLen(n) > 0: - addf(result, ",$N$1\"sons\": [", [istr]) - for i in countup(0, sonsLen(n) - 1): - if i > 0: add(result, ",") - addf(result, "$N$1$2", [rspaces(indent + 4), debugTree(conf, n.sons[i], - indent + 4, maxRecDepth - 1, renderType)]) - addf(result, "$N$1]", [istr]) - addf(result, "$N$1}", [rspaces(indent)]) - -when declared(echo): - proc debug(conf: ConfigRef; n: PSym) = - if n == nil: - echo("null") - elif n.kind == skUnknown: - echo("skUnknown") - else: - #writeLine(stdout, $symToYaml(n, 0, 1)) - echo("$1_$2: $3, $4, $5, $6" % [ - n.name.s, $n.id, $flagsToStr(n.flags), $flagsToStr(n.loc.flags), - $lineInfoToStr(conf, n.info), $n.kind]) - - proc debug(conf: ConfigRef; n: PType) = - echo($debugType(conf, n)) - - proc debug(conf: ConfigRef; n: PNode) = - echo($debugTree(conf, n, 0, 100)) + this.key "typ" + this.value "nil" -proc nextTry(h, maxHash: Hash): Hash = + case value.kind + of nkCharLit..nkUInt64Lit: + this.key "intVal" + this.value value.intVal + of nkFloatLit, nkFloat32Lit, nkFloat64Lit: + this.key "floatVal" + this.value value.floatVal.toStrMaxPrecision + of nkStrLit..nkTripleStrLit: + this.key "strVal" + this.value value.strVal + of nkSym: + this.key "sym" + this.value value.sym + #this.value value.sym.name.s + of nkIdent: + if value.ident != nil: + this.key "ident" + this.value value.ident.s + else: + if this.renderSymType and value.typ != nil: + this.key "typ" + this.value value.typ + 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.closeCurly + + +proc debug(n: PSym; conf: ConfigRef) = + 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( + 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( + visited: initTable[pointer, int](), + renderSymType: false, + useColor: not defined(windows) + ) + this.value(n) + echo($this.res) + +proc nextTry(h, maxHash: Hash): Hash {.inline.} = result = ((5 * h) + 1) and maxHash # For any initial h in range(maxHash), repeating that maxHash times # generates each int in range(maxHash) exactly once (see any text on @@ -451,13 +509,13 @@ proc objectSetRawInsert(data: var TObjectSeq, obj: RootRef) = proc objectSetEnlarge(t: var TObjectSet) = var n: TObjectSeq - newSeq(n, len(t.data) * GrowthFactor) - for i in countup(0, high(t.data)): + newSeq(n, t.data.len * GrowthFactor) + for i in 0..high(t.data): if t.data[i] != nil: objectSetRawInsert(n, t.data[i]) swap(t.data, n) proc objectSetIncl*(t: var TObjectSet, obj: RootRef) = - if mustRehash(len(t.data), t.counter): objectSetEnlarge(t) + if mustRehash(t.data.len, t.counter): objectSetEnlarge(t) objectSetRawInsert(t.data, obj) inc(t.counter) @@ -470,7 +528,7 @@ proc objectSetContainsOrIncl*(t: var TObjectSet, obj: RootRef): bool = if it == obj: return true # found it h = nextTry(h, high(t.data)) - if mustRehash(len(t.data), t.counter): + if mustRehash(t.data.len, t.counter): objectSetEnlarge(t) objectSetRawInsert(t.data, obj) else: @@ -487,35 +545,18 @@ proc strTableContains*(t: TStrTable, n: PSym): bool = h = nextTry(h, high(t.data)) result = false -proc strTableRawInsert(data: var TSymSeq, n: PSym) = +proc strTableRawInsert(data: var seq[PSym], n: PSym) = var h: Hash = n.name.h and high(data) - if sfImmediate notin n.flags: - # fast path: - while data[h] != nil: - if data[h] == n: - # allowed for 'export' feature: - #InternalError(n.info, "StrTableRawInsert: " & n.name.s) - return - h = nextTry(h, high(data)) - assert(data[h] == nil) - data[h] = n - else: - # slow path; we have to ensure immediate symbols are preferred for - # symbol lookups. - # consider the chain: foo (immediate), foo, bar, bar (immediate) - # then bar (immediate) gets replaced with foo (immediate) and the non - # immediate foo is picked! Thus we need to replace it with the first - # slot that has in fact the same identifier stored in it! - var favPos = -1 - while data[h] != nil: - if data[h] == n: return - if favPos < 0 and data[h].name.id == n.name.id: favPos = h - h = nextTry(h, high(data)) - assert(data[h] == nil) - data[h] = n - if favPos >= 0: swap data[h], data[favPos] - -proc symTabReplaceRaw(data: var TSymSeq, prevSym: PSym, newSym: PSym) = + while data[h] != nil: + if data[h] == n: + # allowed for 'export' feature: + #InternalError(n.info, "StrTableRawInsert: " & n.name.s) + return + h = nextTry(h, high(data)) + assert(data[h] == nil) + data[h] = n + +proc symTabReplaceRaw(data: var seq[PSym], prevSym: PSym, newSym: PSym) = assert prevSym.name.h == newSym.name.h var h: Hash = prevSym.name.h and high(data) while data[h] != nil: @@ -529,21 +570,22 @@ proc symTabReplace*(t: var TStrTable, prevSym: PSym, newSym: PSym) = symTabReplaceRaw(t.data, prevSym, newSym) proc strTableEnlarge(t: var TStrTable) = - var n: TSymSeq - newSeq(n, len(t.data) * GrowthFactor) - for i in countup(0, high(t.data)): + var n: seq[PSym] + newSeq(n, t.data.len * GrowthFactor) + for i in 0..high(t.data): if t.data[i] != nil: strTableRawInsert(n, t.data[i]) swap(t.data, n) proc strTableAdd*(t: var TStrTable, n: PSym) = - if mustRehash(len(t.data), t.counter): strTableEnlarge(t) + if mustRehash(t.data.len, t.counter): strTableEnlarge(t) strTableRawInsert(t.data, n) inc(t.counter) -proc strTableIncl*(t: var TStrTable, n: PSym; onConflictKeepOld=false): bool {.discardable.} = - # 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! +proc strTableInclReportConflict*(t: var TStrTable, n: PSym; + onConflictKeepOld = false): PSym = + # if `t` has a conflicting symbol (same identifier as `n`), return it + # otherwise return `nil`. Incl `n` to `t` unless `onConflictKeepOld = true` + # and a conflict was found. assert n.name != nil var h: Hash = n.name.h and high(t.data) var replaceSlot = -1 @@ -555,21 +597,26 @@ proc strTableIncl*(t: var TStrTable, n: PSym; onConflictKeepOld=false): bool {.d # So it is possible the very same sym is added multiple # times to the symbol table which we allow here with the 'it == n' check. if it.name.id == n.name.id: - if it == n: return false + if it == n: return nil replaceSlot = h h = nextTry(h, high(t.data)) if replaceSlot >= 0: + result = t.data[replaceSlot] # found it if not onConflictKeepOld: t.data[replaceSlot] = n # overwrite it with newer definition! - return true # found it - elif mustRehash(len(t.data), t.counter): + return result # but return the old one + elif mustRehash(t.data.len, t.counter): strTableEnlarge(t) strTableRawInsert(t.data, n) else: assert(t.data[h] == nil) t.data[h] = n inc(t.counter) - result = false + result = nil + +proc strTableIncl*(t: var TStrTable, n: PSym; + onConflictKeepOld = false): bool {.discardable.} = + result = strTableInclReportConflict(t, n, onConflictKeepOld) != nil proc strTableGet*(t: TStrTable, name: PIdent): PSym = var h: Hash = name.h and high(t.data) @@ -586,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 = @@ -655,137 +707,16 @@ 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 countup(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(len(t.data), t.counter): - newSeq(n, len(t.data) * GrowthFactor) - for i in countup(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 idNodeTableGetLazy*(t: TIdNodeTable, key: PIdObj): PNode = - if not isNil(t.data): - result = idNodeTableGet(t, key) - -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(len(t.data), t.counter): - var n: TIdNodePairSeq - newSeq(n, len(t.data) * GrowthFactor) - for i in countup(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) - -proc idNodeTablePutLazy*(t: var TIdNodeTable, key: PIdObj, val: PNode) = - if isNil(t.data): initIdNodeTable(t) - idNodeTablePut(t, key, val) - -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) - for i in countup(0, StartSize - 1): x.data[i].key = InvalidKey + for i in 0..<StartSize: x.data[i].key = InvalidKey proc iiTableRawGet(t: TIITable, key: int): int = var h: Hash @@ -816,13 +747,25 @@ proc iiTablePut(t: var TIITable, key, val: int) = assert(t.data[index].key != InvalidKey) t.data[index].val = val else: - if mustRehash(len(t.data), t.counter): + if mustRehash(t.data.len, t.counter): var n: TIIPairSeq - newSeq(n, len(t.data) * GrowthFactor) - for i in countup(0, high(n)): n[i].key = InvalidKey - for i in countup(0, high(t.data)): + newSeq(n, t.data.len * GrowthFactor) + for i in 0..high(n): n[i].key = InvalidKey + for i in 0..high(t.data): if t.data[i].key != InvalidKey: iiTableRawInsert(n, t.data[i].key, t.data[i].val) swap(t.data, n) iiTableRawInsert(t.data, key, val) inc(t.counter) + +proc listSymbolNames*(symbols: openArray[PSym]): string = + result = "" + for sym in symbols: + if result.len > 0: + result.add ", " + result.add sym.name.s + +proc isDiscriminantField*(n: PNode): bool = + if n.kind == nkCheckedFieldExpr: sfDiscriminant in n[0][1].sym.flags + elif n.kind == nkDotExpr: sfDiscriminant in n[1].sym.flags + else: false 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 e38732877..7d142b01d 100644 --- a/compiler/bitsets.nim +++ b/compiler/bitsets.nim @@ -10,88 +10,88 @@ # 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 - TBitSet* = seq[int8] # we use byte here to avoid issues with + ElemType = byte + TBitSet* = seq[ElemType] # we use byte here to avoid issues with # cross-compiling; uint would be more efficient # however - const - ElemSize* = sizeof(int8) * 8 - -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 = - result = (x[int(e div ElemSize)] and toU8(int(1 shl (e mod ElemSize)))) != - toU8(0) - -proc bitSetIncl(x: var TBitSet, elem: BiggestInt) = + ElemSize* = 8 + One = ElemType(1) + Zero = ElemType(0) + +template modElemSize(arg: untyped): untyped = arg and 7 +template divElemSize(arg: untyped): untyped = arg shr 3 + +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) = assert(elem >= 0) - x[int(elem div ElemSize)] = x[int(elem div ElemSize)] or - toU8(int(1 shl (elem mod ElemSize))) + x[int(elem.divElemSize)] = x[int(elem.divElemSize)] or + (One shl elem.modElemSize) -proc bitSetExcl(x: var TBitSet, elem: BiggestInt) = - x[int(elem div ElemSize)] = x[int(elem div ElemSize)] and - not toU8(int(1 shl (elem mod ElemSize))) +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) = - for i in countup(0, high(x)): x[i] = x[i] or y[i] +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) = - for i in countup(0, high(x)): x[i] = x[i] and not y[i] +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) = - for i in countup(0, high(x)): x[i] = x[i] xor y[i] +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) = - for i in countup(0, high(x)): x[i] = x[i] and y[i] +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 = - for i in countup(0, high(x)): +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 = - for i in countup(0, high(x)): - if (x[i] and not y[i]) != int8(0): +proc bitSetContains*(x, y: TBitSet): bool = + for i in 0..high(x): + if (x[i] and not y[i]) != Zero: return false result = true # Number of set bits for all values of int8 -const populationCount: array[low(int8)..high(int8), int8] = block: - var arr: array[low(int8)..high(int8), int8] +const populationCount: array[uint8, uint8] = block: + var arr: array[uint8, uint8] - proc countSetBits(x: int8): int8 = + proc countSetBits(x: uint8): uint8 = return - ( x and 0b00000001'i8) + - ((x and 0b00000010'i8) shr 1) + - ((x and 0b00000100'i8) shr 2) + - ((x and 0b00001000'i8) shr 3) + - ((x and 0b00010000'i8) shr 4) + - ((x and 0b00100000'i8) shr 5) + - ((x and 0b01000000'i8) shr 6) + - ((x and 0b10000000'i8) shr 7) - - - for it in low(int8)..high(int8): - arr[it] = countSetBits(it) + ( x and 0b00000001'u8) + + ((x and 0b00000010'u8) shr 1) + + ((x and 0b00000100'u8) shr 2) + + ((x and 0b00001000'u8) shr 3) + + ((x and 0b00010000'u8) shr 4) + + ((x and 0b00100000'u8) shr 5) + + ((x and 0b01000000'u8) shr 6) + + ((x and 0b10000000'u8) shr 7) + + + for it in low(uint8)..high(uint8): + arr[it] = countSetBits(cast[uint8](it)) arr -proc bitSetCard(x: TBitSet): BiggestInt = +proc bitSetCard*(x: TBitSet): BiggestInt = + result = 0 for it in x: - result.inc populationCount[it] + 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 6cd6e51f4..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,37 +38,41 @@ 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: + for j in 0..<x.entries: if j+1 == x.entries or less(key, x.keys[j+1]): x = x.links[j] break assert(not x.isInternal) - for j in 0 ..< x.entries: + for j in 0..<x.entries: if eq(key, x.keys[j]): return x.vals[j] proc contains*[Key, Val](b: BTree[Key, Val], key: Key): bool = var x = b.root while x.isInternal: - for j in 0 ..< x.entries: + for j in 0..<x.entries: if j+1 == x.entries or less(key, x.keys[j+1]): x = x.links[j] break assert(not x.isInternal) - for j in 0 ..< x.entries: + for j in 0..<x.entries: if eq(key, x.keys[j]): return true return false proc copyHalf[Key, Val](h, result: Node[Key, Val]) = - for j in 0 ..< Mhalf: + for j in 0..<Mhalf: result.keys[j] = h.keys[Mhalf + j] if h.isInternal: - for j in 0 ..< Mhalf: + for j in 0..<Mhalf: result.links[j] = h.links[Mhalf + j] else: - for j in 0 ..< Mhalf: - shallowCopy(result.vals[j], h.vals[Mhalf + j]) + for j in 0..<Mhalf: + 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 @@ -79,10 +86,16 @@ proc insert[Key, Val](h: Node[Key, Val], key: Key, val: Val): Node[Key, Val] = var j = 0 if not h.isInternal: while j < h.entries: + if eq(key, h.keys[j]): + h.vals[j] = val + return 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 @@ -132,8 +145,7 @@ proc `$`[Key, Val](b: BTree[Key, Val]): string = result = "" toString(b.root, "", result) -proc hasNext*[Key, Val](b: BTree[Key, Val]; index: int): bool = - result = index < b.entries +proc hasNext*[Key, Val](b: BTree[Key, Val]; index: int): bool = index < b.entries proc countSubTree[Key, Val](it: Node[Key, Val]): int = if it.isInternal: @@ -166,68 +178,3 @@ iterator pairs*[Key, Val](b: BTree[Key, Val]): (Key, Val) = yield (k, v) proc len*[Key, Val](b: BTree[Key, Val]): int {.inline.} = b.entries - -when isMainModule: - - import random, tables - - proc main = - var st = initBTree[string, string]() - st.add("www.cs.princeton.edu", "abc") - st.add("www.princeton.edu", "128.112.128.15") - st.add("www.yale.edu", "130.132.143.21") - st.add("www.simpsons.com", "209.052.165.60") - st.add("www.apple.com", "17.112.152.32") - st.add("www.amazon.com", "207.171.182.16") - st.add("www.ebay.com", "66.135.192.87") - st.add("www.cnn.com", "64.236.16.20") - st.add("www.google.com", "216.239.41.99") - st.add("www.nytimes.com", "199.239.136.200") - st.add("www.microsoft.com", "207.126.99.140") - st.add("www.dell.com", "143.166.224.230") - st.add("www.slashdot.org", "66.35.250.151") - st.add("www.espn.com", "199.181.135.201") - st.add("www.weather.com", "63.111.66.11") - st.add("www.yahoo.com", "216.109.118.65") - - assert st.getOrDefault("www.cs.princeton.edu") == "abc" - assert st.getOrDefault("www.harvardsucks.com") == nil - - assert st.getOrDefault("www.simpsons.com") == "209.052.165.60" - assert st.getOrDefault("www.apple.com") == "17.112.152.32" - assert st.getOrDefault("www.ebay.com") == "66.135.192.87" - assert st.getOrDefault("www.dell.com") == "143.166.224.230" - assert(st.entries == 16) - - for k, v in st: - echo k, ": ", v - - when false: - var b2 = initBTree[string, string]() - const iters = 10_000 - for i in 1..iters: - b2.add($i, $(iters - i)) - for i in 1..iters: - let x = b2.getOrDefault($i) - if x != $(iters - i): - echo "got ", x, ", but expected ", iters - i - echo b2.entries - - when true: - var b2 = initBTree[int, string]() - var t2 = initTable[int, string]() - const iters = 100_000 - for i in 1..iters: - let x = rand(high(int)) - if not t2.hasKey(x): - doAssert b2.getOrDefault(x).len == 0, " what, tree has this element " & $x - t2[x] = $x - b2.add(x, $x) - - doAssert b2.entries == t2.len - echo "unique entries ", b2.entries - for k, v in t2: - doAssert $k == v - doAssert b2.getOrDefault(k) == $k - - main() diff --git a/compiler/canonicalizer.nim b/compiler/canonicalizer.nim deleted file mode 100644 index d1669a06c..000000000 --- a/compiler/canonicalizer.nim +++ /dev/null @@ -1,421 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2015 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements the canonalization for the various caching mechanisms. - -import strutils, db_sqlite, md5 - -var db: DbConn - -# We *hash* the relevant information into 128 bit hashes. This should be good -# enough to prevent any collisions. - -type - TUid = distinct MD5Digest - -# For name mangling we encode these hashes via a variant of base64 (called -# 'base64a') and prepend the *primary* identifier to ease the debugging pain. -# So a signature like: -# -# proc gABI(c: PCtx; n: PNode; opc: TOpcode; a, b: TRegister; imm: BiggestInt) -# -# is mangled into: -# gABI_MTdmOWY5MTQ1MDcyNGQ3ZA -# -# This is a good compromise between correctness and brevity. ;-) - -const - cb64 = [ - "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", - "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", - "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", - "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", - "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", - "_A", "_B"] - -proc toBase64a(s: cstring, len: int): string = - ## encodes `s` into base64 representation. After `lineLen` characters, a - ## `newline` is added. - result = newStringOfCap(((len + 2) div 3) * 4) - var i = 0 - while i < s.len - 2: - let a = ord(s[i]) - let b = ord(s[i+1]) - let c = ord(s[i+2]) - result.add cb64[a shr 2] - result.add cb64[((a and 3) shl 4) or ((b and 0xF0) shr 4)] - result.add cb64[((b and 0x0F) shl 2) or ((c and 0xC0) shr 6)] - result.add cb64[c and 0x3F] - inc(i, 3) - if i < s.len-1: - let a = ord(s[i]) - let b = ord(s[i+1]) - result.add cb64[a shr 2] - result.add cb64[((a and 3) shl 4) or ((b and 0xF0) shr 4)] - result.add cb64[((b and 0x0F) shl 2)] - elif i < s.len: - let a = ord(s[i]) - result.add cb64[a shr 2] - result.add cb64[(a and 3) shl 4] - -proc toBase64a(u: TUid): string = toBase64a(cast[cstring](u), sizeof(u)) - -proc `&=`(c: var MD5Context, s: string) = md5Update(c, s, s.len) - -proc hashSym(c: var MD5Context, s: PSym) = - if sfAnon in s.flags or s.kind == skGenericParam: - c &= ":anon" - else: - var it = s.owner - while it != nil: - hashSym(c, it) - c &= "." - it = s.owner - c &= s.name.s - -proc hashTree(c: var MD5Context, n: PNode) = - if n == nil: - c &= "\255" - return - var k = n.kind - md5Update(c, cast[cstring](addr(k)), 1) - # we really must not hash line information. 'n.typ' is debatable but - # shouldn't be necessary for now and avoids potential infinite recursions. - case n.kind - of nkEmpty, nkNilLit, nkType: discard - of nkIdent: - c &= n.ident.s - of nkSym: - hashSym(c, n.sym) - of nkCharLit..nkUInt64Lit: - var v = n.intVal - md5Update(c, cast[cstring](addr(v)), sizeof(v)) - of nkFloatLit..nkFloat64Lit: - var v = n.floatVal - md5Update(c, cast[cstring](addr(v)), sizeof(v)) - of nkStrLit..nkTripleStrLit: - c &= n.strVal - else: - for i in 0..<n.len: hashTree(c, n.sons[i]) - -proc hashType(c: var MD5Context, t: PType) = - # modelled after 'typeToString' - if t == nil: - c &= "\254" - return - - var k = t.kind - md5Update(c, cast[cstring](addr(k)), 1) - - if t.sym != nil and sfAnon notin t.sym.flags: - # t.n for literals, but not for e.g. objects! - if t.kind in {tyFloat, tyInt}: c.hashNode(t.n) - c.hashSym(t.sym) - - case t.kind - of tyGenericBody, tyGenericInst, tyGenericInvocation: - for i in countup(0, sonsLen(t) -1 -ord(t.kind != tyGenericInvocation)): - c.hashType t.sons[i] - of tyUserTypeClass: - internalAssert t.sym != nil and t.sym.owner != nil - c &= t.sym.owner.name.s - of tyUserTypeClassInst: - let body = t.base - c.hashSym body.sym - for i in countup(1, sonsLen(t) - 2): - c.hashType t.sons[i] - of tyFromExpr: - c.hashTree(t.n) - of tyArray: - c.hashTree(t.sons[0].n) - c.hashType(t.sons[1]) - of tyTuple: - if t.n != nil: - assert(sonsLen(t.n) == sonsLen(t)) - for i in countup(0, sonsLen(t.n) - 1): - assert(t.n.sons[i].kind == nkSym) - c &= t.n.sons[i].sym.name.s - c &= ":" - c.hashType(t.sons[i]) - c &= "," - else: - for i in countup(0, sonsLen(t) - 1): c.hashType t.sons[i] - of tyRange: - c.hashTree(t.n) - c.hashType(t.sons[0]) - of tyProc: - c &= (if tfIterator in t.flags: "iterator " else: "proc ") - for i in 0..<t.len: c.hashType(t.sons[i]) - md5Update(c, cast[cstring](addr(t.callConv)), 1) - - if tfNoSideEffect in t.flags: c &= ".noSideEffect" - if tfThread in t.flags: c &= ".thread" - else: - for i in 0..<t.len: c.hashType(t.sons[i]) - if tfNotNil in t.flags: c &= "not nil" - -proc canonConst(n: PNode): TUid = - var c: MD5Context - md5Init(c) - c.hashTree(n) - c.hashType(n.typ) - md5Final(c, MD5Digest(result)) - -proc canonSym(s: PSym): TUid = - var c: MD5Context - md5Init(c) - c.hashSym(s) - md5Final(c, MD5Digest(result)) - -proc pushType(w: PRodWriter, t: PType) = - # check so that the stack does not grow too large: - if iiTableGet(w.index.tab, t.id) == InvalidKey: - w.tstack.add(t) - -proc pushSym(w: PRodWriter, s: PSym) = - # check so that the stack does not grow too large: - if iiTableGet(w.index.tab, s.id) == InvalidKey: - w.sstack.add(s) - -proc encodeNode(w: PRodWriter, fInfo: TLineInfo, n: PNode, - result: var string) = - if n == nil: - # nil nodes have to be stored too: - result.add("()") - return - result.add('(') - encodeVInt(ord(n.kind), result) - # we do not write comments for now - # Line information takes easily 20% or more of the filesize! Therefore we - # omit line information if it is the same as the father's line information: - if fInfo.fileIndex != n.info.fileIndex: - result.add('?') - encodeVInt(n.info.col, result) - result.add(',') - encodeVInt(n.info.line, result) - result.add(',') - encodeVInt(fileIdx(w, toFilename(n.info)), result) - elif fInfo.line != n.info.line: - result.add('?') - encodeVInt(n.info.col, result) - result.add(',') - encodeVInt(n.info.line, result) - elif fInfo.col != n.info.col: - result.add('?') - encodeVInt(n.info.col, result) - var f = n.flags * PersistentNodeFlags - if f != {}: - result.add('$') - encodeVInt(cast[int32](f), result) - if n.typ != nil: - result.add('^') - encodeVInt(n.typ.id, result) - pushType(w, n.typ) - case n.kind - of nkCharLit..nkInt64Lit: - if n.intVal != 0: - result.add('!') - encodeVBiggestInt(n.intVal, result) - of nkFloatLit..nkFloat64Lit: - if n.floatVal != 0.0: - result.add('!') - encodeStr($n.floatVal, result) - of nkStrLit..nkTripleStrLit: - if n.strVal != "": - result.add('!') - encodeStr(n.strVal, result) - of nkIdent: - result.add('!') - encodeStr(n.ident.s, result) - of nkSym: - result.add('!') - encodeVInt(n.sym.id, result) - pushSym(w, n.sym) - else: - for i in countup(0, sonsLen(n) - 1): - encodeNode(w, n.info, n.sons[i], result) - add(result, ')') - -proc encodeLoc(w: PRodWriter, loc: TLoc, result: var string) = - var oldLen = result.len - result.add('<') - if loc.k != low(loc.k): encodeVInt(ord(loc.k), result) - if loc.s != low(loc.s): - add(result, '*') - encodeVInt(ord(loc.s), result) - if loc.flags != {}: - add(result, '$') - encodeVInt(cast[int32](loc.flags), result) - if loc.t != nil: - add(result, '^') - encodeVInt(cast[int32](loc.t.id), result) - pushType(w, loc.t) - if loc.r != nil: - add(result, '!') - encodeStr($loc.r, result) - if loc.a != 0: - add(result, '?') - encodeVInt(loc.a, result) - if oldLen + 1 == result.len: - # no data was necessary, so remove the '<' again: - setLen(result, oldLen) - else: - add(result, '>') - -proc encodeType(w: PRodWriter, t: PType, result: var string) = - if t == nil: - # nil nodes have to be stored too: - result.add("[]") - return - # we need no surrounding [] here because the type is in a line of its own - if t.kind == tyForward: internalError("encodeType: tyForward") - # for the new rodfile viewer we use a preceding [ so that the data section - # can easily be disambiguated: - add(result, '[') - encodeVInt(ord(t.kind), result) - add(result, '+') - encodeVInt(t.id, result) - if t.n != nil: - encodeNode(w, unknownLineInfo(), t.n, result) - if t.flags != {}: - add(result, '$') - encodeVInt(cast[int32](t.flags), result) - if t.callConv != low(t.callConv): - add(result, '?') - encodeVInt(ord(t.callConv), result) - if t.owner != nil: - add(result, '*') - encodeVInt(t.owner.id, result) - pushSym(w, t.owner) - if t.sym != nil: - add(result, '&') - encodeVInt(t.sym.id, result) - pushSym(w, t.sym) - if t.size != - 1: - add(result, '/') - encodeVBiggestInt(t.size, result) - if t.align != 2: - add(result, '=') - encodeVInt(t.align, result) - encodeLoc(w, t.loc, result) - for i in countup(0, sonsLen(t) - 1): - if t.sons[i] == nil: - add(result, "^()") - else: - add(result, '^') - encodeVInt(t.sons[i].id, result) - pushType(w, t.sons[i]) - -proc encodeLib(w: PRodWriter, lib: PLib, info: TLineInfo, result: var string) = - add(result, '|') - encodeVInt(ord(lib.kind), result) - add(result, '|') - encodeStr($lib.name, result) - add(result, '|') - encodeNode(w, info, lib.path, result) - -proc encodeSym(w: PRodWriter, s: PSym, result: var string) = - if s == nil: - # nil nodes have to be stored too: - result.add("{}") - return - # we need no surrounding {} here because the symbol is in a line of its own - encodeVInt(ord(s.kind), result) - result.add('+') - encodeVInt(s.id, result) - result.add('&') - encodeStr(s.name.s, result) - if s.typ != nil: - result.add('^') - encodeVInt(s.typ.id, result) - pushType(w, s.typ) - result.add('?') - if s.info.col != -1'i16: encodeVInt(s.info.col, result) - result.add(',') - if s.info.line != -1'i16: encodeVInt(s.info.line, result) - result.add(',') - encodeVInt(fileIdx(w, toFilename(s.info)), result) - if s.owner != nil: - result.add('*') - encodeVInt(s.owner.id, result) - pushSym(w, s.owner) - if s.flags != {}: - result.add('$') - encodeVInt(cast[int32](s.flags), result) - if s.magic != mNone: - result.add('@') - encodeVInt(ord(s.magic), result) - if s.options != w.options: - result.add('!') - encodeVInt(cast[int32](s.options), result) - if s.position != 0: - result.add('%') - encodeVInt(s.position, result) - if s.offset != - 1: - result.add('`') - encodeVInt(s.offset, result) - encodeLoc(w, s.loc, result) - if s.annex != nil: encodeLib(w, s.annex, s.info, result) - if s.constraint != nil: - add(result, '#') - encodeNode(w, unknownLineInfo(), s.constraint, result) - # lazy loading will soon reload the ast lazily, so the ast needs to be - # the last entry of a symbol: - if s.ast != nil: - # we used to attempt to save space here by only storing a dummy AST if - # it is not necessary, but Nim's heavy compile-time evaluation features - # make that unfeasible nowadays: - encodeNode(w, s.info, s.ast, result) - - -proc createDb() = - db.exec(sql""" - create table if not exists Module( - id integer primary key, - name varchar(256) not null, - fullpath varchar(256) not null, - interfHash varchar(256) not null, - fullHash varchar(256) not null, - - created timestamp not null default (DATETIME('now')) - );""") - - db.exec(sql""" - create table if not exists Backend( - id integer primary key, - strongdeps varchar(max) not null, - weakdeps varchar(max) not null, - header varchar(max) not null, - code varchar(max) not null - ) - - create table if not exists Symbol( - id integer primary key, - module integer not null, - backend integer not null, - name varchar(max) not null, - data varchar(max) not null, - created timestamp not null default (DATETIME('now')), - - foreign key (module) references Module(id), - foreign key (backend) references Backend(id) - );""") - - db.exec(sql""" - create table if not exists Type( - id integer primary key, - module integer not null, - name varchar(max) not null, - data varchar(max) not null, - created timestamp not null default (DATETIME('now')), - - foreign key (module) references module(id) - );""") - - 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 2f9cc822b..ac607e3ad 100644 --- a/compiler/ccgcalls.nim +++ b/compiler/ccgcalls.nim @@ -9,273 +9,573 @@ # # included from cgen.nim -proc leftAppearsOnRightSide(le, ri: PNode): bool = +proc canRaiseDisp(p: BProc; n: PNode): bool = + # we assume things like sysFatal cannot raise themselves + if n.kind == nkSym and {sfNeverRaises, sfImportc, sfCompilerProc} * n.sym.flags != {}: + result = false + elif optPanics in p.config.globalOptions or + (n.kind == nkSym and sfSystemModule in getModule(n.sym).flags and + sfSystemRaisesDefect notin n.sym.flags): + # we know we can be strict: + result = canRaise(n) + else: + # we have to be *very* conservative: + result = canRaiseConservative(n) + +proc 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! + case n.kind + of nkSym: + # we don't own the location so it escapes: + if n.sym.owner != p.prc: + return true + elif inTryStmt and sfUsedInFinallyOrExcept in n.sym.flags: + # it is also an observable store if the location is used + # in 'except' or 'finally' + return true + return false + of nkDotExpr, nkBracketExpr, nkObjUpConv, nkObjDownConv, + nkCheckedFieldExpr: + n = n[0] + of nkHiddenStdConv, nkHiddenSubConv, nkConv: + n = n[1] + else: + # cannot analyse the location; assume the worst + return true + + result = false if le != nil: - for i in 1 ..< ri.len: + for i in 1..<ri.len: let r = ri[i] if isPartOf(le, r) != arNo: return true + # we use the weaker 'canRaise' here in order to prevent too many + # annoying warnings, see #14514 + 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.sons[0].kind == nkSym and sfNoInit in call.sons[0].sym.flags + result = call[0].kind == nkSym and sfNoInit in call[0].sym.flags + +proc isHarmlessStore(p: BProc; canRaise: bool; d: TLoc): bool = + if d.k in {locTemp, locNone} or not canRaise: + result = true + elif d.k == locLocalVar and p.withinTryWithExcept == 0: + # we cannot observe a store to a local variable if the current proc + # has no error handler: + result = true + 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) = - var pl = callee & ~"(" & params + let canRaise = p.config.exc == excGoto and canRaiseDisp(p, ri[0]) + genLineDir(p, ri) + var pl = callee & "(" & params # getUniqueType() is too expensive here: - var typ = skipTypes(ri.sons[0].typ, abstractInst) - if typ.sons[0] != nil: - if isInvalidReturnType(p.config, typ.sons[0]): - if params != nil: pl.add(~", ") + var typ = skipTypes(ri[0].typ, abstractInst) + 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 leftAppearsOnRightSide(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.sons[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)" - add(pl, addrLoc(p.config, d)) - add(pl, ~");$n") + pl.add(addrLoc(p.config, d)) + pl.add(");\n") line(p, cpsStmts, pl) else: - var tmp: TLoc - getTemp(p, typ.sons[0], tmp, needsInit=true) - add(pl, addrLoc(p.config, tmp)) - add(pl, ~");$n") + var tmp: TLoc = getTemp(p, typ.returnType, needsInit=true) + pl.add(addrLoc(p.config, tmp)) + pl.add(");\n") line(p, cpsStmts, pl) genAssignment(p, d, tmp, {}) # no need for deep copying + if canRaise: raiseExit(p) else: - add(pl, ~")") - 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 - excl d.flags, lfSingleUse - else: - if d.k == locNone: getTemp(p, typ.sons[0], d) + 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.snippet = pl + excl d.flags, lfSingleUse + else: + if d.k == locNone and p.splitDecls == 0: + d = getTempCpp(p, typ.returnType, pl) + else: + 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): + 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 + 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.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: - add(pl, ~");$n") + pl.add(");\n") line(p, cpsStmts, pl) - -proc isInCurrentFrame(p: BProc, n: PNode): bool = - # checks if `n` is an expression that refers to the current frame; - # this does not work reliably because of forwarding + inlining can break it - case n.kind - of nkSym: - if n.sym.kind in {skVar, skResult, skTemp, skLet} and p.prc != nil: - result = p.prc.id == n.sym.owner.id - of nkDotExpr, nkBracketExpr: - if skipTypes(n.sons[0].typ, abstractInst).kind notin {tyVar,tyLent,tyPtr,tyRef}: - result = isInCurrentFrame(p, n.sons[0]) - of nkHiddenStdConv, nkHiddenSubConv, nkConv: - result = isInCurrentFrame(p, n.sons[1]) - of nkHiddenDeref, nkDerefExpr: - # what about: var x = addr(y); callAsOpenArray(x[])? - # *shrug* ``addr`` is unsafe anyway. + if canRaise: raiseExit(p) + +proc genBoundsCheck(p: BProc; arr, a, b: TLoc; arrTyp: PType) + +proc reifiedOpenArray(n: PNode): bool {.inline.} = + var x = n + 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 - of nkObjUpConv, nkObjDownConv, nkCheckedFieldExpr: - result = isInCurrentFrame(p, n.sons[0]) - else: discard - -proc genBoundsCheck(p: BProc; arr, a, b: TLoc) - -proc openArrayLoc(p: BProc, n: PNode): Rope = - var a: TLoc - - let q = skipConv(n) + else: + result = true + +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, 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 + of tyArray: + let first = toInt64(firstOrd(p.config, ty)) + if first == 0: + 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), lit, dest], + lengthExpr) + of tyOpenArray, tyVarargs: + if reifiedOpenArray(q[1]): + result = ("($3*)($1.Field0)+($2)" % [rdLoc(a), rdLoc(b), dest], + lengthExpr) + else: + result = ("($3*)($1)+($2)" % [rdLoc(a), rdLoc(b), dest], + lengthExpr) + of tyUncheckedArray, tyCstring: + result = ("($3*)($1)+($2)" % [rdLoc(a), rdLoc(b), dest], + lengthExpr) + of tyString, tySequence: + let atyp = skipTypes(a.t, abstractInst) + if formalType.skipTypes(abstractInst).kind in {tyVar} and atyp.kind == tyString and + 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 = ("(($5) ? (($4*)(*$1)$3+($2)) : NIM_NIL)" % + [rdLoc(a), rdLoc(b), dataField(p), dest, dataFieldAccessor(p, "*" & rdLoc(a))], + lengthExpr) + else: + 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; result: var Rope) = + var q = skipConv(n) + var skipped = false + while q.kind == nkStmtListExpr and q.len > 0: + skipped = true + q = q.lastSon if getMagic(q) == mSlice: # magic: pass slice to openArray: - var b, c: TLoc - initLocExpr(p, q[1], a) - initLocExpr(p, q[2], b) - initLocExpr(p, q[3], c) - # but first produce the required index checks: - if optBoundsCheck in p.options: - genBoundsCheck(p, a, b, c) - let ty = skipTypes(a.t, abstractVar+{tyPtr}) - case ty.kind - of tyArray: - let first = firstOrd(p.config, ty) - if first == 0: - result = "($1)+($2), ($3)-($2)+1" % [rdLoc(a), rdLoc(b), rdLoc(c)] - else: - result = "($1)+(($2)-($4)), ($3)-($2)+1" % [rdLoc(a), rdLoc(b), rdLoc(c), intLiteral(first)] - of tyOpenArray, tyVarargs: - result = "($1)+($2), ($3)-($2)+1" % [rdLoc(a), rdLoc(b), rdLoc(c)] - of tyString, tySequence: - if skipTypes(n.typ, abstractInst).kind == tyVar and - not compileToCpp(p.module): - result = "(*$1)->data+($2), ($3)-($2)+1" % [rdLoc(a), rdLoc(b), rdLoc(c)] - else: - result = "$1->data+($2), ($3)-($2)+1" % [rdLoc(a), rdLoc(b), rdLoc(c)] - else: - internalError(p.config, "openArrayLoc: " & typeToString(a.t)) + if skipped: + q = skipConv(n) + while q.kind == nkStmtListExpr and q.len > 0: + for i in 0..<q.len-1: + genStmts(p, q[i]) + q = q.lastSon + let (x, y) = genOpenArraySlice(p, q, formalType, n.typ.elementType) + result.add x & ", " & y else: - initLocExpr(p, 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: - result = "$1, $1Len_0" % [rdLoc(a)] + if reifiedOpenArray(n): + if a.t.kind in {tyVar, tyLent}: + result.add "$1->Field0, $1->Field1" % [rdLoc(a)] + else: + result.add "$1.Field0, $1.Field1" % [rdLoc(a)] + else: + result.add "$1, $1Len_0" % [rdLoc(a)] of tyString, tySequence: - if skipTypes(n.typ, abstractInst).kind == tyVar and - not compileToCpp(p.module): - result = "(*$1)->data, (*$1 ? (*$1)->$2 : 0)" % [a.rdLoc, lenField(p)] + 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(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->data, ($1 ? $1->$2 : 0)" % [a.rdLoc, lenField(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: - result = "(*$1)->data, (*$1 ? (*$1)->$2 : 0)" % [a.rdLoc, lenField(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)) -proc genArgStringToCString(p: BProc, n: PNode): Rope {.inline.} = - var a: TLoc - initLocExpr(p, n.sons[0], a) - result = "($1 ? $1->data : (NCSTRING)\"\")" % [a.rdLoc] +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, gcAtomicArc, gcOrc} and + getSize(p.config, a.lode.typ) < 1024: + result = getTemp(p, a.lode.typ, needsInit=false) + genAssignment(p, result, a, {}) + else: + result = a + +proc literalsNeedsTmp(p: BProc, a: TLoc): TLoc = + result = getTemp(p, a.lode.typ, needsInit=false) + genAssignment(p, result, a, {}) + +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): Rope = +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) + genArgStringToCString(p, n, result, needsTmp) elif skipTypes(param.typ, abstractVar).kind in {tyOpenArray, tyVarargs}: - var n = if n.kind != nkHiddenAddr: n else: n.sons[0] - result = openArrayLoc(p, n) - elif ccgIntroducedPtr(p.config, param): - initLocExpr(p, n, a) - result = addrLoc(p.config, a) - elif p.module.compileToCpp and param.typ.kind == tyVar and + var n = if n.kind != nkHiddenAddr: n else: n[0] + 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.sons[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.sons[0] + 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) + {sfImportc, sfInfixCall, sfCompilerProc} * callee.sym.flags == {sfImportc} and + {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(a) - -proc genArgNoParam(p: BProc, n: PNode): Rope = + 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; result: var Rope; needsTmp = false) = var a: TLoc if n.kind == nkStringToCString: - result = genArgStringToCString(p, n) + genArgStringToCString(p, n, result, needsTmp) else: - initLocExprSingleUse(p, n, a) - result = rdLoc(a) - -template genParamLoop(params) {.dirty.} = - if i < sonsLen(typ): - assert(typ.n.sons[i].kind == nkSym) - let paramType = typ.n.sons[i] - if not paramType.typ.isCompileTimeOnly: - if params != nil: add(params, ~", ") - add(params, genArg(p, ri.sons[i], paramType.sym, ri)) + a = initLocExprSingleUse(p, n) + addRdLoc(withTmpIfNeeded(p, a, needsTmp), result) + +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 + +proc skipTrivialIndirections(n: PNode): PNode = + result = n + while true: + case result.kind + of nkDerefExpr, nkHiddenDeref, nkAddr, nkHiddenAddr, nkObjDownConv, nkObjUpConv: + result = result[0] + of nkHiddenStdConv, nkHiddenSubConv: + result = result[1] + else: break + +proc getPotentialWrites(n: PNode; mutate: bool; result: var seq[PNode]) = + case n.kind: + of nkLiterals, nkIdent, nkFormalParams: discard + of nkSym: + if mutate: result.add n + of nkAsgn, nkFastAsgn, nkSinkAsgn: + getPotentialWrites(n[0], true, result) + getPotentialWrites(n[1], mutate, result) + of nkAddr, nkHiddenAddr: + 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: - if params != nil: add(params, ~", ") - add(params, genArgNoParam(p, ri.sons[i])) + for s in n: + getPotentialWrites(s, mutate, result) + +proc getPotentialReads(n: PNode; result: var seq[PNode]) = + case n.kind: + of nkLiterals, nkIdent, nkFormalParams: discard + of nkSym: result.add n + else: + for s in n: + getPotentialReads(s, result) + +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] = @[] + for i in countdown(ri.len - 1, 1): + if ri[i].skipTrivialIndirections.kind == nkSym: + needTmp[i - 1] = potentialAlias(ri[i], potentialWrites) + else: + #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) + 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.n.len: + assert(typ.n[i].kind == nkSym) + let paramType = typ.n[i] + if not paramType.typ.isCompileTimeOnly: + if oldLen != result.len: + result.add(", ") + oldLen = result.len + genArg(p, ri[i], paramType.sym, ri, result, needTmp[i-1]) + else: + 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 + (sym.typ.callConv == ccInline or sym.owner.id == module.id): + 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.sons[0], op) - var params: Rope + var op = initLocExpr(p, ri[0]) # getUniqueType() is too expensive here: - var typ = skipTypes(ri.sons[0].typ, abstractInst) + var typ = skipTypes(ri[0].typ, abstractInstOwned) assert(typ.kind == tyProc) - assert(sonsLen(typ) == sonsLen(typ.n)) - var length = sonsLen(ri) - for i in countup(1, length - 1): - genParamLoop(params) - fixupCall(p, le, ri, d, op.r, params) -proc genClosureCall(p: BProc, le, ri: PNode, d: var TLoc) = + var params = newRopeAppender() + genParams(p, ri, typ, params) - proc getRawProcType(p: BProc, t: PType): Rope = - result = getClosureType(p.module, t, clHalf) + var callee = rdLoc(op) + if p.hcrOn and ri[0].kind == nkSym: + callee.addActualSuffixForHCR(p.module.module, ri[0].sym) + fixupCall(p, le, ri, d, callee, params) + +proc genClosureCall(p: BProc, le, ri: PNode, d: var TLoc) = proc addComma(r: Rope): Rope = - result = 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.sons[0], op) - var pl: Rope - var typ = skipTypes(ri.sons[0].typ, abstractInst) + var op = initLocExpr(p, ri[0]) + + # getUniqueType() is too expensive here: + var typ = skipTypes(ri[0].typ, abstractInstOwned) assert(typ.kind == tyProc) - var length = sonsLen(ri) - for i in countup(1, length - 1): - assert(sonsLen(typ) == sonsLen(typ.n)) - genParamLoop(pl) + + var pl = newRopeAppender() + genParams(p, ri, typ, pl) template genCallPattern {.dirty.} = - lineF(p, cpsStmts, callPattern & ";$n", [op.r, pl, pl.addComma, rawProc]) + if tfIterator in typ.flags: + lineF(p, cpsStmts, PatIter & ";$n", [rdLoc(op), pl, pl.addComma, rawProc]) + else: + lineF(p, cpsStmts, PatProc & ";$n", [rdLoc(op), pl, pl.addComma, rawProc]) - let rawProc = getRawProcType(p, typ) - let callPattern = if tfIterator in typ.flags: PatIter else: PatProc - if typ.sons[0] != nil: - if isInvalidReturnType(p.config, typ.sons[0]): - if sonsLen(ri) > 1: add(pl, ~", ") + let rawProc = getClosureType(p.module, typ, clHalf) + let canRaise = p.config.exc == excGoto and canRaiseDisp(p, ri[0]) + 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 leftAppearsOnRightSide(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.sons[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)" - add(pl, addrLoc(p.config, d)) + pl.add(addrLoc(p.config, d)) genCallPattern() + if canRaise: raiseExit(p) else: - var tmp: TLoc - getTemp(p, typ.sons[0], tmp, needsInit=true) - add(pl, addrLoc(p.config, tmp)) + 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 - else: - if d.k == locNone: getTemp(p, typ.sons[0], d) + elif isHarmlessStore(p, canRaise, 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 = callPattern % [op.r, pl, pl.addComma, rawProc] + var list: TLoc = initLoc(locCall, d.lode, OnUnknown) + if tfIterator in typ.flags: + list.snippet = PatIter % [rdLoc(op), pl, pl.addComma, rawProc] + else: + 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.returnType) + assert(d.t != nil) # generate an assignment to d: + var list: TLoc = initLoc(locCall, d.lode, OnUnknown) + if tfIterator in typ.flags: + list.snippet = PatIter % [rdLoc(op), pl, pl.addComma, rawProc] + else: + list.snippet = PatProc % [rdLoc(op), pl, pl.addComma, rawProc] + genAssignment(p, tmp, list, {}) + if canRaise: raiseExit(p) + genAssignment(p, d, tmp, {}) else: genCallPattern() + if canRaise: raiseExit(p) -proc genOtherArg(p: BProc; ri: PNode; i: int; typ: PType): Rope = - if i < sonsLen(typ): +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.sons[i] + let paramType = typ.n[i] assert(paramType.kind == nkSym) if paramType.typ.isCompileTimeOnly: - result = nil - elif typ.sons[i].kind == tyVar and ri.sons[i].kind == nkHiddenAddr: - result = genArgNoParam(p, ri.sons[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.sons[i]) #, typ.n.sons[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.sons[i]) + if argsCounter > 0: result.add ", " + genArgNoParam(p, ri[i], result) + inc argsCounter discard """ Dot call syntax in C++ @@ -319,99 +619,99 @@ proc skipAddrDeref(node: PNode): PNode = var isAddr = false case n.kind of nkAddr, nkHiddenAddr: - n = n.sons[0] + n = n[0] isAddr = true of nkDerefExpr, nkHiddenDeref: - n = n.sons[0] + n = n[0] else: return n - if n.kind == nkObjDownConv: n = n.sons[0] + if n.kind == nkObjDownConv: n = n[0] if isAddr and n.kind in {nkDerefExpr, nkHiddenDeref}: - result = n.sons[0] + result = n[0] elif n.kind in {nkAddr, nkHiddenAddr}: - result = n.sons[0] + result = n[0] 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 < sonsLen(typ) - assert(typ.n.sons[i].kind == nkSym) + 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: var ri = ri[i] while ri.kind == nkObjDownConv: ri = ri[0] - let t = typ.sons[i].skipTypes({tyGenericInst, tyAlias, tySink}) - if t.kind == tyVar: + let t = typ[i].skipTypes({tyGenericInst, tyAlias, tySink}) + 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.sons[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 '@': - if j < ri.len: - result.add genOtherArg(p, ri, j, typ) - for k in j+1 ..< ri.len: - result.add(~", ") - result.add genOtherArg(p, ri, k, typ) + var argsCounter = 0 + for k in j..<ri.len: + genOtherArg(p, ri, k, typ, result, argsCounter) inc i of '#': - if pat[i+1] in {'+', '@'}: + if i+1 < pat.len and pat[i+1] in {'+', '@'}: let ri = ri[j] if ri.kind in nkCallKinds: - let typ = skipTypes(ri.sons[0].typ, abstractInst) - if pat[i+1] == '+': result.add genArgNoParam(p, ri.sons[0]) - result.add(~"(") + let typ = skipTypes(ri[0].typ, abstractInst) + if pat[i+1] == '+': genArgNoParam(p, ri[0], result) + result.add("(") if 1 < ri.len: - result.add genOtherArg(p, ri, 1, typ) - for k in j+1 ..< ri.len: - result.add(~", ") - result.add genOtherArg(p, ri, k, typ) - result.add(~")") + var argsCounterB = 0 + genOtherArg(p, ri, 1, typ, result, argsCounterB) + for k in j+1..<ri.len: + 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 pat[i+1] == '.': - result.add genThisArg(p, ri, j, typ) + elif i+1 < pat.len and pat[i+1] == '.': + genThisArg(p, ri, j, typ, result) inc i - elif pat[i+1] == '[': - var arg = ri.sons[j].skipAddrDeref + 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 @@ -419,142 +719,147 @@ proc genPatternCall(p: BProc; ri: PNode; pat: string; typ: PType): Rope = if pat[i] notin {'@', '#', '\''}: inc(i) else: break if i - 1 >= start: - add(result, substr(pat, start, i - 1)) + result.add(substr(pat, start, i - 1)) proc genInfixCall(p: BProc, le, ri: PNode, d: var TLoc) = - var op: TLoc - initLocExpr(p, ri.sons[0], op) + var op = initLocExpr(p, ri[0]) # getUniqueType() is too expensive here: - var typ = skipTypes(ri.sons[0].typ, abstractInst) + var typ = skipTypes(ri[0].typ, abstractInst) assert(typ.kind == tyProc) - var length = sonsLen(ri) - assert(sonsLen(typ) == sonsLen(typ.n)) # don't call '$' here for efficiency: - let pat = ri.sons[0].sym.loc.r.data - internalAssert p.config, pat != nil + 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.sons[0].typ, abstractInst) - if typ.sons[0] != nil: + var typ = skipTypes(ri[0].typ, abstractInst) + 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.sons[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: - add(pl, ~";$n") + pl.add(";\n") line(p, cpsStmts, pl) else: - var pl: Rope = nil - #var param = typ.n.sons[1].sym + var pl = newRopeAppender() + var argsCounter = 0 if 1 < ri.len: - add(pl, genThisArg(p, ri, 1, typ)) - add(pl, op.r) - var params: Rope - for i in countup(2, length - 1): - if params != nil: params.add(~", ") - assert(sonsLen(typ) == sonsLen(typ.n)) - add(params, genOtherArg(p, ri, i, typ)) + genThisArg(p, ri, 1, typ, pl) + pl.add(op.snippet) + var params = newRopeAppender() + for i in 2..<ri.len: + 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.sons[0], op) - var pl = ~"[" + var op = initLocExpr(p, ri[0]) + var pl = "[" # getUniqueType() is too expensive here: - var typ = skipTypes(ri.sons[0].typ, abstractInst) + var typ = skipTypes(ri[0].typ, abstractInst) assert(typ.kind == tyProc) - var length = sonsLen(ri) - assert(sonsLen(typ) == sonsLen(typ.n)) # don't call '$' here for efficiency: - let pat = ri.sons[0].sym.loc.r.data - internalAssert p.config, pat != nil + let pat = $ri[0].sym.loc.snippet + internalAssert p.config, pat.len > 0 var start = 3 if ' ' in pat: start = 1 - add(pl, op.r) - if length > 1: - add(pl, ~": ") - add(pl, genArg(p, ri.sons[1], typ.n.sons[1].sym, ri)) + pl.add(op.snippet) + if ri.len > 1: + pl.add(": ") + genArg(p, ri[1], typ.n[1].sym, ri, pl) start = 2 else: - if length > 1: - add(pl, genArg(p, ri.sons[1], typ.n.sons[1].sym, ri)) - add(pl, ~" ") - add(pl, op.r) - if length > 2: - add(pl, ~": ") - add(pl, genArg(p, ri.sons[2], typ.n.sons[2].sym, ri)) - for i in countup(start, length-1): - assert(sonsLen(typ) == sonsLen(typ.n)) - if i >= sonsLen(typ): + if ri.len > 1: + genArg(p, ri[1], typ.n[1].sym, ri, pl) + pl.add(" ") + pl.add(op.snippet) + if ri.len > 2: + pl.add(": ") + genArg(p, ri[2], typ.n[2].sym, ri, pl) + for i in start..<ri.len: + if i >= typ.n.len: internalError(p.config, ri.info, "varargs for objective C method?") - assert(typ.n.sons[i].kind == nkSym) - var param = typ.n.sons[i].sym - add(pl, ~" ") - add(pl, param.name.s) - add(pl, ~": ") - add(pl, genArg(p, ri.sons[i], param, ri)) - if typ.sons[0] != nil: - if isInvalidReturnType(p.config, typ.sons[0]): - if sonsLen(ri) > 1: add(pl, ~" ") + assert(typ.n[i].kind == nkSym) + var param = typ.n[i].sym + pl.add(" ") + pl.add(param.name.s) + 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.sons[0], d, needsInit=true) - add(pl, ~"Result: ") - add(pl, addrLoc(p.config, d)) - add(pl, ~"];$n") + if d.k == locNone: d = getTemp(p, typ.returnType, needsInit=true) + pl.add("Result: ") + pl.add(addrLoc(p.config, d)) + pl.add("];\n") line(p, cpsStmts, pl) else: - var tmp: TLoc - getTemp(p, typ.sons[0], tmp, needsInit=true) - add(pl, addrLoc(p.config, tmp)) - add(pl, ~"];$n") + var tmp: TLoc = getTemp(p, typ.returnType, needsInit=true) + pl.add(addrLoc(p.config, tmp)) + pl.add("];\n") line(p, cpsStmts, pl) genAssignment(p, d, tmp, {}) # no need for deep copying else: - add(pl, ~"]") - if d.k == locNone: getTemp(p, typ.sons[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: - add(pl, ~"];$n") + pl.add("];\n") line(p, cpsStmts, pl) -proc genCall(p: BProc, e: PNode, d: var TLoc) = - if e.sons[0].typ.skipTypes({tyGenericInst, tyAlias, tySink}).callConv == ccClosure: - genClosureCall(p, nil, e, d) - elif e.sons[0].kind == nkSym and sfInfixCall in e.sons[0].sym.flags: - genInfixCall(p, nil, e, d) - elif e.sons[0].kind == nkSym and sfNamedParamCall in e.sons[0].sym.flags: - genNamedParamCall(p, e, d) - else: - genPrefixCall(p, nil, e, d) - postStmtActions(p) +proc notYetAlive(n: PNode): bool {.inline.} = + let r = getRoot(n) + result = r != nil and r.loc.lode == nil + +proc isInactiveDestructorCall(p: BProc, e: PNode): bool = + #[ Consider this example. + + var :tmpD_3281815 + try: + if true: + return + let args_3280013 = + wasMoved_3281816(:tmpD_3281815) + `=_3280036`(:tmpD_3281815, [1]) + :tmpD_3281815 + finally: + `=destroy_3280027`(args_3280013) + + We want to return early but the 'finally' section is traversed before + the 'let args = ...' statement. We exploit this to generate better + code for 'return'. ]# + result = e.len == 2 and e[0].kind == nkSym and + e[0].sym.name.s == "=destroy" and notYetAlive(e[1].skipAddr) proc genAsgnCall(p: BProc, le, ri: PNode, d: var TLoc) = - if ri.sons[0].typ.skipTypes({tyGenericInst, tyAlias, tySink}).callConv == ccClosure: + if p.withinBlockLeaveActions > 0 and isInactiveDestructorCall(p, ri): + return + if ri[0].typ.skipTypes({tyGenericInst, tyAlias, tySink, tyOwned}).callConv == ccClosure: genClosureCall(p, le, ri, d) - elif ri.sons[0].kind == nkSym and sfInfixCall in ri.sons[0].sym.flags: + elif ri[0].kind == nkSym and sfInfixCall in ri[0].sym.flags: genInfixCall(p, le, ri, d) - elif ri.sons[0].kind == nkSym and sfNamedParamCall in ri.sons[0].sym.flags: + elif ri[0].kind == nkSym and sfNamedParamCall in ri[0].sym.flags: 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 82cc3a1fb..545d43ae8 100644 --- a/compiler/ccgexprs.nim +++ b/compiler/ccgexprs.nim @@ -9,125 +9,148 @@ # included from cgen.nim +when defined(nimCompilerStacktraceHints): + import std/stackframes + +proc getNullValueAuxT(p: BProc; orig, t: PType; obj, constOrNil: PNode, + result: var Rope; count: var int; + isConst: bool, info: TLineInfo) + # -------------------------- 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 genLiteral(p: BProc, n: PNode, ty: PType): Rope = - if ty == nil: internalError(p.config, n.info, "genLiteral: ty is nil") +proc intLiteral(i: Int128; result: var Rope) = + intLiteral(toInt64(i), result) + +proc genLiteral(p: BProc, n: PNode, ty: PType; result: var Rope) = case n.kind of nkCharLit..nkUInt64Lit: - case skipTypes(ty, abstractVarRange).kind + var k: TTypeKind + if ty != nil: + k = skipTypes(ty, abstractVarRange).kind + else: + case n.kind + of nkCharLit: k = tyChar + of nkUInt64Lit: k = tyUInt64 + of nkInt64Lit: k = tyInt64 + 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)) + 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 = "(($1) $2)" % [getTypeDesc(p.module, - ty), intLiteral(n.intVal)] + result.add "((" + result.add getTypeDesc(p.module, ty) + result.add ")" + intLiteral(n.intVal, result) + result.add ")" of nkNilLit: - let t = skipTypes(ty, abstractVarRange) - if t.kind == tyProc and t.callConv == ccClosure: + 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) - addf(p.module.s[cfsData], + 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.add rope("NIM_NIL") else: - result = rope("NIM_NIL") + result.add "(($1) NIM_NIL)" % [getTypeDesc(p.module, ty)] of nkStrLit..nkTripleStrLit: - case skipTypes(ty, abstractVarRange).kind + 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 'nil' strings, we can map "" to nil and + # with the new semantics for not 'nil' strings, we can map "" to nil and # save tons of allocations: - #if n.strVal.len == 0: result = genNilStringLiteral(p.module, n.info) - #else: - result = genStringLiteral(p.module, n) + if n.strVal.len == 0 and optSeqDestructors notin p.config.globalOptions: + genNilStringLiteral(p.module, n.info, result) + else: + genStringLiteral(p.module, n, result) else: - if n.strVal.isNil: result = rope("NIM_NIL") - 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 bitSetToWord(s: TBitSet, size: int): BiggestInt = - result = 0 - when true: - for j in countup(0, size - 1): - if j < len(s): result = result or `shl`(ze64(s[j]), j * 8) - else: - # not needed, too complex thinking: - if CPU[platform.hostCPU].endian == CPU[targetCPU].endian: - for j in countup(0, size - 1): - if j < len(s): result = result or `shl`(Ze64(s[j]), j * 8) - else: - for j in countup(0, size - 1): - if j < len(s): result = result or `shl`(Ze64(s[j]), (Size - 1 - j) * 8) +proc genLiteral(p: BProc, n: PNode; result: var Rope) = + genLiteral(p, n, n.typ, result) -proc genRawSetData(cs: TBitSet, size: int): Rope = - var frmt: FormatStr +proc genRawSetData(cs: TBitSet, size: int; result: var Rope) = if size > 8: - result = "{$n" % [] - for i in countup(0, size - 1): + var res = "{\n" + for i in 0..<size: + res.add "0x" + res.add "0123456789abcdef"[cs[i] div 16] + res.add "0123456789abcdef"[cs[i] mod 16] if i < size - 1: - # not last iteration? - if (i + 1) mod 8 == 0: frmt = "0x$1,$n" - else: frmt = "0x$1, " + # not last iteration + if i mod 8 == 7: + res.add ",\n" + else: + res.add ", " else: - frmt = "0x$1}$n" - addf(result, frmt, [rope(toHex(ze64(cs[i]), 2))]) + res.add "}\n" + + result.add rope(res) else: - result = intLiteral(bitSetToWord(cs, size)) - # result := rope('0x' + ToHex(bitSetToWord(cs, size), size * 2)) + intLiteral(cast[BiggestInt](bitSetToWord(cs, size)), result) -proc genSetNode(p: BProc, n: PNode): Rope = - var cs: TBitSet +proc genSetNode(p: BProc, n: PNode; result: var Rope) = var size = int(getSize(p.config, n.typ)) - toBitSet(p.config, n, cs) + 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) - addf(p.module.s[cfsData], "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 case n.kind of nkSym: case n.sym.kind @@ -141,16 +164,18 @@ proc getStorageLoc(n: PNode): TStorageLoc = else: result = OnUnknown else: result = OnUnknown of nkDerefExpr, nkHiddenDeref: - case n.sons[0].typ.kind + case n[0].typ.kind 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.sons[0]) + result = getStorageLoc(n[0]) else: result = OnUnknown -proc canMove(n: PNode): bool = +proc canMove(p: BProc, n: PNode; dest: TLoc): bool = # for now we're conservative here: if n.kind == nkBracket: # This needs to be kept consistent with 'const' seq code @@ -158,40 +183,26 @@ proc canMove(n: PNode): bool = if not isDeepConstExpr(n) or n.len == 0: if skipTypes(n.typ, abstractVarRange).kind == tySequence: return true + elif n.kind in nkStrKinds and n.strVal.len == 0: + # Empty strings are codegen'd as NIM_NIL so it's just a pointer copy + return true result = n.kind in nkCallKinds + #if not result and dest.k == locTemp: + # return true + #if result: # echo n.info, " optimized ", n # result = false -proc genRefAssign(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = - if dest.storage == OnStack or not usesNativeGC(p.config): - linefmt(p, cpsStmts, "$1 = $2;$n", rdLoc(dest), rdLoc(src)) +proc genRefAssign(p: BProc, dest, src: TLoc) = + if (dest.storage == OnStack and p.config.selectedGC != gcGo) or not usesWriteBarrier(p.config): + linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) elif dest.storage == OnHeap: - # location is on heap - # now the writer barrier is inlined for performance: - # - # if afSrcIsNotNil in flags: - # UseMagic(p.module, 'nimGCref') - # lineF(p, cpsStmts, 'nimGCref($1);$n', [rdLoc(src)]) - # elif afSrcIsNil notin flags: - # UseMagic(p.module, 'nimGCref') - # lineF(p, cpsStmts, 'if ($1) nimGCref($1);$n', [rdLoc(src)]) - # if afDestIsNotNil in flags: - # UseMagic(p.module, 'nimGCunref') - # lineF(p, cpsStmts, 'nimGCunref($1);$n', [rdLoc(dest)]) - # elif afDestIsNil notin flags: - # UseMagic(p.module, 'nimGCunref') - # lineF(p, cpsStmts, 'if ($1) nimGCunref($1);$n', [rdLoc(dest)]) - # lineF(p, cpsStmts, '$1 = $2;$n', [rdLoc(dest), rdLoc(src)]) - if canFormAcycle(dest.t): - linefmt(p, cpsStmts, "#asgnRef((void**) $1, $2);$n", - addrLoc(p.config, dest), rdLoc(src)) - else: - linefmt(p, cpsStmts, "#asgnRefNoCycle((void**) $1, $2);$n", - addrLoc(p.config, dest), rdLoc(src)) + linefmt(p, cpsStmts, "#asgnRef((void**) $1, $2);$n", + [addrLoc(p.config, dest), rdLoc(src)]) else: linefmt(p, cpsStmts, "#unsureAsgnRef((void**) $1, $2);$n", - addrLoc(p.config, dest), rdLoc(src)) + [addrLoc(p.config, dest), rdLoc(src)]) proc asgnComplexity(n: PNode): int = if n != nil: @@ -201,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 = @@ -221,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.sons[i] + for i, t in t.ikids: let field = "Field$1" % [i.rope] genAssignment(p, optAsgnLoc(dest, t, field), optAsgnLoc(src, t, field), newflags) @@ -240,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 @@ -254,163 +268,208 @@ proc genGenericAsgn(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = # tfShallow flag for the built-in string type too! So we check only # here for this flag, where it is reasonably safe to do so # (for objects, etc.): - if needToCopy notin flags or + if optSeqDestructors in p.config.globalOptions: + linefmt(p, cpsStmts, + "$1 = $2;$n", + [rdLoc(dest), rdLoc(src)]) + elif needToCopy notin flags or tfShallow in skipTypes(dest.t, abstractVarRange).flags: - if dest.storage == OnStack or not usesNativeGC(p.config): - useStringh(p.module) + if (dest.storage == OnStack and p.config.selectedGC != gcGo) or not usesWriteBarrier(p.config): linefmt(p, cpsStmts, - "memcpy((void*)$1, (NIM_CONST void*)$2, sizeof($3));$n", - addrLoc(p.config, dest), addrLoc(p.config, src), rdLoc(dest)) + "#nimCopyMem((void*)$1, (NIM_CONST void*)$2, sizeof($3));$n", + [addrLoc(p.config, dest), addrLoc(p.config, src), rdLoc(dest)]) else: linefmt(p, cpsStmts, "#genericShallowAssign((void*)$1, (void*)$2, $3);$n", - addrLoc(p.config, dest), addrLoc(p.config, src), genTypeInfo(p.module, dest.t, dest.lode.info)) + [addrLoc(p.config, dest), addrLoc(p.config, src), genTypeInfoV1(p.module, dest.t, dest.lode.info)]) else: linefmt(p, cpsStmts, "#genericAssign((void*)$1, (void*)$2, $3);$n", - addrLoc(p.config, dest), addrLoc(p.config, src), genTypeInfo(p.module, dest.t, dest.lode.info)) + [addrLoc(p.config, dest), addrLoc(p.config, src), genTypeInfoV1(p.module, dest.t, dest.lode.info)]) + +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): + 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 = ($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))]) + of tyString: + let etyp = skipTypes(a.t, abstractInst) + 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 = ($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) proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = # This function replaces all other methods for generating # the assignment operation in C. if src.t != nil and src.t.kind == tyPtr: # little HACK to support the new 'var T' as return type: - linefmt(p, cpsStmts, "$1 = $2;$n", rdLoc(dest), rdLoc(src)) + linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) return let ty = skipTypes(dest.t, abstractRange + tyUserTypeClasses + {tyStatic}) case ty.kind of tyRef: - genRefAssign(p, dest, src, flags) + genRefAssign(p, dest, src) of tySequence: - if (needToCopy notin flags and src.storage != OnStatic) or canMove(src.lode): - genRefAssign(p, dest, src, flags) + 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): + genRefAssign(p, dest, src) else: linefmt(p, cpsStmts, "#genericSeqAssign($1, $2, $3);$n", - addrLoc(p.config, dest), rdLoc(src), - genTypeInfo(p.module, dest.t, dest.lode.info)) + [addrLoc(p.config, dest), rdLoc(src), + genTypeInfoV1(p.module, dest.t, dest.lode.info)]) of tyString: - if (needToCopy notin flags and src.storage != OnStatic) or canMove(src.lode): - genRefAssign(p, dest, src, flags) + if optSeqDestructors in p.config.globalOptions: + genGenericAsgn(p, dest, src, flags) + elif ({needToCopy, needToCopySinkParam} * flags == {} and src.storage != OnStatic) or canMove(p, src.lode, dest): + genRefAssign(p, dest, src) else: - if dest.storage == OnStack or not usesNativeGC(p.config): - linefmt(p, cpsStmts, "$1 = #copyString($2);$n", dest.rdLoc, src.rdLoc) + 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) + [dest.rdLoc, src.rdLoc, tmp.rdLoc]) + linefmt(p, cpsStmts, "if ($1) #nimGCunrefNoCycle($1);$n", [tmp.rdLoc]) else: linefmt(p, cpsStmts, "#unsureAsgnRef((void**) $1, #copyString($2));$n", - addrLoc(p.config, dest), rdLoc(src)) + [addrLoc(p.config, dest), rdLoc(src)]) of tyProc: - if needsComplexAssignment(dest.t): + if containsGarbageCollectedRef(dest.t): # optimize closure assignment: let a = optAsgnLoc(dest, dest.t, "ClE_0".rope) let b = optAsgnLoc(src, dest.t, "ClE_0".rope) - genRefAssign(p, a, b, flags) - linefmt(p, cpsStmts, "$1.ClP_0 = $2.ClP_0;$n", rdLoc(dest), rdLoc(src)) + genRefAssign(p, a, b) + linefmt(p, cpsStmts, "$1.ClP_0 = $2.ClP_0;$n", [rdLoc(dest), rdLoc(src)]) else: - linefmt(p, cpsStmts, "$1 = $2;$n", rdLoc(dest), rdLoc(src)) + linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) of tyTuple: - if needsComplexAssignment(dest.t): - if dest.t.len <= 4: genOptAsgnTuple(p, dest, src, flags) + if containsGarbageCollectedRef(dest.t): + 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)) + linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) of tyObject: # XXX: check for subtyping? if ty.isImportedCppType: - linefmt(p, cpsStmts, "$1 = $2;$n", rdLoc(dest), rdLoc(src)) + linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) elif not isObjLackingTypeField(ty): genGenericAsgn(p, dest, src, flags) - elif needsComplexAssignment(ty): - if ty.sons[0].isNil and asgnComplexity(ty.n) <= 4: + elif containsGarbageCollectedRef(ty): + 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) else: genGenericAsgn(p, dest, src, flags) else: - linefmt(p, cpsStmts, "$1 = $2;$n", rdLoc(dest), rdLoc(src)) + linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) of tyArray: - if needsComplexAssignment(dest.t): + if containsGarbageCollectedRef(dest.t) and p.config.selectedGC notin {gcArc, gcAtomicArc, gcOrc, gcHooks}: genGenericAsgn(p, dest, src, flags) else: - useStringh(p.module) linefmt(p, cpsStmts, - "memcpy((void*)$1, (NIM_CONST void*)$2, sizeof($3));$n", - rdLoc(dest), rdLoc(src), getTypeDesc(p.module, dest.t)) + "#nimCopyMem((void*)$1, (NIM_CONST void*)$2, sizeof($3));$n", + [rdLoc(dest), rdLoc(src), getTypeDesc(p.module, dest.t)]) of tyOpenArray, tyVarargs: # open arrays are always on the stack - really? What if a sequence is # passed to an open array? - if needsComplexAssignment(dest.t): + if reifiedOpenArray(dest.lode): + 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", - addrLoc(p.config, dest), addrLoc(p.config, src), - genTypeInfo(p.module, dest.t, dest.lode.info)) + [addrLoc(p.config, dest), addrLoc(p.config, src), + genTypeInfoV1(p.module, dest.t, dest.lode.info)]) else: - useStringh(p.module) linefmt(p, cpsStmts, - # bug #4799, keep the memcpy for a while - #"memcpy((void*)$1, (NIM_CONST void*)$2, sizeof($1[0])*$1Len_0);$n", + # bug #4799, keep the nimCopyMem for a while + #"#nimCopyMem((void*)$1, (NIM_CONST void*)$2, sizeof($1[0])*$1Len_0);\n", "$1 = $2;$n", - rdLoc(dest), rdLoc(src)) + [rdLoc(dest), rdLoc(src)]) of tySet: - if mapType(p.config, ty) == ctArray: - useStringh(p.module) - linefmt(p, cpsStmts, "memcpy((void*)$1, (NIM_CONST void*)$2, $3);$n", - rdLoc(dest), rdLoc(src), rope(getSize(p.config, dest.t))) + if mapSetType(p.config, ty) == ctArray: + linefmt(p, cpsStmts, "#nimCopyMem((void*)$1, (NIM_CONST void*)$2, $3);$n", + [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, - tyInt..tyUInt64, tyRange, tyVar, tyLent: - linefmt(p, cpsStmts, "$1 = $2;$n", rdLoc(dest), rdLoc(src)) + linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) + 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) if optMemTracker in p.options and dest.storage in {OnHeap, OnUnknown}: #writeStackTrace() #echo p.currLineInfo, " requesting" linefmt(p, cpsStmts, "#memTrackerWrite((void*)$1, $2, $3, $4);$n", - addrLoc(p.config, dest), rope getSize(p.config, dest.t), + [addrLoc(p.config, dest), getSize(p.config, dest.t), makeCString(toFullPath(p.config, p.currLineInfo)), - rope p.currLineInfo.safeLineNm) + p.currLineInfo.safeLineNm]) 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: addrLoc(p.config, a) - var ty = skipTypes(dest.t, abstractVarRange) + var ty = skipTypes(dest.t, abstractVarRange + {tyStatic}) case ty.kind of tyPtr, tyRef, tyProc, tyTuple, tyObject, tyArray: # XXX optimize this linefmt(p, cpsStmts, "#genericDeepCopy((void*)$1, (void*)$2, $3);$n", - addrLoc(p.config, dest), addrLocOrTemp(src), - genTypeInfo(p.module, dest.t, dest.lode.info)) + [addrLoc(p.config, dest), addrLocOrTemp(src), + genTypeInfoV1(p.module, dest.t, dest.lode.info)]) of tySequence, tyString: - linefmt(p, cpsStmts, "#genericSeqDeepCopy($1, $2, $3);$n", - addrLoc(p.config, dest), rdLoc(src), - genTypeInfo(p.module, dest.t, dest.lode.info)) + if optTinyRtti in p.config.globalOptions: + linefmt(p, cpsStmts, "#genericDeepCopy((void*)$1, (void*)$2, $3);$n", + [addrLoc(p.config, dest), addrLocOrTemp(src), + genTypeInfoV1(p.module, dest.t, dest.lode.info)]) + else: + linefmt(p, cpsStmts, "#genericSeqDeepCopy($1, $2, $3);$n", + [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), - genTypeInfo(p.module, dest.t, dest.lode.info)) + "#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 mapType(p.config, ty) == ctArray: - useStringh(p.module) - linefmt(p, cpsStmts, "memcpy((void*)$1, (NIM_CONST void*)$2, $3);$n", - rdLoc(dest), rdLoc(src), rope(getSize(p.config, dest.t))) + if mapSetType(p.config, ty) == ctArray: + linefmt(p, cpsStmts, "#nimCopyMem((void*)$1, (NIM_CONST void*)$2, $3);$n", + [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, + linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) + of tyPointer, tyChar, tyBool, tyEnum, tyCstring, tyInt..tyUInt64, tyRange, tyVar, tyLent: - linefmt(p, cpsStmts, "$1 = $2;$n", rdLoc(dest), rdLoc(src)) + linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) else: internalError(p.config, "genDeepCopy: " & $ty.kind) proc putLocIntoDest(p: BProc, d: var TLoc, s: TLoc) = @@ -421,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: @@ -433,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: @@ -448,245 +505,264 @@ 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, frmt: string) = - var a, b: TLoc +proc binaryStmt(p: BProc, e: PNode, d: var TLoc, op: string) = if d.k != locNone: internalError(p.config, e.info, "binaryStmt") - initLocExpr(p, e.sons[1], a) - initLocExpr(p, e.sons[2], b) - lineCg(p, cpsStmts, frmt, rdLoc(a), rdLoc(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 unaryStmt(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a: TLoc +proc binaryStmtAddr(p: BProc, e: PNode, d: var TLoc, cpname: string) = + if d.k != locNone: internalError(p.config, e.info, "binaryStmtAddr") + 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) = if d.k != locNone: internalError(p.config, e.info, "unaryStmt") - initLocExpr(p, e.sons[1], a) + var a: TLoc = initLocExpr(p, e[1]) lineCg(p, cpsStmts, frmt, [rdLoc(a)]) -proc binaryExpr(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a, b: TLoc - assert(e.sons[1].typ != nil) - assert(e.sons[2].typ != nil) - initLocExpr(p, e.sons[1], a) - initLocExpr(p, e.sons[2], b) +template binaryExpr(p: BProc, e: PNode, d: var TLoc, frmt: string) = + assert(e[1].typ != nil) + assert(e[2].typ != nil) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) putIntoDest(p, d, e, ropecg(p.module, frmt, [rdLoc(a), rdLoc(b)])) -proc binaryExprChar(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a, b: TLoc - assert(e.sons[1].typ != nil) - assert(e.sons[2].typ != nil) - initLocExpr(p, e.sons[1], a) - initLocExpr(p, e.sons[2], b) +template binaryExprChar(p: BProc, e: PNode, d: var TLoc, frmt: string) = + assert(e[1].typ != nil) + assert(e[2].typ != nil) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) putIntoDest(p, d, e, ropecg(p.module, frmt, [a.rdCharLoc, b.rdCharLoc])) -proc unaryExpr(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a: TLoc - initLocExpr(p, e.sons[1], a) +template unaryExpr(p: BProc, e: PNode, d: var TLoc, frmt: string) = + var a: TLoc = initLocExpr(p, e[1]) putIntoDest(p, d, e, ropecg(p.module, frmt, [rdLoc(a)])) -proc unaryExprChar(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a: TLoc - initLocExpr(p, e.sons[1], a) +template unaryExprChar(p: BProc, e: PNode, d: var TLoc, frmt: string) = + var a: TLoc = initLocExpr(p, e[1]) putIntoDest(p, d, e, ropecg(p.module, frmt, [rdCharLoc(a)])) -proc binaryArithOverflowRaw(p: BProc, t: PType, a, b: TLoc; - frmt: string): Rope = +template binaryArithOverflowRaw(p: BProc, t: PType, a, b: TLoc; + cpname: string): Rope = var size = getSize(p.config, t) let storage = if size < p.config.target.intSize: rope("NI") else: getTypeDesc(p.module, t) - result = getTempName(p.module) - linefmt(p, cpsLocals, "$1 $2;$n", storage, result) - lineCg(p, cpsStmts, frmt, result, rdCharLoc(a), rdCharLoc(b)) + var result = getTempName(p.module) + linefmt(p, cpsLocals, "$1 $2;$n", [storage, result]) + 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();$n", - result, intLiteral(firstOrd(p.config, t)), intLiteral(lastOrd(p.config, t))) + 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) = const prc: array[mAddI..mPred, string] = [ - "$# = #addInt($#, $#);$n", "$# = #subInt($#, $#);$n", - "$# = #mulInt($#, $#);$n", "$# = #divInt($#, $#);$n", - "$# = #modInt($#, $#);$n", - "$# = #addInt($#, $#);$n", "$# = #subInt($#, $#);$n"] + "nimAddInt", "nimSubInt", + "nimMulInt", "nimDivInt", "nimModInt", + "nimAddInt", "nimSubInt" + ] prc64: array[mAddI..mPred, string] = [ - "$# = #addInt64($#, $#);$n", "$# = #subInt64($#, $#);$n", - "$# = #mulInt64($#, $#);$n", "$# = #divInt64($#, $#);$n", - "$# = #modInt64($#, $#);$n", - "$# = #addInt64($#, $#);$n", "$# = #subInt64($#, $#);$n"] - opr: array[mAddI..mPred, string] = [ - "($#)($# + $#)", "($#)($# - $#)", "($#)($# * $#)", - "($#)($# / $#)", "($#)($# % $#)", - "($#)($# + $#)", "($#)($# - $#)"] - var a, b: TLoc - assert(e.sons[1].typ != nil) - assert(e.sons[2].typ != nil) - initLocExpr(p, e.sons[1], a) - initLocExpr(p, e.sons[2], b) + "nimAddInt64", "nimSubInt64", + "nimMulInt64", "nimDivInt64", "nimModInt64", + "nimAddInt64", "nimSubInt64" + ] + opr: array[mAddI..mPred, string] = ["+", "-", "*", "/", "%", "+", "-"] + assert(e[1].typ != nil) + assert(e[2].typ != nil) + 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: - let res = opr[m] % [getTypeDesc(p.module, e.typ), rdLoc(a), rdLoc(b)] + 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: - 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]) + # 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}: + 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) = - const - opr: array[mUnaryMinusI..mAbsI, string] = [ - mUnaryMinusI: "((NI$2)-($1))", - mUnaryMinusI64: "-($1)", - mAbsI: "($1 > 0? ($1) : -($1))"] - var - a: TLoc - t: PType - assert(e.sons[1].typ != nil) - initLocExpr(p, e.sons[1], a) + var t: PType + assert(e[1].typ != nil) + var a: TLoc = initLocExpr(p, e[1]) t = skipTypes(e.typ, abstractRange) if optOverflowCheck in p.options: - linefmt(p, cpsStmts, "if ($1 == $2) #raiseOverflow();$n", - rdLoc(a), intLiteral(firstOrd(p.config, t))) - putIntoDest(p, d, e, opr[m] % [rdLoc(a), rope(getSize(p.config, t) * 8)]) + 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)]) + of mUnaryMinusI64: + putIntoDest(p, d, e, "-($1)" % [rdLoc(a)]) + of mAbsI: + putIntoDest(p, d, e, "($1 > 0? ($1) : -($1))" % [rdLoc(a)]) + else: + assert(false, $m) proc binaryArith(p: BProc, e: PNode, d: var TLoc, op: TMagic) = - const - binArithTab: array[mAddF64..mXor, string] = [ - "(($4)($1) + ($4)($2))", # AddF64 - "(($4)($1) - ($4)($2))", # SubF64 - "(($4)($1) * ($4)($2))", # MulF64 - "(($4)($1) / ($4)($2))", # DivF64 - - "($4)((NU$5)($1) >> (NU$3)($2))", # ShrI - "($4)((NU$3)($1) << (NU$3)($2))", # ShlI - "($4)($1 & $2)", # BitandI - "($4)($1 | $2)", # BitorI - "($4)($1 ^ $2)", # BitxorI - "(($1 <= $2) ? $1 : $2)", # MinI - "(($1 >= $2) ? $1 : $2)", # MaxI - "(($1 <= $2) ? $1 : $2)", # MinF64 - "(($1 >= $2) ? $1 : $2)", # MaxF64 - "($4)((NU$3)($1) + (NU$3)($2))", # AddU - "($4)((NU$3)($1) - (NU$3)($2))", # SubU - "($4)((NU$3)($1) * (NU$3)($2))", # MulU - "($4)((NU$3)($1) / (NU$3)($2))", # DivU - "($4)((NU$3)($1) % (NU$3)($2))", # ModU - "($1 == $2)", # EqI - "($1 <= $2)", # LeI - "($1 < $2)", # LtI - "($1 == $2)", # EqF64 - "($1 <= $2)", # LeF64 - "($1 < $2)", # LtF64 - "((NU$3)($1) <= (NU$3)($2))", # LeU - "((NU$3)($1) < (NU$3)($2))", # LtU - "((NU64)($1) <= (NU64)($2))", # LeU64 - "((NU64)($1) < (NU64)($2))", # LtU64 - "($1 == $2)", # EqEnum - "($1 <= $2)", # LeEnum - "($1 < $2)", # LtEnum - "((NU8)($1) == (NU8)($2))", # EqCh - "((NU8)($1) <= (NU8)($2))", # LeCh - "((NU8)($1) < (NU8)($2))", # LtCh - "($1 == $2)", # EqB - "($1 <= $2)", # LeB - "($1 < $2)", # LtB - "($1 == $2)", # EqRef - "($1 == $2)", # EqPtr - "($1 <= $2)", # LePtr - "($1 < $2)", # LtPtr - "($1 != $2)"] # Xor var - a, b: TLoc - s, k: BiggestInt - assert(e.sons[1].typ != nil) - assert(e.sons[2].typ != nil) - initLocExpr(p, e.sons[1], a) - initLocExpr(p, e.sons[2], b) + s, k: BiggestInt = 0 + assert(e[1].typ != nil) + assert(e[2].typ != nil) + 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 - putIntoDest(p, d, e, - binArithTab[op] % [rdLoc(a), rdLoc(b), rope(s), - getSimpleTypeDesc(p.module, e.typ), rope(k)]) + + template applyFormat(frmt: untyped) = + putIntoDest(p, d, e, frmt % [ + rdLoc(a), rdLoc(b), rope(s), + getSimpleTypeDesc(p.module, e.typ), rope(k)] + ) + + case op + of mAddF64: applyFormat("(($4)($1) + ($4)($2))") + of mSubF64: applyFormat("(($4)($1) - ($4)($2))") + of mMulF64: applyFormat("(($4)($1) * ($4)($2))") + of mDivF64: applyFormat("(($4)($1) / ($4)($2))") + of mShrI: applyFormat("($4)((NU$5)($1) >> (NU$3)($2))") + of mShlI: applyFormat("($4)((NU$3)($1) << (NU$3)($2))") + of mAshrI: applyFormat("($4)((NI$3)($1) >> (NU$3)($2))") + of mBitandI: applyFormat("($4)($1 & $2)") + of mBitorI: applyFormat("($4)($1 | $2)") + of mBitxorI: applyFormat("($4)($1 ^ $2)") + of mMinI: applyFormat("(($1 <= $2) ? $1 : $2)") + of mMaxI: applyFormat("(($1 >= $2) ? $1 : $2)") + of mAddU: applyFormat("($4)((NU$3)($1) + (NU$3)($2))") + of mSubU: applyFormat("($4)((NU$3)($1) - (NU$3)($2))") + of mMulU: applyFormat("($4)((NU$3)($1) * (NU$3)($2))") + of mDivU: applyFormat("($4)((NU$3)($1) / (NU$3)($2))") + of mModU: applyFormat("($4)((NU$3)($1) % (NU$3)($2))") + of mEqI: applyFormat("($1 == $2)") + of mLeI: applyFormat("($1 <= $2)") + of mLtI: applyFormat("($1 < $2)") + of mEqF64: applyFormat("($1 == $2)") + of mLeF64: applyFormat("($1 <= $2)") + of mLtF64: applyFormat("($1 < $2)") + of mLeU: applyFormat("((NU$3)($1) <= (NU$3)($2))") + of mLtU: applyFormat("((NU$3)($1) < (NU$3)($2))") + of mEqEnum: applyFormat("($1 == $2)") + of mLeEnum: applyFormat("($1 <= $2)") + of mLtEnum: applyFormat("($1 < $2)") + of mEqCh: applyFormat("((NU8)($1) == (NU8)($2))") + of mLeCh: applyFormat("((NU8)($1) <= (NU8)($2))") + of mLtCh: applyFormat("((NU8)($1) < (NU8)($2))") + of mEqB: applyFormat("($1 == $2)") + of mLeB: applyFormat("($1 <= $2)") + of mLtB: applyFormat("($1 < $2)") + of mEqRef: applyFormat("($1 == $2)") + of mLePtr: applyFormat("($1 <= $2)") + of mLtPtr: applyFormat("($1 < $2)") + of mXor: applyFormat("($1 != $2)") + else: + assert(false, $op) proc genEqProc(p: BProc, e: PNode, d: var TLoc) = - var a, b: TLoc - assert(e.sons[1].typ != nil) - assert(e.sons[2].typ != nil) - initLocExpr(p, e.sons[1], a) - initLocExpr(p, e.sons[2], b) - if a.t.skipTypes(abstractInst).callConv == ccClosure: + assert(e[1].typ != nil) + assert(e[2].typ != nil) + 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)]) else: putIntoDest(p, d, e, "($1 == $2)" % [rdLoc(a), rdLoc(b)]) proc genIsNil(p: BProc, e: PNode, d: var TLoc) = - let t = skipTypes(e.sons[1].typ, abstractRange) + let t = skipTypes(e[1].typ, abstractRange) if t.kind == tyProc and t.callConv == ccClosure: unaryExpr(p, e, d, "($1.ClP_0 == 0)") else: unaryExpr(p, e, d, "($1 == 0)") proc unaryArith(p: BProc, e: PNode, d: var TLoc, op: TMagic) = - const - unArithTab: array[mNot..mToBiggestInt, string] = ["!($1)", # Not - "$1", # UnaryPlusI - "($3)((NU$2) ~($1))", # BitnotI - "$1", # UnaryPlusF64 - "-($1)", # UnaryMinusF64 - "($1 < 0? -($1) : ($1))", # AbsF64; BUGFIX: fabs() makes problems - # for Tiny C, so we don't use it - "(($3)(NU)(NU8)($1))", # mZe8ToI - "(($3)(NU64)(NU8)($1))", # mZe8ToI64 - "(($3)(NU)(NU16)($1))", # mZe16ToI - "(($3)(NU64)(NU16)($1))", # mZe16ToI64 - "(($3)(NU64)(NU32)($1))", # mZe32ToI64 - "(($3)(NU64)(NU)($1))", # mZeIToI64 - "(($3)(NU8)(NU)($1))", # ToU8 - "(($3)(NU16)(NU)($1))", # ToU16 - "(($3)(NU32)(NU64)($1))", # ToU32 - "((double) ($1))", # ToFloat - "((double) ($1))", # ToBiggestFloat - "float64ToInt32($1)", # ToInt - "float64ToInt64($1)"] # ToBiggestInt var - a: TLoc t: PType - assert(e.sons[1].typ != nil) - initLocExpr(p, e.sons[1], a) + assert(e[1].typ != nil) + var a = initLocExpr(p, e[1]) t = skipTypes(e.typ, abstractRange) - putIntoDest(p, d, e, - unArithTab[op] % [rdLoc(a), rope(getSize(p.config, t) * 8), + + template applyFormat(frmt: untyped) = + putIntoDest(p, d, e, frmt % [rdLoc(a), rope(getSize(p.config, t) * 8), getSimpleTypeDesc(p.module, e.typ)]) + case op + of mNot: + applyFormat("!($1)") + of mUnaryPlusI: + applyFormat("$1") + of mBitnotI: + applyFormat("($3)((NU$2) ~($1))") + of mUnaryPlusF64: + applyFormat("$1") + of mUnaryMinusF64: + applyFormat("-($1)") + else: + assert false, $op proc isCppRef(p: BProc; typ: PType): bool {.inline.} = result = p.module.compileToCpp and - skipTypes(typ, abstractInst).kind == tyVar and - tfVarIsPtr notin skipTypes(typ, abstractInst).flags + skipTypes(typ, abstractInstOwned).kind in {tyVar} and + tfVarIsPtr notin skipTypes(typ, abstractInstOwned).flags -proc genDeref(p: BProc, e: PNode, d: var TLoc; enforceDeref=false) = - let mt = mapType(p.config, e.sons[0].typ) - if mt in {ctArray, ctPtrToArray} and not enforceDeref: +proc genDeref(p: BProc, e: PNode, d: var TLoc) = + 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? - #if e[0].kind != nkBracketExpr: - # message(e.info, warnUser, "CAME HERE " & renderTree(e)) - expr(p, e.sons[0], d) - if e.sons[0].typ.skipTypes(abstractInst).kind == tyRef: + expr(p, e[0], d) + if e[0].typ.skipTypes(abstractInstOwned).kind == tyRef: d.storage = OnHeap else: var a: TLoc - var typ = e.sons[0].typ + var typ = e[0].typ if typ.kind in {tyUserTypeClass, tyUserTypeClassInst} and typ.isResolvedUserTypeClass: - typ = typ.lastSon - typ = typ.skipTypes(abstractInst) - if typ.kind == tyVar and tfVarIsPtr notin typ.flags and p.module.compileToCpp and e.sons[0].kind == nkHiddenAddr: - initLocExprSingleUse(p, e[0][0], d) + typ = typ.last + typ = typ.skipTypes(abstractInstOwned) + if typ.kind in {tyVar} and tfVarIsPtr notin typ.flags and p.module.compileToCpp and e[0].kind == nkHiddenAddr: + d = initLocExprSingleUse(p, e[0][0]) return else: - initLocExprSingleUse(p, e.sons[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 @@ -705,63 +781,73 @@ proc genDeref(p: BProc, e: PNode, d: var TLoc; enforceDeref=false) = else: internalError(p.config, e.info, "genDeref " & $typ.kind) elif p.module.compileToCpp: - if typ.kind == tyVar and tfVarIsPtr notin typ.flags and + if typ.kind in {tyVar} and tfVarIsPtr notin typ.flags and e.kind == nkHiddenDeref: putIntoDest(p, d, e, rdLoc(a), a.storage) return - if enforceDeref and mt == ctPtrToArray: + if mt == ctPtrToArray and lfEnforceDeref in d.flags: # we lie about the type for better C interop: 'ptr array[3,T]' is # translated to 'ptr T', but for deref'ing this produces wrong code. # See tmissingderef. So we get rid of the deref instead. The codegen # ends up using 'memcpy' for the array assignment, # so the '&' and '*' cancel out: - putIntoDest(p, d, lodeTyp(a.t.sons[0]), rdLoc(a), a.storage) + putIntoDest(p, d, e, rdLoc(a), a.storage) else: putIntoDest(p, d, e, "(*$1)" % [rdLoc(a)], a.storage) +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) + linefmt(p, cpsStmts, "#nimPrepareStrMutationV2($1);$n", [byRefLoc(p, a)]) + +proc cow(p: BProc; n: PNode) {.inline.} = + if n.kind == nkHiddenAddr: cowBracket(p, n[0]) + proc genAddr(p: BProc, e: PNode, d: var TLoc) = # careful 'addr(myptrToArray)' needs to get the ampersand: - if e.sons[0].typ.skipTypes(abstractInst).kind in {tyRef, tyPtr}: - var a: TLoc - initLocExpr(p, e.sons[0], a) - putIntoDest(p, d, e, "&" & a.r, a.storage) + if e[0].typ.skipTypes(abstractInstOwned).kind in {tyRef, tyPtr}: + 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.sons[0].typ) == ctArray or isCppRef(p, e.sons[0].typ): - expr(p, e.sons[0], d) + 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.sons[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.sons[0], a) - if e.sons[1].kind != nkSym: internalError(p.config, e.info, "genRecordFieldAux") +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.sons[0], a) - let tupType = a.t.skipTypes(abstractInst) + i: int = 0 + var a: TLoc = initLocExpr(p, e[0]) + let tupType = a.t.skipTypes(abstractInst+{tyVar}) assert tupType.kind == tyTuple d.inheritLocation(a) discard getTypeDesc(p.module, a.t) # fill the record's fields.loc var r = rdLoc(a) - case e.sons[1].kind - of nkIntLit..nkUInt64Lit: i = int(e.sons[1].intVal) + case e[1].kind + of nkIntLit..nkUInt64Lit: i = int(e[1].intVal) else: internalError(p.config, e.info, "genTupleElem") - addf(r, ".Field$1", [rope(i)]) + r.addf(".Field$1", [rope(i)]) putIntoDest(p, d, e, r, a.storage) 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}) @@ -769,177 +855,290 @@ proc lookupFieldAgain(p: BProc, ty: PType; field: PSym; r: var Rope; if result != nil: if resTyp != nil: resTyp[] = ty break - if not p.module.compileToCpp: add(r, ".Sup") - ty = ty.sons[0] + if not p.module.compileToCpp: r.add(".Sup") + ty = ty[0] 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.sons[1].sym - let ty = skipTypes(a.t, abstractInst + tyUserTypeClasses) + var f = e[1].sym + let ty = skipTypes(a.t, abstractInstOwned + tyUserTypeClasses) if ty.kind == tyTuple: # we found a unique tuple type which lacks field information # so we use Field$i - addf(r, ".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)) - addf(r, ".$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) proc genFieldCheck(p: BProc, e: PNode, obj: Rope, field: PSym) = var test, u, v: TLoc - for i in countup(1, sonsLen(e) - 1): - var it = e.sons[i] + for i in 1..<e.len: + var it = e[i] assert(it.kind in nkCallKinds) - assert(it.sons[0].kind == nkSym) - let op = it.sons[0].sym - if op.magic == mNot: it = it.sons[1] - let disc = it.sons[2].skipConv + assert(it[0].kind == nkSym) + let op = it[0].sym + if op.magic == mNot: it = it[1] + let disc = it[2].skipConv assert(disc.kind == nkSym) - initLoc(test, locNone, it, OnStack) - initLocExpr(p, it.sons[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 id = nodeTableTestOrSet(p.module.dataCache, - newStrNode(nkStrLit, field.name.s), p.module.labels) - let strLit = if id == p.module.labels: genStringLiteralDataOnly(p.module, field.name.s, e.info) - else: p.module.tmpBase & rope(id) - if op.magic == mNot: - linefmt(p, cpsStmts, - "if ($1) #raiseFieldError($2);$n", - rdLoc(test), genStringLiteralFromData(p.module, strLit, e.info)) + 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);$n", - rdLoc(test), genStringLiteralFromData(p.module, strLit, e.info)) + # 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 - genRecordFieldAux(p, e.sons[0], d, a) + 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.sons[0].sons[1].sym + 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) - add(r, ropecg(p.module, ".$1", field.loc.r)) - putIntoDest(p, d, e.sons[0], r, a.storage) + r.add(".") + r.add field.loc.snippet + putIntoDest(p, d, e[0], r, a.storage) + r.freeze else: - genRecordField(p, e.sons[0], d) + genRecordField(p, e[0], d) + +proc genUncheckedArrayElem(p: BProc, n, x, y: PNode, d: var TLoc) = + 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 tfUncheckedArray notin ty.flags: + 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)) #raiseIndexError();$n", - rdCharLoc(b), intLiteral(lastOrd(p.config, ty))) + 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) #raiseIndexError();$n", - rdCharLoc(b), first, intLiteral(lastOrd(p.config, ty))) + 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): - localError(p.config, x.info, "index out of bounds") + localError(p.config, x.info, formatErrorIndexBound(idx, firstOrd(p.config, ty), lastOrd(p.config, ty))) d.inheritLocation(a) putIntoDest(p, d, n, - ropecg(p.module, "$1[($2)- $3]", rdLoc(a), rdCharLoc(b), first), a.storage) + 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 ty = skipTypes(a.t, abstractVarRange) + 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) + 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: - linefmt(p, cpsStmts, - "if ($2-$1 != -1 && " & - "((NU)($1) >= (NU)($3Len_0) || (NU)($2) >= (NU)($3Len_0))) #raiseIndexError();$n", - rdLoc(a), rdLoc(b), rdLoc(arr)) - of tyArray: - let first = intLiteral(firstOrd(p.config, ty)) - if tfUncheckedArray notin ty.flags: + if reifiedOpenArray(arr.lode): linefmt(p, cpsStmts, "if ($2-$1 != -1 && " & - "($2-$1 < -1 || $1 < $3 || $1 > $4 || $2 < $3 || $2 > $4)) #raiseIndexError();$n", - rdCharLoc(a), rdCharLoc(b), first, intLiteral(lastOrd(p.config, ty))) + "($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 && ($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: + 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(); ", + [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 && " & - "(!$3 || (NU)($1) >= (NU)($3->$4) || (NU)($2) >= (NU)($3->$4))) #raiseIndexError();$n", - rdLoc(a), rdLoc(b), rdLoc(arr), lenField(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) # emit range check: - if optBoundsCheck in p.options: - linefmt(p, cpsStmts, "if ((NU)($1) >= (NU)($2Len_0)) #raiseIndexError();$n", - rdLoc(b), rdLoc(a)) # BUGFIX: ``>=`` and not ``>``! - inheritLocation(d, a) - putIntoDest(p, d, n, - ropecg(p.module, "$1[$2]", rdLoc(a), rdCharLoc(b)), a.storage) + 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 ($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 ($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: - if ty.kind == tyString and (not defined(nimNoZeroTerminator) or optLaxStrings in p.options): - linefmt(p, cpsStmts, - "if (!$2 || (NU)($1) > (NU)($2->$3)) #raiseIndexError();$n", - rdLoc(b), rdLoc(a), lenField(p)) - else: - linefmt(p, cpsStmts, - "if (!$2 || (NU)($1) >= (NU)($2->$3)) #raiseIndexError();$n", - rdLoc(b), rdLoc(a), lenField(p)) + linefmt(p, cpsStmts, + "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: + linefmt(p, cpsStmts, "#nimPrepareStrMutationV2($1);$n", [byRefLoc(p, a)]) putIntoDest(p, d, n, - ropecg(p.module, "$1->data[$2]", rdLoc(a), rdCharLoc(b)), a.storage) + ropecg(p.module, "$1$3[$2]", [rdLoc(a), rdCharLoc(b), dataField(p)]), a.storage) proc genBracketExpr(p: BProc; n: PNode; d: var TLoc) = - var ty = skipTypes(n.sons[0].typ, abstractVarRange + tyUserTypeClasses) - if ty.kind in {tyRef, tyPtr}: ty = skipTypes(ty.lastSon, abstractVarRange) + var ty = skipTypes(n[0].typ, abstractVarRange + tyUserTypeClasses) + if ty.kind in {tyRef, tyPtr}: ty = skipTypes(ty.elementType, abstractVarRange) case ty.kind - of tyArray: genArrayElem(p, n, n.sons[0], n.sons[1], d) - of tyOpenArray, tyVarargs: genOpenArrayElem(p, n, n.sons[0], n.sons[1], d) - of tySequence, tyString: genSeqElem(p, n, n.sons[0], n.sons[1], d) - of tyCString: genCStringElem(p, n, n.sons[0], n.sons[1], d) + 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 tyTuple: genTupleElem(p, n, d) else: internalError(p.config, n.info, "expr(nkBracketExpr, " & $ty.kind & ')') + discard getTypeDesc(p.module, n.typ) + +proc isSimpleExpr(n: PNode): bool = + # calls all the way down --> can stay expression based + case n.kind + of nkCallKinds, nkDotExpr, nkPar, nkTupleConstr, + nkObjConstr, nkBracket, nkCurly, nkHiddenDeref, nkDerefExpr, nkHiddenAddr, + nkHiddenStdConv, nkHiddenSubConv, nkConv, nkAddr: + for c in n: + if not isSimpleExpr(c): return false + result = true + of nkStmtListExpr: + for i in 0..<n.len-1: + if n[i].kind notin {nkCommentStmt, nkEmpty}: return false + result = isSimpleExpr(n.lastSon) + else: + result = n.isAtom proc genAndOr(p: BProc, e: PNode, d: var TLoc, m: TMagic) = # how to generate code? @@ -962,60 +1161,87 @@ proc genAndOr(p: BProc, e: PNode, d: var TLoc, m: TMagic) = # tmp = a # end: # a = tmp - var - L: TLabel - tmp: TLoc - getTemp(p, e.typ, tmp) # force it into a temp! - inc p.splitDecls - expr(p, e.sons[1], tmp) - L = getLabel(p) - if m == mOr: - lineF(p, cpsStmts, "if ($1) goto $2;$n", [rdLoc(tmp), L]) - else: - lineF(p, cpsStmts, "if (!($1)) goto $2;$n", [rdLoc(tmp), L]) - expr(p, e.sons[2], tmp) - fixLabel(p, L) - if d.k == locNone: - d = tmp + when false: + #if isSimpleExpr(e) and p.module.compileToCpp: + #getTemp(p, e.typ, tmpA) + #getTemp(p, e.typ, tmpB) + var tmpA = initLocExprSingleUse(p, e[1]) + var tmpB = initLocExprSingleUse(p, e[2]) + tmpB.k = locExpr + if m == mOr: + tmpB.snippet = "((" & rdLoc(tmpA) & ")||(" & rdLoc(tmpB) & "))" + else: + tmpB.snippet = "((" & rdLoc(tmpA) & ")&&(" & rdLoc(tmpB) & "))" + if d.k == locNone: + d = tmpB + else: + genAssignment(p, d, tmpB, {}) else: - genAssignment(p, d, tmp, {}) # no need for deep copying - dec p.splitDecls + var + L: TLabel + var tmp: TLoc = getTemp(p, e.typ) # force it into a temp! + inc p.splitDecls + expr(p, e[1], tmp) + L = getLabel(p) + if m == mOr: + lineF(p, cpsStmts, "if ($1) goto $2;$n", [rdLoc(tmp), L]) + else: + lineF(p, cpsStmts, "if (!($1)) goto $2;$n", [rdLoc(tmp), L]) + expr(p, e[2], tmp) + fixLabel(p, L) + if d.k == locNone: + d = tmp + else: + genAssignment(p, d, tmp, {}) # no need for deep copying + dec p.splitDecls proc genEcho(p: BProc, n: PNode) = - # this unusal way of implementing it ensures that e.g. ``echo("hallo", 45)`` + # this unusual way of implementing it ensures that e.g. ``echo("hallo", 45)`` # is threadsafe. internalAssert p.config, n.kind == nkBracket if p.config.target.targetOS == osGenode: - # bypass libc and print directly to the Genode LOG session - var args: Rope = nil + # echo directly to the Genode LOG session + var args: Rope = "" var a: TLoc - for it in n.sons: + for i, it in n.sons: if it.skipConv.kind == nkNilLit: - add(args, ", \"\"") - else: - initLocExpr(p, it, a) - addf(args, ", $1? ($1)->data:\"\"", [rdLoc(a)]) + args.add(", \"\"") + 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>") - linefmt(p, cpsStmts, """Genode::log(""$1);$n""", args) + p.module.includeHeader("<util/string.h>") + linefmt(p, cpsStmts, """Genode::log($1);$n""", [args]) else: if n.len == 0: - linefmt(p, cpsStmts, "#echoBinSafe(NIM_NIL, $1);$n", n.len.rope) + linefmt(p, cpsStmts, "#echoBinSafe(NIM_NIL, $1);$n", [n.len]) else: - var a: TLoc - initLocExpr(p, n, a) - linefmt(p, cpsStmts, "#echoBinSafe($1, $2);$n", a.rdLoc, n.len.rope) + var a: TLoc = initLocExpr(p, n) + linefmt(p, cpsStmts, "#echoBinSafe($1, $2);$n", [a.rdLoc, n.len]) when false: p.module.includeHeader("<stdio.h>") linefmt(p, cpsStmts, "printf($1$2);$n", - makeCString(repeat("%s", n.len) & "\L"), args) - linefmt(p, cpsStmts, "fflush(stdout);$n") + makeCString(repeat("%s", n.len) & "\L"), [args]) + linefmt(p, cpsStmts, "fflush(stdout);$n", []) proc gcUsage(conf: ConfigRef; n: PNode) = if conf.selectedGC == gcNone: message(conf, n.info, warnGcMem, n.renderTree) +proc strLoc(p: BProc; d: TLoc): Rope = + if optSeqDestructors in p.config.globalOptions: + result = byRefLoc(p, d) + else: + result = rdLoc(d) + 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> # { @@ -1030,25 +1256,26 @@ 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 - for i in countup(0, sonsLen(e) - 2): + var appends: Rope = "" + var lens: Rope = "" + for i in 0..<e.len - 1: # compute the length expression: - initLocExpr(p, e.sons[i + 1], a) - if skipTypes(e.sons[i + 1].typ, abstractVarRange).kind == tyChar: + a = initLocExpr(p, e[i + 1]) + if skipTypes(e[i + 1].typ, abstractVarRange).kind == tyChar: inc(L) - add(appends, ropecg(p.module, "#appendChar($1, $2);$n", tmp.r, rdLoc(a))) + appends.add(ropecg(p.module, "#appendChar($1, $2);$n", [strLoc(p, tmp), rdLoc(a)])) else: - if e.sons[i + 1].kind in {nkStrLit..nkTripleStrLit}: - inc(L, len(e.sons[i + 1].strVal)) + if e[i + 1].kind in {nkStrLit..nkTripleStrLit}: + inc(L, e[i + 1].strVal.len) else: - addf(lens, "($1 ? $1->$2 : 0) + ", [rdLoc(a), lenField(p)]) - add(appends, ropecg(p.module, "#appendString($1, $2);$n", tmp.r, rdLoc(a))) - linefmt(p, cpsStmts, "$1 = #rawNewString($2$3);$n", tmp.r, lens, rope(L)) - add(p.s(cpsStmts), appends) + 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.snippet, lens, L]) + p.s(cpsStmts).add appends if d.k == locNone: d = tmp else: @@ -1057,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> # { @@ -1068,158 +1295,250 @@ proc genStrAppend(p: BProc, e: PNode, d: var TLoc) = # appendChar(s, 'z'); # } var - a, dest: TLoc - appends, lens: Rope + a, call: TLoc + appends, lens: Rope = "" assert(d.k == locNone) var L = 0 - initLocExpr(p, e.sons[1], dest) - for i in countup(0, sonsLen(e) - 3): + var dest = initLocExpr(p, e[1]) + for i in 0..<e.len - 2: # compute the length expression: - initLocExpr(p, e.sons[i + 2], a) - if skipTypes(e.sons[i + 2].typ, abstractVarRange).kind == tyChar: + a = initLocExpr(p, e[i + 2]) + if skipTypes(e[i + 2].typ, abstractVarRange).kind == tyChar: inc(L) - add(appends, ropecg(p.module, "#appendChar($1, $2);$n", - rdLoc(dest), rdLoc(a))) + appends.add(ropecg(p.module, "#appendChar($1, $2);$n", + [strLoc(p, dest), rdLoc(a)])) else: - if e.sons[i + 2].kind in {nkStrLit..nkTripleStrLit}: - inc(L, len(e.sons[i + 2].strVal)) + if e[i + 2].kind in {nkStrLit..nkTripleStrLit}: + inc(L, e[i + 2].strVal.len) else: - addf(lens, "($1 ? $1->$2 : 0) + ", [rdLoc(a), lenField(p)]) - add(appends, ropecg(p.module, "#appendString($1, $2);$n", - rdLoc(dest), rdLoc(a))) - linefmt(p, cpsStmts, "$1 = #resizeString($1, $2$3);$n", - rdLoc(dest), lens, rope(L)) - add(p.s(cpsStmts), appends) - gcUsage(p.config, e) + lens.add(lenExpr(p, a)) + lens.add(" + ") + appends.add(ropecg(p.module, "#appendString($1, $2);$n", + [strLoc(p, dest), rdLoc(a)])) + if optSeqDestructors in p.config.globalOptions: + linefmt(p, cpsStmts, "#prepareAdd($1, $2$3);$n", + [byRefLoc(p, dest), lens, L]) + else: + 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 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; - let seqAppendPattern = if not p.module.compileToCpp: - "$1 = ($2) #incrSeqV3(&($1)->Sup, $3);$n" - else: - "$1 = ($2) #incrSeqV3($1, $3);$n" - var a, b, dest, tmpL: TLoc - initLocExpr(p, e.sons[1], a) - initLocExpr(p, e.sons[2], b) - let seqType = skipTypes(e.sons[1].typ, {tyVar}) - lineCg(p, cpsStmts, seqAppendPattern, [ - rdLoc(a), - getTypeDesc(p.module, e.sons[1].typ), - genTypeInfo(p.module, seqType, e.info)]) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) + let seqType = skipTypes(e[1].typ, {tyVar}) + var call = initLoc(locCall, e, OnHeap) + if not p.module.compileToCpp: + const seqAppendPattern = "($2) #incrSeqV3((TGenericSeq*)($1), $3)" + 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.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 + # use 'genRefAssign' for the seq. + genRefAssign(p, a, call) #if bt != b.t: # echo "YES ", e.info, " new: ", typeToString(bt), " old: ", typeToString(b.t) - initLoc(dest, locExpr, e.sons[2], OnHeap) - getIntTemp(p, tmpL) - lineCg(p, cpsStmts, "$1 = $2->$3++;$n", tmpL.r, rdLoc(a), lenField(p)) - dest.r = ropecg(p.module, "$1->data[$2]", rdLoc(a), tmpL.r) - genAssignment(p, dest, b, {needToCopy, afDestIsNil}) + 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.sons[1], a) - linefmt(p, cpsStmts, "#genericReset((void*)$1, $2);$n", - addrLoc(p.config, a), - genTypeInfo(p.module, skipTypes(a.t, {tyVar}), n.info)) +proc genDefault(p: BProc; n: PNode; d: var TLoc) = + if d.k == locNone: d = getTemp(p, n.typ, needsInit=true) + else: resetLoc(p, d) -proc rawGenNew(p: BProc, a: TLoc, sizeExpr: Rope) = +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) - let refType = typ.skipTypes(abstractInst) + var b: TLoc = initLoc(locExpr, a.lode, OnHeap) + let refType = typ.skipTypes(abstractInstOwned) assert refType.kind == tyRef - let bt = refType.lastSon - if sizeExpr.isNil: - sizeExpr = "sizeof($1)" % - [getTypeDesc(p.module, bt)] - let args = [getTypeDesc(p.module, typ), - genTypeInfo(p.module, typ, a.lode.info), - sizeExpr] - if a.storage == OnHeap and usesNativeGC(p.config): - # use newObjRC1 as an optimization - if canFormAcycle(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) - b.r = ropecg(p.module, "($1) #newObjRC1($2, $3)", args) - linefmt(p, cpsStmts, "$1 = $2;$n", a.rdLoc, b.rdLoc) - else: - b.r = ropecg(p.module, "($1) #newObj($2, $3)", args) - genAssignment(p, a, b, {}) # set the object type: - genObjectInit(p, cpsStmts, bt, a, false) + let bt = refType.elementType + if sizeExpr == "": + sizeExpr = "sizeof($1)" % [getTypeDesc(p.module, bt)] + + if optTinyRtti in p.config.globalOptions: + if needsInit: + b.snippet = ropecg(p.module, "($1) #nimNewObj($2, NIM_ALIGNOF($3))", + [getTypeDesc(p.module, typ), sizeExpr, getTypeDesc(p.module, bt)]) + else: + 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: + let ti = genTypeInfoV1(p.module, typ, a.lode.info) + let op = getAttachedOp(p.module.g.graph, bt, attachedDestructor) + if op != nil and not isTrivialProc(p.module.g.graph, op): + # the prototype of a destructor is ``=destroy(x: var T)`` and that of a + # finalizer is: ``proc (x: ref T) {.nimcall.}``. We need to check the calling + # convention at least: + if op.typ == nil or op.typ.callConv != ccNimCall: + localError(p.module.config, a.lode.info, + "the destructor that is turned into a finalizer needs " & + "to have the 'nimcall' calling convention") + 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(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.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.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.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.sons[1], a) + var a: TLoc = initLocExpr(p, e[1]) # 'genNew' also handles 'unsafeNew': if e.len == 3: - var se: TLoc - initLocExpr(p, e.sons[2], se) - rawGenNew(p, a, se.rdLoc) + var se: TLoc = initLocExpr(p, e[2]) + rawGenNew(p, a, se.rdLoc, needsInit = true) else: - rawGenNew(p, a, nil) + rawGenNew(p, a, "", needsInit = true) gcUsage(p.config, e) -proc genNewSeqAux(p: BProc, dest: TLoc, length: Rope) = +proc genNewSeqAux(p: BProc, dest: TLoc, length: Rope; lenIsZero: bool) = let seqtype = skipTypes(dest.t, abstractVarRange) - let args = [getTypeDesc(p.module, seqtype), - genTypeInfo(p.module, seqtype, dest.lode.info), length] - var call: TLoc - initLoc(call, locExpr, dest.lode, OnHeap) - if dest.storage == OnHeap and usesNativeGC(p.config): - if canFormAcycle(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) - call.r = ropecg(p.module, "($1) #newSeqRC1($2, $3)", args) - linefmt(p, cpsStmts, "$1 = $2;$n", dest.rdLoc, call.rdLoc) - else: - call.r = ropecg(p.module, "($1) #newSeq($2, $3)", args) + var call: TLoc = initLoc(locExpr, dest.lode, OnHeap) + if dest.storage == OnHeap and usesWriteBarrier(p.config): + 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.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.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.snippet = rope"NIM_NIL" + else: + 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.sons[1], a) - initLocExpr(p, e.sons[2], b) - genNewSeqAux(p, a, b.rdLoc) - gcUsage(p.config, e) + 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.elementType), + getSeqPayloadType(p.module, seqtype)]) + else: + let lenIsZero = e[2].kind == nkIntLit and e[2].intVal == 0 + genNewSeqAux(p, a, b.rdLoc, lenIsZero) + gcUsage(p.config, e) proc genNewSeqOfCap(p: BProc; e: PNode; d: var TLoc) = let seqtype = skipTypes(e.typ, abstractVarRange) - var a: TLoc - initLocExpr(p, e.sons[1], a) - putIntoDest(p, d, e, ropecg(p.module, - "($1)#nimNewSeqOfCap($2, $3)", [ - getTypeDesc(p.module, seqtype), - genTypeInfo(p.module, seqtype, e.info), a.rdLoc])) - gcUsage(p.config, e) + var a: TLoc = initLocExpr(p, e[1]) + if optSeqDestructors in p.config.globalOptions: + if d.k == locNone: d = getTemp(p, e.typ, needsInit=false) + linefmt(p, cpsStmts, "$1.len = 0; $1.p = ($4*) #newSeqPayloadUninit($2, sizeof($3), NIM_ALIGNOF($3));$n", + [d.rdLoc, a.rdLoc, getTypeDesc(p.module, seqtype.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), + genTypeInfoV1(p.module, seqtype, e.info), a.rdLoc])) + gcUsage(p.config, e) + +proc rawConstExpr(p: BProc, n: PNode; d: var TLoc) = + let t = n.typ + discard getTypeDesc(p.module, t) # so that any fields are initialized + let id = nodeTableTestOrSet(p.module.dataCache, n, p.module.labels) + fillLoc(d, locData, n, p.module.tmpBase & rope(id), OnStatic) + if id == p.module.labels: + # expression not found in the cache: + inc(p.module.labels) + 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 genConstExpr(p: BProc, n: PNode): Rope proc handleConstExpr(p: BProc, n: PNode, d: var TLoc): bool = if d.k == locNone and n.len > ord(n.kind == nkObjConstr) and n.isDeepConstExpr: - let t = n.typ - discard getTypeDesc(p.module, t) # so that any fields are initialized - let id = nodeTableTestOrSet(p.module.dataCache, n, p.module.labels) - fillLoc(d, locData, n, p.module.tmpBase & rope(id), OnStatic) - if id == p.module.labels: - # expression not found in the cache: - inc(p.module.labels) - addf(p.module.s[cfsData], "NIM_CONST $1 $2 = $3;$n", - [getTypeDesc(p.module, t), d.r, genConstExpr(p, n)]) + rawConstExpr(p, n, d) result = true 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: + if not p.module.compileToCpp and optSeqDestructors notin p.config.globalOptions: + # disabled optimization: it is wrong for C++ and now also + # causes trouble for --gc:arc, see bug #13240 + #[ + var box: seq[Thing] + for i in 0..3: + box.add Thing(s1: "121") # pass by sink can mutate Thing. + ]# if handleConstExpr(p, e, d): return - var t = e.typ.skipTypes(abstractInst) + var t = e.typ.skipTypes(abstractInstOwned) let isRef = t.kind == tyRef # check if we need to construct the object in a temporary @@ -1228,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) - t = t.lastSon.skipTypes(abstractInst) + 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.sons[i] - var tmp2: TLoc - tmp2.r = r - let field = lookupFieldAgain(p, ty, it.sons[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.sons[2], r, field) - add(tmp2.r, ".") - add(tmp2.r, 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.sons[1] - expr(p, it.sons[1], tmp2) + for i in 1..<e.len: + 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 @@ -1271,23 +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) - # generate call to newSeq before adding the elements per hand: - genNewSeqAux(p, dest[], intLiteral(sonsLen(n))) - for i in countup(0, sonsLen(n) - 1): - initLoc(arr, locExpr, n[i], OnHeap) - arr.r = ropecg(p.module, "$1->data[$2]", rdLoc(dest[]), intLiteral(i)) + d = getTemp(p, n.typ) + + 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[], lit, getTypeDesc(p.module, seqtype.elementType), + getSeqPayloadType(p.module, seqtype)]) + else: + # generate call to newSeq before adding the elements per hand: + genNewSeqAux(p, dest[], lit, n.len == 0) + for i in 0..<n.len: + 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) @@ -1298,110 +1621,129 @@ 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 - if n.sons[1].kind == nkBracket: - n.sons[1].typ = n.typ - genSeqConstr(p, n.sons[1], d) + 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 = int(lengthOrd(p.config, n.sons[1].typ)) - genNewSeqAux(p, d, intLiteral(L)) - initLocExpr(p, n.sons[1], a) + 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.elementType), + getSeqPayloadType(p.module, seqtype)]) + else: + 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 countup(0, L - 1): - initLoc(elem, locExpr, lodeTyp elemType(skipTypes(n.typ, abstractInst)), OnHeap) - elem.r = ropecg(p.module, "$1->data[$2]", rdLoc(d), intLiteral(i)) + for i in 0..<L: + 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.sons[1].typ, abstractInst)), a.storage) - arr.r = ropecg(p.module, "$1[$2]", rdLoc(a), intLiteral(i)) - genAssignment(p, elem, arr, {afDestIsNil, needToCopy}) - else: - var i: TLoc - getTemp(p, getSysType(p.module.g.graph, unknownLineInfo(), tyInt), i) - let oldCode = p.s(cpsStmts) - linefmt(p, cpsStmts, "for ($1 = 0; $1 < $2; $1++) {$n", i.r, L.rope) - initLoc(elem, locExpr, lodeTyp elemType(skipTypes(n.typ, abstractInst)), OnHeap) - elem.r = ropecg(p.module, "$1->data[$2]", rdLoc(d), rdLoc(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)) + 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.sons[1].typ, abstractInst)), a.storage) - arr.r = ropecg(p.module, "$1[$2]", rdLoc(a), rdLoc(i)) - genAssignment(p, elem, arr, {afDestIsNil, needToCopy}) + 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.sons[1].typ, abstractVarRange) - initLocExpr(p, e.sons[1], a) - initLocExpr(p, e.sons[2], f) - initLoc(b, locExpr, a.lode, OnHeap) - ti = genTypeInfo(p.module, refType, e.info) - addf(p.module.s[cfsTypeInit3], "$1->finalizer = (void*)$2;$n", [ti, rdLoc(f)]) - b.r = ropecg(p.module, "($1) #newObj($2, sizeof($3))", [ + refType = skipTypes(e[1].typ, abstractVarRange) + 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.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) - genObjectInit(p, cpsStmts, bt, a, false) + 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 = - # unfortunately 'genTypeInfo' sets tfObjHasKids as a side effect, so we - # have to call it here first: - let ti = genTypeInfo(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] - else: - discard cgsym(p.module, "TNimType") - inc p.module.labels - let cache = "Nim_OfCheck_CACHE" & p.module.labels.rope - addf(p.module.s[cfsVars], "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, genTypeInfo(p.module, dest, info)) +proc genOfHelper(p: BProc; dest: PType; a: Rope; info: TLineInfo; result: var Rope) = + if optTinyRtti in p.config.globalOptions: + 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.add "$1.m_type == $2" % [a, ti] + else: + 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]) + 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 t = skipTypes(a.t, abstractInst) + 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) + r = ropecg(p.module, "(*$1)", [r]) + t = skipTypes(t.elementType, typedescInst+{tyOwned}) discard getTypeDesc(p.module, t) if not p.module.compileToCpp: - while t.kind == tyObject and t.sons[0] != nil: - add(r, ~".Sup") - t = skipTypes(t.sons[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.sons[1], n.sons[2].typ, d) + genOf(p, n[1], n[2].typ, d) proc genRepr(p: BProc, e: PNode, d: var TLoc) = - var a: TLoc - initLocExpr(p, e.sons[1], a) - var t = skipTypes(e.sons[1].typ, abstractVarRange) + if optTinyRtti in p.config.globalOptions: + localError(p.config, e.info, "'repr' is not available for --newruntime") + var a: TLoc = initLocExpr(p, e[1]) + var t = skipTypes(e[1].typ, abstractVarRange) case t.kind of tyInt..tyInt64, tyUInt..tyUInt64: putIntoDest(p, d, e, @@ -1415,87 +1757,144 @@ proc genRepr(p: BProc, e: PNode, d: var TLoc) = of tyEnum, tyOrdinal: putIntoDest(p, d, e, ropecg(p.module, "#reprEnum((NI)$1, $2)", [ - rdLoc(a), genTypeInfo(p.module, t, e.info)]), a.storage) + rdLoc(a), genTypeInfoV1(p.module, t, e.info)]), a.storage) of tyString: putIntoDest(p, d, e, ropecg(p.module, "#reprStr($1)", [rdLoc(a)]), a.storage) of tySet: putIntoDest(p, d, e, ropecg(p.module, "#reprSet($1, $2)", [ - addrLoc(p.config, a), genTypeInfo(p.module, t, e.info)]), a.storage) + addrLoc(p.config, a), genTypeInfoV1(p.module, t, e.info)]), a.storage) of tyOpenArray, tyVarargs: - var b: TLoc - case a.t.kind + 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->data, ($1 ? $1->$2 : 0)" % [rdLoc(a), lenField(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) - else: internalError(p.config, e.sons[0].info, "genRepr()") + else: internalError(p.config, e[0].info, "genRepr()") putIntoDest(p, d, e, ropecg(p.module, "#reprOpenArray($1, $2)", [rdLoc(b), - genTypeInfo(p.module, elemType(t), e.info)]), a.storage) - of tyCString, tyArray, tyRef, tyPtr, tyPointer, tyNil, tySequence: + genTypeInfoV1(p.module, elemType(t), e.info)]), a.storage) + of tyCstring, tyArray, tyRef, tyPtr, tyPointer, tyNil, tySequence: putIntoDest(p, d, e, ropecg(p.module, "#reprAny($1, $2)", [ - rdLoc(a), genTypeInfo(p.module, t, e.info)]), a.storage) + rdLoc(a), genTypeInfoV1(p.module, t, e.info)]), a.storage) of tyEmpty, tyVoid: localError(p.config, e.info, "'repr' doesn't support 'void' type") else: putIntoDest(p, d, e, ropecg(p.module, "#reprAny($1, $2)", - [addrLoc(p.config, a), genTypeInfo(p.module, t, e.info)]), + [addrLoc(p.config, a), genTypeInfoV1(p.module, t, e.info)]), a.storage) gcUsage(p.config, e) -proc genGetTypeInfo(p: BProc, e: PNode, d: var TLoc) = - let t = e.sons[1].typ - putIntoDest(p, d, e, genTypeInfo(p.module, t, e.info)) +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 = derefs + if t.kind notin {tyVar, tyLent} or not p.module.compileToCpp: + 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.baseClass != nil: + result.add(".Sup") + t = skipTypes(t.baseClass, skipPtrs) + result.add ".m_type" + if optTinyRtti in p.config.globalOptions and enforceV1: + result.add "->typeInfoV1" -proc genDollar(p: BProc, n: PNode, d: var TLoc, frmt: string) = - var a: TLoc - initLocExpr(p, n.sons[1], a) - a.r = ropecg(p.module, frmt, [rdLoc(a)]) - if d.k == locNone: getTemp(p, n.typ, d) +proc genGetTypeInfo(p: BProc, e: PNode, d: var TLoc) = + cgsym(p.module, "TNimType") + let t = e[1].typ + # ordinary static type information + putIntoDest(p, d, e, genTypeInfoV1(p.module, t, e.info)) + +proc genGetTypeInfoV2(p: BProc, e: PNode, d: var TLoc) = + let t = e[1].typ + if isFinal(t) or e[0].sym.name.s != "getDynamicTypeInfo": + # ordinary static type information + putIntoDest(p, d, e, genTypeInfoV2(p.module, t, e.info)) + else: + 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) + +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.snippet = ropecg(p.module, frmt, [rdLoc(a)]) + a.flags.excl lfIndirect # this flag should not be propagated here (not just for HCR) + if d.k == locNone: d = getTemp(p, n.typ) genAssignment(p, d, a, {}) gcUsage(p.config, n) proc genArrayLen(p: BProc, e: PNode, d: var TLoc, op: TMagic) = - var a = e.sons[1] - if a.kind == nkHiddenAddr: a = a.sons[0] + var a = e[1] + if a.kind == nkHiddenAddr: a = a[0] var typ = skipTypes(a.typ, abstractVar + tyUserTypeClasses) case typ.kind of tyOpenArray, tyVarargs: - if op == mHigh: unaryExpr(p, e, d, "($1Len_0-1)") - else: unaryExpr(p, e, d, "$1Len_0") - of tyCString: - useStringh(p.module) - if op == mHigh: unaryExpr(p, e, d, "($1 ? (strlen($1)-1) : -1)") - else: unaryExpr(p, e, d, "($1 ? strlen($1) : 0)") - of tyString: - if not p.module.compileToCpp: - if op == mHigh: unaryExpr(p, e, d, "($1 ? ($1->Sup.len-1) : -1)") - else: unaryExpr(p, e, d, "($1 ? $1->Sup.len : 0)") - else: - if op == mHigh: unaryExpr(p, e, d, "($1 ? ($1->len-1) : -1)") - else: unaryExpr(p, e, d, "($1 ? $1->len : 0)") - of tySequence: - var a, tmp: TLoc - initLocExpr(p, e[1], a) - getIntTemp(p, tmp) - var frmt: FormatStr - if not p.module.compileToCpp: + # 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 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: - frmt = "$1 = ($2 ? ($2->Sup.len-1) : -1);$n" + putIntoDest(p, d, e, ropecg(p.module, "(($2)-($1))", [rdLoc(b), rdLoc(c)])) else: - frmt = "$1 = ($2 ? $2->Sup.len : 0);$n" + putIntoDest(p, d, e, ropecg(p.module, "(($2)-($1)+1)", [rdLoc(b), rdLoc(c)])) else: - if op == mHigh: - frmt = "$1 = ($2 ? ($2->len-1) : -1);$n" + if not reifiedOpenArray(a): + if op == mHigh: unaryExpr(p, e, d, "($1Len_0-1)") + else: unaryExpr(p, e, d, "$1Len_0") else: - frmt = "$1 = ($2 ? $2->len : 0);$n" - lineCg(p, cpsStmts, frmt, tmp.r, rdLoc(a)) - putIntoDest(p, d, e, tmp.r) + 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]) + 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 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.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))) @@ -1503,47 +1902,72 @@ proc genArrayLen(p: BProc, e: PNode, d: var TLoc, op: TMagic) = else: internalError(p.config, e.info, "genArrayLen()") proc genSetLengthSeq(p: BProc, e: PNode, d: var TLoc) = - var a, b: TLoc + if optSeqDestructors in p.config.globalOptions: + e[1] = makeAddr(e[1], p.module.idgen) + genCall(p, e, d) + return assert(d.k == locNone) - var x = e.sons[1] + var x = e[1] if x.kind in {nkAddr, nkHiddenAddr}: x = x[0] - initLocExpr(p, x, a) - initLocExpr(p, e.sons[2], b) - let t = skipTypes(e.sons[1].typ, {tyVar}) - let setLenPattern = if not p.module.compileToCpp: - "$1 = ($3) #setLengthSeqV2(&($1)->Sup, $4, $2);$n" - else: - "$1 = ($3) #setLengthSeqV2($1, $4, $2);$n" + var a = initLocExpr(p, x) + var b = initLocExpr(p, e[2]) + let t = skipTypes(e[1].typ, {tyVar}) - lineCg(p, cpsStmts, setLenPattern, [ + var call = initLoc(locCall, e, OnHeap) + if not p.module.compileToCpp: + 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), - genTypeInfo(p.module, t.skipTypes(abstractInst), e.info)]) + genTypeInfoV1(p.module, t.skipTypes(abstractInst), e.info)]) + + else: + const setLenPattern = "($3) #setLengthSeqV2($1, $4, $2)" + call.snippet = ropecg(p.module, setLenPattern, [ + rdLoc(a), rdLoc(b), getTypeDesc(p.module, t), + genTypeInfoV1(p.module, t.skipTypes(abstractInst), e.info)]) + + genAssignment(p, a, call, {}) gcUsage(p.config, e) proc genSetLengthStr(p: BProc, e: PNode, d: var TLoc) = - binaryStmt(p, e, d, "$1 = #setLengthStr($1, $2);$n") - gcUsage(p.config, e) + if optSeqDestructors in p.config.globalOptions: + binaryStmtAddr(p, e, d, "setLengthStrV2") + else: + if d.k != locNone: internalError(p.config, e.info, "genSetLengthStr") + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[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) proc genSwap(p: BProc, e: PNode, d: var TLoc) = # swap(a, b) --> # temp = a # a = b # b = temp - var a, b, tmp: TLoc - getTemp(p, skipTypes(e.sons[1].typ, abstractVar), tmp) - initLocExpr(p, e.sons[1], a) # eval a - initLocExpr(p, e.sons[2], b) # eval b + cowBracket(p, e[1]) + cowBracket(p, e[2]) + 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, setType: 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 @@ -1554,94 +1978,110 @@ proc fewCmps(conf: ConfigRef; s: PNode): bool = elif elemType(s.typ).kind in {tyInt, tyInt16..tyInt64}: result = true # better not emit the set if int is basetype! else: - result = sonsLen(s) <= 8 # 8 seems to be a good value + result = s.len <= 8 # 8 seems to be a good value -proc 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)]) +template binaryExprIn(p: BProc, e: PNode, a, b, d: var TLoc, frmt: string) = + 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.sons[1].typ, abstractVar))) - of 1: binaryExprIn(p, e, a, b, d, "(($1 &(1U<<((NU)($2)&7U)))!=0)") - of 2: binaryExprIn(p, e, a, b, d, "(($1 &(1U<<((NU)($2)&15U)))!=0)") - of 4: binaryExprIn(p, e, a, b, d, "(($1 &(1U<<((NU)($2)&31U)))!=0)") + case int(getSize(p.config, skipTypes(e[1].typ, abstractVar))) + of 1: binaryExprIn(p, e, a, b, d, "(($1 &((NU8)1<<((NU)($2)&7U)))!=0)") + of 2: binaryExprIn(p, e, a, b, d, "(($1 &((NU16)1<<((NU)($2)&15U)))!=0)") + of 4: binaryExprIn(p, e, a, b, d, "(($1 &((NU32)1<<((NU)($2)&31U)))!=0)") of 8: binaryExprIn(p, e, a, b, d, "(($1 &((NU64)1<<((NU)($2)&63U)))!=0)") else: binaryExprIn(p, e, a, b, d, "(($1[(NU)($2)>>3] &(1U<<((NU)($2)&7U)))!=0)") -proc binaryStmtInExcl(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a, b: TLoc +template binaryStmtInExcl(p: BProc, e: PNode, d: var TLoc, frmt: string) = assert(d.k == locNone) - initLocExpr(p, e.sons[1], a) - initLocExpr(p, e.sons[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 - if (e.sons[1].kind == nkCurly) and fewCmps(p.config, e.sons[1]): + if (e[1].kind == nkCurly) and fewCmps(p.config, e[1]): # a set constructor but not a constant set: # do not emit the set, but generate a bunch of comparisons; and if we do # so, we skip the unnecessary range check: This is a semantical extension # that code now relies on. :-/ XXX - let ea = if e.sons[2].kind in {nkChckRange, nkChckRange64}: - e.sons[2].sons[0] + let ea = if e[2].kind in {nkChckRange, nkChckRange64}: + e[2][0] else: - e.sons[2] - initLocExpr(p, ea, a) - initLoc(b, locExpr, e, OnUnknown) - b.r = rope("(") - var length = sonsLen(e.sons[1]) - for i in countup(0, length - 1): - let it = e.sons[1].sons[i] - if it.kind == nkRange: - initLocExpr(p, it.sons[0], x) - initLocExpr(p, it.sons[1], y) - addf(b.r, "$1 >= $2 && $1 <= $3", - [rdCharLoc(a), rdCharLoc(x), rdCharLoc(y)]) - else: - initLocExpr(p, it, x) - addf(b.r, "$1 == $2", [rdCharLoc(a), rdCharLoc(x)]) - if i < length - 1: add(b.r, " || ") - add(b.r, ")") - putIntoDest(p, d, e, b.r) - else: - assert(e.sons[1].typ != nil) - assert(e.sons[2].typ != nil) - initLocExpr(p, e.sons[1], a) - initLocExpr(p, e.sons[2], b) + e[2] + a = initLocExpr(p, ea) + b = initLoc(locExpr, e, OnUnknown) + if e[1].len > 0: + b.snippet = rope("(") + for i in 0..<e[1].len: + let it = e[1][i] + if it.kind == nkRange: + x = initLocExpr(p, it[0]) + y = initLocExpr(p, it[1]) + b.snippet.addf("$1 >= $2 && $1 <= $3", + [rdCharLoc(a), rdCharLoc(x), rdCharLoc(y)]) + else: + 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.snippet = rope("0") + putIntoDest(p, d, e, b.snippet) + else: + assert(e[1].typ != nil) + assert(e[2].typ != nil) + 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) = const - lookupOpr: array[mLeSet..mSymDiffSet, string] = [ + lookupOpr: array[mLeSet..mMinusSet, string] = [ + "for ($1 = 0; $1 < $2; $1++) { $n" & + " $3 = (($4[$1] & ~ $5[$1]) == 0);$n" & + " if (!$3) break;}$n", "for ($1 = 0; $1 < $2; $1++) { $n" & - " $3 = (($4[$1] & ~ $5[$1]) == 0);$n" & - " if (!$3) break;}$n", "for ($1 = 0; $1 < $2; $1++) { $n" & - " $3 = (($4[$1] & ~ $5[$1]) == 0);$n" & " if (!$3) break;}$n" & - "if ($3) $3 = (memcmp($4, $5, $2) != 0);$n", - "&", "|", "& ~", "^"] - var a, b, i: TLoc - var setType = skipTypes(e.sons[1].typ, abstractVar) + " $3 = (($4[$1] & ~ $5[$1]) == 0);$n" & + " if (!$3) break;}$n" & + "if ($3) $3 = (#nimCmpMem($4, $5, $2) != 0);$n", + "&", + "|", + "& ~"] + var a, b: TLoc + var i: TLoc + var setType = skipTypes(e[1].typ, abstractVar) var size = int(getSize(p.config, setType)) case size of 1, 2, 4, 8: case op of mIncl: - var ts = "NU" & $(size * 8) - binaryStmtInExcl(p, e, d, - "$1 |= ((" & ts & ")1)<<(($2)%(sizeof(" & ts & ")*8));$n") + case size + of 1: binaryStmtInExcl(p, e, d, "$1 |= ((NU8)1)<<(($2) & 7);$n") + of 2: binaryStmtInExcl(p, e, d, "$1 |= ((NU16)1)<<(($2) & 15);$n") + of 4: binaryStmtInExcl(p, e, d, "$1 |= ((NU32)1)<<(($2) & 31);$n") + of 8: binaryStmtInExcl(p, e, d, "$1 |= ((NU64)1)<<(($2) & 63);$n") + else: assert(false, $size) of mExcl: - var ts = "NU" & $(size * 8) - binaryStmtInExcl(p, e, d, "$1 &= ~(((" & ts & ")1) << (($2) % (sizeof(" & - ts & ")*8)));$n") + case size + of 1: binaryStmtInExcl(p, e, d, "$1 &= ~(((NU8)1) << (($2) & 7));$n") + of 2: binaryStmtInExcl(p, e, d, "$1 &= ~(((NU16)1) << (($2) & 15));$n") + of 4: binaryStmtInExcl(p, e, d, "$1 &= ~(((NU32)1) << (($2) & 31));$n") + of 8: binaryStmtInExcl(p, e, d, "$1 &= ~(((NU64)1) << (($2) & 63));$n") + else: assert(false, $size) of mCard: if size <= 4: unaryExprChar(p, e, d, "#countBits32($1)") else: unaryExprChar(p, e, d, "#countBits64($1)") - of mLtSet: binaryExprChar(p, e, d, "(($1 & ~ $2 ==0)&&($1 != $2))") + of mLtSet: binaryExprChar(p, e, d, "((($1 & ~ $2)==0)&&($1 != $2))") of mLeSet: binaryExprChar(p, e, d, "(($1 & ~ $2)==0)") of mEqSet: binaryExpr(p, e, d, "($1 == $2)") of mMulSet: binaryExpr(p, e, d, "($1 & $2)") of mPlusSet: binaryExpr(p, e, d, "($1 | $2)") of mMinusSet: binaryExpr(p, e, d, "($1 & ~ $2)") - of mSymDiffSet: binaryExpr(p, e, d, "($1 ^ $2)") of mInSet: genInOp(p, e, d) else: internalError(p.config, e.info, "genSetOp()") @@ -1649,23 +2089,32 @@ proc genSetOp(p: BProc, e: PNode, d: var TLoc, op: TMagic) = case op 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: unaryExprChar(p, e, d, "#cardSet($1, " & $size & ')') + of mCard: + 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.sons[1], a) - initLocExpr(p, e.sons[2], b) - if d.k == locNone: getTemp(p, getSysType(p.module.g.graph, unknownLineInfo(), tyBool), d) - lineF(p, cpsStmts, lookupOpr[op], - [rdLoc(i), rope(size), rdLoc(d), rdLoc(a), rdLoc(b)]) + 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)]) + else: + linefmt(p, cpsStmts, lookupOpr[mLeSet], + [rdLoc(i), size, rdLoc(d), rdLoc(a), rdLoc(b)]) of mEqSet: - useStringh(p.module) - binaryExprChar(p, e, d, "(memcmp($1, $2, " & $(size) & ")==0)") - of mMulSet, mPlusSet, mMinusSet, mSymDiffSet: + assert(e[1].typ != nil) + assert(e[2].typ != nil) + 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.sons[1], a) - initLocExpr(p, e.sons[2], b) - if d.k == locNone: getTemp(p, a.t, 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", [ @@ -1679,25 +2128,34 @@ proc genOrd(p: BProc, e: PNode, d: var TLoc) = proc genSomeCast(p: BProc, e: PNode, d: var TLoc) = const - ValueTypes = {tyTuple, tyObject, tyArray, tyOpenArray, tyVarargs} + 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.sons[1], a) - let etyp = skipTypes(e.typ, abstractRange) + 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: putIntoDest(p, d, e, "(*($1*) ($2))" % [getTypeDesc(p.module, e.typ), addrLoc(p.config, a)], a.storage) - elif etyp.kind == tyProc and etyp.callConv == ccClosure: + elif etyp.kind == tyProc and etyp.callConv == ccClosure and srcTyp.callConv != ccClosure: putIntoDest(p, d, e, "(($1) ($2))" % [getClosureType(p.module, etyp, clHalfWithEnv), rdCharLoc(a)], a.storage) else: - let srcTyp = skipTypes(e.sons[1].typ, abstractRange) # C++ does not like direct casts from pointer to shorter integral types if srcTyp.kind in {tyPtr, tyPointer} and etyp.kind in IntegralTypes: putIntoDest(p, d, e, "(($1) (ptrdiff_t) ($2))" % [getTypeDesc(p.module, e.typ), rdCharLoc(a)], a.storage) + elif optSeqDestructors in p.config.globalOptions and etyp.kind in {tySequence, tyString}: + putIntoDest(p, d, e, "(*($1*) (&$2))" % + [getTypeDesc(p.module, e.typ), rdCharLoc(a)], a.storage) + 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) @@ -1705,100 +2163,272 @@ proc genCast(p: BProc, e: PNode, d: var TLoc) = const ValueTypes = {tyFloat..tyFloat128, tyTuple, tyObject, tyArray} let destt = skipTypes(e.typ, abstractRange) - srct = skipTypes(e.sons[1].typ, abstractRange) + srct = skipTypes(e[1].typ, abstractRange) if destt.kind in ValueTypes or srct.kind in ValueTypes: # '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.sons[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 tmp.flags = {} - expr(p, e.sons[1], tmp) + expr(p, e[1], tmp) putIntoDest(p, d, e, "LOC$#.dest" % [lbl], tmp.storage) else: # I prefer the shorter cast version for pointer types -> generate less # C code; plus it's the right thing to do for closures: genSomeCast(p, e, d) -proc genRangeChck(p: BProc, n: PNode, d: var TLoc, magic: string) = - var a: TLoc +proc genRangeChck(p: BProc, n: PNode, d: var TLoc) = + var a: TLoc = initLocExpr(p, n[0]) var dest = skipTypes(n.typ, abstractVar) - # range checks for unsigned turned out to be buggy and annoying: - if optRangeCheck notin p.options or dest.skipTypes({tyRange}).kind in - {tyUInt..tyUInt64}: - initLocExpr(p, n.sons[0], a) - putIntoDest(p, d, n, "(($1) ($2))" % - [getTypeDesc(p.module, dest), rdCharLoc(a)], a.storage) + 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" else: - initLocExpr(p, n.sons[0], a) - putIntoDest(p, d, lodeTyp dest, ropecg(p.module, "(($1)#$5($2, $3, $4))", [ - getTypeDesc(p.module, dest), rdCharLoc(a), - genLiteral(p, n.sons[1], dest), genLiteral(p, n.sons[2], dest), - rope(magic)]), a.storage) + let n0t = n[0].typ + + # emit range check: + if n0t.kind in {tyUInt, tyUInt64}: + 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" + cgsym(p.module, raiser) + + let boundaryCast = + if n0t.skipTypes(abstractVarRange).kind in {tyUInt, tyUInt32, tyUInt64}: + "(NI64)" + else: + "" + 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.sons[1].typ): - expr(p, e.sons[1], d) + 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.sons[0], a) - putIntoDest(p, d, n, "($1 ? $1->data : (NCSTRING)\"\")" % [rdLoc(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.sons[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) = var x: TLoc - var a = e.sons[1] - var b = e.sons[2] + var a = e[1] + var b = e[2] if a.kind in {nkStrLit..nkTripleStrLit} and a.strVal == "": - initLocExpr(p, e.sons[2], x) + x = initLocExpr(p, e[2]) putIntoDest(p, d, e, - ropecg(p.module, "(!($1) || ($1)->$2 == 0)", rdLoc(x), lenField(p))) + ropecg(p.module, "($1 == 0)", [lenExpr(p, x)])) elif b.kind in {nkStrLit..nkTripleStrLit} and b.strVal == "": - initLocExpr(p, e.sons[1], x) + x = initLocExpr(p, e[1]) putIntoDest(p, d, e, - ropecg(p.module, "(!($1) || ($1)->$2 == 0)", rdLoc(x), lenField(p))) + ropecg(p.module, "($1 == 0)", [lenExpr(p, x)])) else: binaryExpr(p, e, d, "#eqStrings($1, $2)") 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.sons[1].typ != nil) - assert(e.sons[2].typ != nil) - initLocExpr(p, e.sons[1], a) - initLocExpr(p, e.sons[2], b) + assert(e[1].typ != nil) + assert(e[2].typ != nil) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) putIntoDest(p, d, e, ropecg(p.module, "(($4)($2) $1 ($4)($3))", - rope(opr[m]), rdLoc(a), rdLoc(b), - getSimpleTypeDesc(p.module, e[1].typ))) + [opr[m], rdLoc(a), rdLoc(b), + getSimpleTypeDesc(p.module, e[1].typ)])) if optNaNCheck in p.options: - linefmt(p, cpsStmts, "#nanCheck($1);$n", rdLoc(d)) + 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, "#infCheck($1);$n", rdLoc(d)) + 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 genWasMoved(p: BProc; n: PNode) = + var a: TLoc + let n1 = n[1].skipAddr + if p.withinBlockLeaveActions > 0 and notYetAlive(n1): + discard + else: + 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) + if n.len == 4: + # generated by liftdestructors: + 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: 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: + let arg = n[1].skipAddr + let t = arg.typ.skipTypes(abstractInst) + case t.kind + of tyString: + 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" & + "}$n", [rdLoc(a)]) + else: + linefmt(p, cpsStmts, "if ($1.p && !($1.p->cap & NIM_STRLIT_FLAG)) {$n" & + " #dealloc($1.p);$n" & + "}$n", [rdLoc(a)]) + of tySequence: + 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.elementType)]) + else: discard "nothing to do" + else: + let t = n[1].typ.skipTypes(abstractVar) + let op = getAttachedOp(p.module.g.graph, t, attachedDestructor) + if op != nil and getBody(p.module.g.graph, op).len != 0: + internalError(p.config, n.info, "destructor turned out to be not trivial") + discard "ignore calls to the default destructor" + +proc genDispose(p: BProc; n: PNode) = + when false: + let elemType = n[1].typ.skipTypes(abstractVar).elementType + + var a: TLoc = initLocExpr(p, n[1].skipAddr) + + if isFinal(elemType): + if elemType.destructor != nil: + var destroyCall = newNodeI(nkCall, n.info) + genStmts(p, destroyCall) + lineFmt(p, cpsStmts, "#nimRawDispose($1, NIM_ALIGNOF($2))", [rdLoc(a), getTypeDesc(p.module, elemType)]) + else: + # ``nimRawDisposeVirtual`` calls the ``finalizer`` which is the same as the + # destructor, but it uses the runtime type. Afterwards the memory is freed: + 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.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'; " & + "'toOpenArray' is only valid within a call expression") + +proc genEnumToStr(p: BProc, e: PNode, d: var TLoc) = + let t = e[1].typ.skipTypes(abstractInst+{tyRange}) + let toStrProc = getToStringProc(p.module.g.graph, t) + # XXX need to modify this logic for IC. + var n = copyTree(e) + n[0] = newSymNode(toStrProc) + expr(p, n, d) + proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = case op of mOr, mAnd: genAndOr(p, e, d, op) - of mNot..mToBiggestInt: unaryArith(p, e, d, op) + of mNot..mUnaryMinusF64: unaryArith(p, e, d, op) of mUnaryMinusI..mAbsI: unaryArithOverflow(p, e, d, op) of mAddF64..mDivF64: binaryFloatArith(p, e, d, op) of mShrI..mXor: binaryArith(p, e, d, op) @@ -1806,108 +2436,181 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = of mAddI..mPred: binaryArithOverflow(p, e, d, op) of mRepr: genRepr(p, e, d) of mGetTypeInfo: genGetTypeInfo(p, e, d) + of mGetTypeInfoV2: genGetTypeInfoV2(p, e, d) of mSwap: genSwap(p, e, d) - of mUnaryLt: - if optOverflowCheck notin p.options: unaryExpr(p, e, d, "($1 - 1)") - else: unaryExpr(p, e, d, "#subInt($1, 1)") of mInc, mDec: - const opr: array[mInc..mDec, string] = ["$1 += $2;$n", "$1 -= $2;$n"] - const fun64: array[mInc..mDec, string] = ["$# = #addInt64($#, $#);$n", - "$# = #subInt64($#, $#);$n"] - const fun: array[mInc..mDec, string] = ["$# = #addInt($#, $#);$n", - "$# = #subInt($#, $#);$n"] - let underlying = skipTypes(e.sons[1].typ, {tyGenericInst, tyAlias, tySink, tyVar, tyLent, tyRange}) + const opr: array[mInc..mDec, string] = ["+=", "-="] + const fun64: array[mInc..mDec, string] = ["nimAddInt64", "nimSubInt64"] + const fun: array[mInc..mDec, string] = ["nimAddInt","nimSubInt"] + let underlying = skipTypes(e[1].typ, {tyGenericInst, tyAlias, tySink, tyVar, tyLent, tyRange, tyDistinct}) if optOverflowCheck notin p.options or underlying.kind in {tyUInt..tyUInt64}: binaryStmt(p, e, d, opr[op]) else: - var a, b: TLoc - assert(e.sons[1].typ != nil) - assert(e.sons[2].typ != nil) - initLocExpr(p, e.sons[1], a) - initLocExpr(p, e.sons[2], b) + assert(e[1].typ != nil) + assert(e[2].typ != nil) + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) - let ranged = skipTypes(e.sons[1].typ, {tyGenericInst, tyAlias, tySink, tyVar, tyLent}) + let ranged = skipTypes(e[1].typ, {tyGenericInst, tyAlias, tySink, tyVar, tyLent, tyDistinct}) let res = binaryArithOverflowRaw(p, ranged, a, b, if underlying.kind == tyInt64: fun64[op] else: fun[op]) - putIntoDest(p, a, e.sons[1], "($#)($#)" % [ + + putIntoDest(p, a, e[1], "($#)($#)" % [ getTypeDesc(p.module, ranged), res]) of mConStrStr: genStrConcat(p, e, d) - of mAppendStrCh: binaryStmt(p, e, d, "$1 = #addChar($1, $2);$n") + of mAppendStrCh: + if optSeqDestructors in p.config.globalOptions: + binaryStmtAddr(p, e, d, "nimAddCharV1") + else: + 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: genSeqElemAppend(p, e, d) + of mAppendSeqElem: + if optSeqDestructors in p.config.globalOptions: + e[1] = makeAddr(e[1], p.module.idgen) + genCall(p, e, d) + else: + genSeqElemAppend(p, e, d) of mEqStr: genStrEquals(p, e, d) 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 mStrToStr: expr(p, e.sons[1], d) - of mEnumToStr: genRepr(p, e, d) + 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 generatedMagics: genCall(p, e, d) + of mEnumToStr: + if optTinyRtti in p.config.globalOptions: + genEnumToStr(p, e, d) + else: + genRepr(p, e, d) of mOf: genOf(p, e, d) of mNew: genNew(p, e) - of mNewFinalize: genNewFinalize(p, e) - of mNewSeq: genNewSeq(p, e) + of mNewFinalize: + if optTinyRtti in p.config.globalOptions: + var a: TLoc = initLocExpr(p, e[1]) + rawGenNew(p, a, "", needsInit = true) + gcUsage(p.config, e) + else: + genNewFinalize(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.sons[1].typ.skipTypes({tyTypeDesc}) - putIntoDest(p, d, e, "((NI)sizeof($1))" % [getTypeDesc(p.module, t)]) + let t = e[1].typ.skipTypes({tyTypeDesc}) + 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, dkVar)]) + of mOffsetOf: + var dotExpr: PNode + if e[1].kind == nkDotExpr: + dotExpr = e[1] + 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, dkVar) + let member = + if t.kind == tyTuple: + "Field" & rope(dotExpr[1].sym.position) + 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 mXLenStr: - if not p.module.compileToCpp: - unaryExpr(p, e, d, "($1->Sup.len)") - else: - unaryExpr(p, e, d, "$1->len") - of mXLenSeq: - # see 'taddhigh.nim' for why we need to use a temporary here: - var a, tmp: TLoc - initLocExpr(p, e[1], a) - getIntTemp(p, tmp) - var frmt: FormatStr - if not p.module.compileToCpp: - frmt = "$1 = $2->Sup.len;$n" - else: - frmt = "$1 = $2->len;$n" - lineCg(p, cpsStmts, frmt, tmp.r, rdLoc(a)) - putIntoDest(p, d, e, tmp.r) - of mGCref: unaryStmt(p, e, d, "#nimGCref($1);$n") - of mGCunref: unaryStmt(p, e, d, "#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, mInSet: genSetOp(p, e, d, op) - of mNewString, mNewStringOfCap, mCopyStr, mCopyStrLast, mExit, - mParseBiggestFloat: - var opr = e.sons[0].sym + of mNewString, mNewStringOfCap, mExit, mParseBiggestFloat: + var opr = e[0].sym + # Why would anyone want to set nodecl to one of these hardcoded magics? + # - 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: - discard cgsym(p.module, $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 + # 2 forward declarations. That happens because the magic symbol and the original + # one that shall be used have different ids (even though a call to one is + # actually a call to the other) so checking into m.declaredProtos with the 2 different ids doesn't work. + # Why would 2 identical forward declarations be a problem? + # - in the case of hot code-reloading we generate function pointers instead + # of forward declarations and in C++ it is an error to redefine a global + let wasDeclared = containsOrIncl(p.module.declaredProtos, prc.id) + # Make the function behind the magic get actually generated - this will + # not lead to a forward declaration! The genCall will lead to one. + cgsym(p.module, $opr.loc.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 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.sons[0].sym.name.s)) + localError(p.config, e.info, strutils.`%`(errXMustBeCompileTime, e[0].sym.name.s)) of mSpawn: - let n = lowerings.wrapProcForSpawn(p.module.g.graph, p.module.module, e, e.typ, nil, nil) - expr(p, n, d) + when defined(leanCompiler): + p.config.quitOrRaise "compiler built without support for the 'spawn' statement" + else: + let n = spawn.wrapProcForSpawn(p.module.g.graph, p.module.idgen, p.module.module, e, e.typ, nil, nil) + expr(p, n, d) of mParallel: - let n = semparallel.liftParallel(p.module.g.graph, p.module.module, e) - expr(p, n, d) + when defined(leanCompiler): + 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: - var a, b: TLoc + if p.config.selectedGC in {gcArc, gcAtomicArc, gcOrc} and optEnableDeepCopy notin p.config.globalOptions: + localError(p.config, e.info, + "for --mm:arc|atomicArc|orc 'deepcopy' support has to be enabled with --deepcopy:on") + let x = if e[1].kind in {nkAddr, nkHiddenAddr}: e[1][0] else: e[1] - initLocExpr(p, x, a) - initLocExpr(p, e.sons[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 @@ -1916,105 +2619,139 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = proc genSetConstr(p: BProc, e: PNode, d: var TLoc) = # example: { a..b, c, d, e, f..g } # we have to emit an expression of the form: - # memset(tmp, 0, sizeof(tmp)); inclRange(tmp, a, b); incl(tmp, c); + # 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: - useStringh(p.module) - lineF(p, cpsStmts, "memset($1, 0, sizeof($2));$n", + 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.sons[0], a) - initLocExpr(p, it.sons[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.sons[0], a) - initLocExpr(p, it.sons[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 |=((" & ts & ")(1)<<(($1)%(sizeof(" & ts & ")*8)));$n", [ - rdLoc(idx), rdLoc(d), rdSetElemLoc(p.config, a, e.typ), - rdSetElemLoc(p.config, b, e.typ)]) + "$2 |=(($5)(1)<<(($1)%(sizeof($5)*8)));$n", [ + 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 |=((" & ts & ")(1)<<(($2)%(sizeof(" & ts & ")*8)));$n", - [rdLoc(d), rdSetElemLoc(p.config, a, e.typ)]) + "$1 |=(($3)(1)<<(($2)%(sizeof($3)*8)));$n", + [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) - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - if it.kind == nkExprColonExpr: it = it.sons[1] - initLoc(rec, locExpr, it, d.storage) - rec.r = "$1.Field$2" % [rdLoc(d), rope(i)] + + 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] + 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.sons[0].kind == nkSym and isRoutine(n.sons[0].sym) and - n.sons[1].kind == nkNilLit + result = n[0].kind == nkSym and isRoutine(n[0].sym) and + n[1].kind == nkNilLit proc genClosure(p: BProc, n: PNode, d: var TLoc) = - assert n.kind == nkClosure + assert n.kind in {nkPar, nkTupleConstr, nkClosure} if isConstClosure(n): inc(p.module.labels) var tmp = "CNSTCLOSURE" & rope(p.module.labels) - addf(p.module.s[cfsData], "static NIM_CONST $1 $2 = $3;$n", - [getTypeDesc(p.module, n.typ), tmp, genConstExpr(p, n)]) + 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.sons[0], a) - initLocExpr(p, n.sons[1], b) - if n.sons[0].skipConv.kind == nkClosure: + 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: when false: if d.k != locNone: linefmt(p, cpsStmts, "$1.ClP_0 = $2; $1.ClE_0 = $3;$n", - d.rdLoc, a.rdLoc, b.rdLoc) + [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) + [tmp.rdLoc, a.rdLoc, b.rdLoc]) putLocIntoDest(p, d, tmp) 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) - for i in countup(0, sonsLen(n) - 1): - initLoc(arr, locExpr, lodeTyp elemType(skipTypes(n.typ, abstractInst)), d.storage) - arr.r = "$1[$2]" % [rdLoc(d), intLiteral(i)] - expr(p, n.sons[i], arr) + if d.k == locNone: d = getTemp(p, n.typ) + for i in 0..<n.len: + 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.} = @@ -2022,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 - for i in 0 .. n.len - 2: + 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 @@ -2036,83 +2773,82 @@ template genStmtListExprImpl(exprOrStmt) {.dirty.} = else: genStmts(p, it) if n.len > 0: exprOrStmt - if frameName != nil: - add p.s(cpsStmts), deinitFrameNoDebug(p, frameName) + if frameName != "": + p.s(cpsStmts).add deinitFrameNoDebug(p, frameName) proc genStmtListExpr(p: BProc, n: PNode, d: var TLoc) = genStmtListExprImpl: - expr(p, n[n.len - 1], d) + expr(p, n[^1], d) proc genStmtList(p: BProc, n: PNode) = genStmtListExprImpl: - genStmts(p, n[n.len - 1]) + genStmts(p, n[^1]) + +from parampatterns import isLValue proc upConv(p: BProc, n: PNode, d: var TLoc) = - var a: TLoc - initLocExpr(p, n.sons[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 r = rdLoc(a) - var nilCheck: Rope = nil - var t = skipTypes(a.t, abstractInst) - 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 = "(*$1)" % [r] - t = skipTypes(t.lastSon, abstractInst) - discard getTypeDesc(p.module, t) - if not p.module.compileToCpp: - while t.kind == tyObject and t.sons[0] != nil: - add(r, ".Sup") - t = skipTypes(t.sons[0], skipPtrs) - if nilCheck != nil: - linefmt(p, cpsStmts, "if ($1) #chckObj($2.m_type, $3);$n", - nilCheck, r, genTypeInfo(p.module, dest, n.info)) - else: - linefmt(p, cpsStmts, "#chckObj($1.m_type, $2);$n", - r, genTypeInfo(p.module, dest, n.info)) - if n.sons[0].typ.kind != tyObject: - putIntoDest(p, d, n, + 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, + "(*(($1*) (&($2))))" % [getTypeDesc(p.module, n.typ), rdLoc(a)], a.storage) + else: + putIntoDest(p, d, n, "(($1) ($2))" % [getTypeDesc(p.module, n.typ), rdLoc(a)], a.storage) else: putIntoDest(p, d, n, "(*($1*) ($2))" % [getTypeDesc(p.module, dest), addrLoc(p.config, a)], a.storage) proc downConv(p: BProc, n: PNode, d: var TLoc) = - if p.module.compileToCpp: - discard getTypeDesc(p.module, skipTypes(n[0].typ, abstractPtrs)) - expr(p, n.sons[0], d) # downcast does C++ for us - else: - var dest = skipTypes(n.typ, abstractPtrs) + var arg = n[0] + while arg.kind == nkObjDownConv: arg = arg[0] - var arg = n.sons[0] - while arg.kind == nkObjDownConv: arg = arg.sons[0] - - var src = skipTypes(arg.typ, abstractPtrs) - discard getTypeDesc(p.module, src) - var a: TLoc - initLocExpr(p, arg, a) - var r = rdLoc(a) - let isRef = skipTypes(arg.typ, abstractInst).kind in {tyRef, tyPtr, tyVar, tyLent} - if isRef: - add(r, "->Sup") - else: - add(r, ".Sup") - for i in countup(2, abs(inheritanceDiff(dest, src))): add(r, ".Sup") - if isRef: - # it can happen that we end up generating '&&x->Sup' here, so we pack - # the '&x->Sup' into a temporary and then those address is taken - # (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: - if d.k == locNone and skipTypes(n.typ, abstractInst).kind in {tyRef, tyPtr, tyVar, tyLent}: - getTemp(p, n.typ, d) - linefmt(p, cpsStmts, "$1 = &$2;$n", rdLoc(d), r) - else: - r = "&" & r - putIntoDest(p, d, n, r, a.storage) - else: - putIntoDest(p, d, n, r, a.storage) + let dest = skipTypes(n.typ, abstractPtrs) + let src = skipTypes(arg.typ, abstractPtrs) + discard getTypeDesc(p.module, src) + let isRef = skipTypes(arg.typ, abstractInstOwned).kind in {tyRef, tyPtr, tyVar, tyLent} + if isRef and d.k == locNone and n.typ.skipTypes(abstractInstOwned).kind in {tyRef, tyPtr} and n.isLValue: + # it can happen that we end up generating '&&x->Sup' here, so we pack + # the '&x->Sup' into a temporary and then those address is taken + # (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) + 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) + 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) proc exprComplexConst(p: BProc, n: PNode, d: var TLoc) = let t = n.typ @@ -2123,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) - addf(p.module.s[cfsData], "NIM_CONST $1 $2 = $3;$n", - [getTypeDesc(p.module, t), tmp, genConstExpr(p, n)]) + 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) @@ -2135,14 +2873,74 @@ proc exprComplexConst(p: BProc, n: PNode, d: var TLoc) = if t.kind notin {tySequence, tyString}: d.storage = OnStatic +proc genConstSetup(p: BProc; sym: PSym): bool = + let m = p.module + useHeader(m, sym) + if sym.loc.k == locNone: + fillBackendName(p.module, sym) + fillLoc(sym.loc, locData, sym.astdef, OnStatic) + if m.hcrOn: incl(sym.loc.flags, lfIndirect) + result = lfNoDecl notin sym.loc.flags + +proc genConstHeader(m, q: BModule; p: BProc, sym: PSym) = + 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, dkVar), sym.loc.snippet]); + m.initProc.procSec(cpsLocals).addf( + "\t$1 = ($2*)hcrGetGlobal($3, \"$1\");$n", [sym.loc.snippet, + getTypeDesc(m, sym.loc.t, dkVar), getModuleDllPath(q, sym)]) + else: + let headerDecl = "extern NIM_CONST $1 $2;$n" % + [getTypeDesc(m, sym.loc.t, dkVar), sym.loc.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.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, 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.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.snippet, actualConstName, rdLoc(sym.loc)])) + +proc genConstStmt(p: BProc, n: PNode) = + # This code is only used in the new DCE implementation. + assert useAliveDataFromDce in p.module.flags + let m = p.module + for it in n: + if it[0].kind == nkSym: + let sym = it[0].sym + if not isSimpleConst(sym.typ) and sym.itemId.item in m.alive and genConstSetup(p, sym): + genConstDefinition(m, p, sym) + proc expr(p: BProc, n: PNode, d: var TLoc) = + when defined(nimCompilerStacktraceHints): + setFrameMsg p.config$n.info & " " & $n.kind p.currLineInfo = n.info + case n.kind of nkSym: var sym = n.sym case sym.kind of skMethod: - if {sfDispatcher, sfForward} * sym.flags != {}: + if useAliveDataFromDce in p.module.flags or {sfDispatcher, sfForward} * sym.flags != {}: # we cannot produce code for the dispatcher yet: fillProcLoc(p.module, n) genProcPrototype(p.module, sym) @@ -2155,13 +2953,23 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = if sfCompileTime in sym.flags: localError(p.config, n.info, "request to generate code for .compileTime proc: " & sym.name.s) - genProc(p.module, sym) - if sym.loc.r == nil or sym.loc.lode == nil: + if useAliveDataFromDce in p.module.flags and sym.typ.callConv != ccInline: + fillProcLoc(p.module, n) + genProcPrototype(p.module, sym) + else: + genProc(p.module, sym) + if sym.loc.snippet == "" or sym.loc.lode == nil: internalError(p.config, n.info, "expr: proc not init " & sym.name.s) putLocIntoDest(p, d, sym.loc) 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.snippet != "") and (sym.loc.t != nil)) + putLocIntoDest(p, d, sym.loc) else: genComplexConst(p, sym, d) of skEnumField: @@ -2172,26 +2980,35 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = of skVar, skForVar, skResult, skLet: if {sfGlobal, sfThread} * sym.flags != {}: genVarPrototype(p.module, n) - if sym.loc.r == nil or sym.loc.t == nil: + if sfCompileTime in sym.flags: + genSingleVar(p, sym, n, astdef(sym)) + + 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: putLocIntoDest(p, d, sym.loc) of skTemp: - if sym.loc.r == nil or sym.loc.t == nil: + when false: + # this is more harmful than helpful. + 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.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}) @@ -2200,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) - let op = n.sons[0] + 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: @@ -2225,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: @@ -2236,14 +3060,25 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = else: genArrayConstr(p, n, d) of nkPar, nkTupleConstr: - if isDeepConstExpr(n) and n.len != 0: + if n.typ != nil and n.typ.kind == tyProc and n.len == 2: + genClosure(p, n, d) + elif isDeepConstExpr(n) and n.len != 0: exprComplexConst(p, n, d) else: genTupleConstr(p, n, d) 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) @@ -2254,18 +3089,16 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = of nkIfExpr, nkIfStmt: genIf(p, n, d) of nkWhen: # This should be a "when nimvm" node. - expr(p, n.sons[1].sons[0], d) + expr(p, n[1][0], d) of nkObjDownConv: downConv(p, n, d) of nkObjUpConv: upConv(p, n, d) - of nkChckRangeF: genRangeChck(p, n, d, "chckRangeF") - of nkChckRange64: genRangeChck(p, n, d, "chckRange64") - of nkChckRange: genRangeChck(p, n, d, "chckRange") + of nkChckRangeF, nkChckRange64, nkChckRange: genRangeChck(p, n, d) of nkStringToCString: convStrToCStr(p, n, d) of nkCStringToString: convCStrToStr(p, n, d) of nkLambdaKinds: - var sym = n.sons[namePos].sym + 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) @@ -2273,15 +3106,20 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = of nkEmpty: discard of nkWhileStmt: genWhileStmt(p, n) of nkVarSection, nkLetSection: genVarStmt(p, n) - of nkConstSection: discard # consts generated lazily on use + of nkConstSection: + if useAliveDataFromDce in p.module.flags: + genConstStmt(p, n) + # else: consts generated lazily on use of nkForStmt: internalError(p.config, n.info, "for statement not eliminated") of nkCaseStmt: genCase(p, n, d) of nkReturnStmt: genReturnStmt(p, n) of nkBreakStmt: genBreakStmt(p, n) of nkAsgn: + 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. # See tests/run/tcnstseq3 for an example that would fail otherwise. @@ -2290,22 +3128,17 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = let ex = n[0] if ex.kind != nkEmpty: genLineDir(p, n) - var a: TLoc - if ex.kind in nkCallKinds and (ex[0].kind != nkSym or - ex[0].sym.magic == mNone): - # bug #6037: do not assign to a temp in C++ mode: - incl a.flags, lfSingleUse - genCall(p, ex, a) - if lfSingleUse notin a.flags: - line(p, cpsStmts, a.r & ";\L") - else: - initLocExpr(p, ex, a) + var a: TLoc = initLocExprSingleUse(p, ex) + line(p, cpsStmts, "(void)(" & a.snippet & ");\L") of nkAsmStmt: genAsmStmt(p, n) - of nkTryStmt: - if p.module.compileToCpp and optNoCppExceptions notin p.config.globalOptions: + of nkTryStmt, nkHiddenTryStmt: + case p.config.exc + of excGoto: + genTryGoto(p, n, d) + of excCpp: genTryCpp(p, n, d) else: - genTry(p, n, d) + genTrySetjmp(p, n, d) of nkRaiseStmt: genRaiseStmt(p, n) of nkTypeSection: # we have to emit the type information for object types here to support @@ -2316,174 +3149,327 @@ 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.sons[genericParamsPos].kind == nkEmpty: - var prc = n.sons[namePos].sym - # due to a bug/limitation in the lambda lifting, unused inner procs - # are not transformed correctly. We work around this issue (#411) here - # by ensuring it's no inner proc (owner is a module): - if prc.skipGenericOwner.kind == skModule and sfCompileTime notin prc.flags: + 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 generatedMagics: + genProc(p.module, prc) + elif prc.skipGenericOwner.kind == skModule and sfCompileTime notin prc.flags: if ({sfExportc, sfCompilerProc} * prc.flags == {sfExportc}) or (sfExportc in prc.flags and lfExportLib in prc.loc.flags) or (prc.kind == skMethod): - # we have not only the header: - if prc.getBody.kind != nkEmpty or lfDynamicLib in prc.loc.flags: - genProc(p.module, prc) + # due to a bug/limitation in the lambda lifting, unused inner procs + # are not transformed correctly. We work around this issue (#411) here + # by ensuring it's no inner proc (owner is a module). + # Generate proc even if empty body, bugfix #11651. + genProc(p.module, prc) of nkParForStmt: genParForStmt(p, n) of nkState: genState(p, n) - of nkGotoState: genGotoState(p, n) + of nkGotoState: + # simply never set it back to 0 here from here on... + inc p.splitDecls + genGotoState(p, n) of nkBreakState: genBreakState(p, n, d) + of nkMixinStmt, nkBindStmt: discard else: internalError(p.config, n.info, "expr(" & $n.kind & "); unknown node kind") -proc genNamedConstExpr(p: BProc, n: PNode): Rope = - if n.kind == nkExprColonExpr: result = genConstExpr(p, n.sons[1]) - else: result = genConstExpr(p, n) - -proc getDefaultValue(p: BProc; typ: PType; info: TLineInfo): Rope = - var t = skipTypes(typ, abstractRange-{tyTypeDesc}) +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, tyString, tyVar, tyLent, tyPointer, tyPtr, tySequence, tyExpr, - tyStmt, tyTypeDesc, tyStatic, tyRef, tyNil: - result = rope"NIM_NIL" + 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.add rope"NIM_NIL" + of tyString, tySequence: + if optSeqDestructors in p.config.globalOptions: + result.add "{0, NIM_NIL}" + else: + 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: - if not isObjLackingTypeField(t) and not p.module.compileToCpp: - result = "{{$1}}" % [genTypeInfo(p.module, t, info)] - else: - result = rope"{}" + 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 ..< typ.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, typ.sons[i], info) + getDefaultValue(p, a, info, result) result.add "}" - of tyArray: result = rope"{}" + of tyArray: + result.add "{" + for i in 0..<toInt(lengthOrd(p.config, t.indexType)): + if i > 0: result.add ", " + getDefaultValue(p, t.elementType, info, result) + result.add "}" + #result = rope"{}" + of tyOpenArray, tyVarargs: + result.add "{NIM_NIL, 0}" of tySet: - if mapType(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 getNullValueAux(p: BProc; t: PType; obj, cons: PNode, result: var Rope; count: var int) = +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; + isConst: bool, info: TLineInfo) = case obj.kind of nkRecList: for it in obj.sons: - getNullValueAux(p, t, it, cons, result, count) + getNullValueAux(p, t, it, constOrNil, result, count, isConst, info) of nkRecCase: - getNullValueAux(p, t, obj.sons[0], cons, result, count) - for i in countup(1, sonsLen(obj) - 1): - getNullValueAux(p, t, lastSon(obj.sons[i]), cons, result, count) + getNullValueAux(p, t, obj[0], constOrNil, result, count, isConst, info) + var res = "" + if count > 0: res.add ", " + var branch = Zero + if constOrNil != nil: + ## find kind value, default is zero if not specified + for i in 1..<constOrNil.len: + if constOrNil[i].kind == nkExprColonExpr: + if constOrNil[i][0].sym.name.id == obj[0].sym.name.id: + branch = getOrdValue(constOrNil[i][1]) + break + elif i == obj[0].sym.position: + branch = getOrdValue(constOrNil[i]) + break + + let selectedBranch = caseObjDefaultBranch(obj, branch) + res.add "{" + var countB = 0 + let b = lastSon(obj[selectedBranch]) + # designated initilization is the only way to init non first element of unions + # branches are allowed to have no members (b.len == 0), in this case they don't need initializer + if b.kind == nkRecList and not isEmptyCaseObjectBranch(b): + res.add "._" & mangleRecFieldName(p.module, obj[0].sym) & "_" & $selectedBranch & " = {" + getNullValueAux(p, t, b, constOrNil, res, countB, isConst, info) + res.add "}" + elif b.kind == nkSym: + 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: if count > 0: result.add ", " inc count let field = obj.sym - for i in 1..<cons.len: - if cons[i].kind == nkExprColonExpr: - if cons[i][0].sym.name.id == field.name.id: - result.add genConstExpr(p, cons[i][1]) + 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: + genBracedInit(p, constOrNil[i][1], isConst, field.typ, result) + return + elif i == field.position: + genBracedInit(p, constOrNil[i], isConst, field.typ, result) return - elif i == field.position: - result.add genConstExpr(p, cons[i]) - return # not found, produce default value: - result.add getDefaultValue(p, field.typ, cons.info) + getDefaultValue(p, field.typ, info, result) else: - localError(p.config, cons.info, "cannot create null element for: " & $obj) + localError(p.config, info, "cannot create null element for: " & $obj) -proc getNullValueAuxT(p: BProc; orig, t: PType; obj, cons: PNode, result: var Rope; count: var int) = - var base = t.sons[0] +proc getNullValueAuxT(p: BProc; orig, t: PType; obj, constOrNil: PNode, + result: var Rope; count: var int; + isConst: bool, info: TLineInfo) = + var base = t.baseClass let oldRes = result - if not p.module.compileToCpp: result.add "{" let oldcount = count if base != nil: + result.add "{" base = skipTypes(base, skipPtrs) - getNullValueAuxT(p, orig, base, base.n, cons, result, count) - elif not isObjLackingTypeField(t) and not p.module.compileToCpp: - addf(result, "$1", [genTypeInfo(p.module, orig, obj.info)]) + getNullValueAuxT(p, orig, base, base.n, constOrNil, result, count, isConst, info) + result.add "}" + elif not isObjLackingTypeField(t): + if optTinyRtti in p.config.globalOptions: + result.add genTypeInfoV2(p.module, orig, obj.info) + else: + result.add genTypeInfoV1(p.module, orig, obj.info) inc count - getNullValueAux(p, t, obj, cons, result, count) + getNullValueAux(p, t, obj, constOrNil, result, count, isConst, info) # do not emit '{}' as that is not valid C: - if oldcount == count: result = oldres - elif not p.module.compileToCpp: result.add "}" + if oldcount == count: result = oldRes -proc genConstObjConstr(p: BProc; n: PNode): Rope = - result = nil - let t = n.typ.skipTypes(abstractInst) +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: - # addf(result, "{$1}", [genTypeInfo(p.module, t)]) + # result.addf("{$1}", [genTypeInfo(p.module, t)]) # inc count - getNullValueAuxT(p, t, t, t.n, n, result, count) - if p.module.compileToCpp: - result = "{$1}$n" % [result] - -proc genConstSimpleList(p: BProc, n: PNode): Rope = - var length = sonsLen(n) - result = rope("{") - let t = n.typ.skipTypes(abstractInst) - for i in countup(0, length - 2): - addf(result, "$1,$n", [genNamedConstExpr(p, n.sons[i])]) - if length > 0: - add(result, genNamedConstExpr(p, n.sons[length - 1])) - addf(result, "}$n", []) - -proc genConstSeq(p: BProc, n: PNode, t: PType): Rope = + result.add "{" + if t.kind == tyObject: + getNullValueAuxT(p, t, t, t.n, n, result, count, isConst, n.info) + result.add("}\n") + +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: 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; 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: 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; result: var Rope) = var data = "{{$1, $1 | NIM_STRLIT_FLAG}" % [n.len.rope] + let base = t.skipTypes(abstractInst)[0] if n.len > 0: # array part needs extra curlies: data.add(", {") - for i in countup(0, n.len - 1): + for i in 0..<n.len: if i > 0: data.addf(",$n", []) - data.add genConstExpr(p, n.sons[i]) + genBracedInit(p, n[i], isConst, base, data) data.add("}") data.add("}") - result = getTempName(p.module) - let base = t.skipTypes(abstractInst).sons[0] + let tmpName = getTempName(p.module) - appcg(p.module, cfsData, - "NIM_CONST struct {$n" & + appcg(p.module, cfsStrData, + "static $5 struct {$n" & " #TGenericSeq Sup;$n" & " $1 data[$2];$n" & "} $3 = $4;$n", [ - getTypeDesc(p.module, base), n.len.rope, result, data]) + getTypeDesc(p.module, base), n.len, tmpName, data, + if isConst: "NIM_CONST" else: ""]) + + result.add "(($1)&$2)" % [getTypeDesc(p.module, t), tmpName] + +proc genConstSeqV2(p: BProc, n: PNode, t: PType; isConst: bool; result: var Rope) = + let base = t.skipTypes(abstractInst)[0] + 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("}") - result = "(($1)&$2)" % [getTypeDesc(p.module, t), result] + let payload = getTempName(p.module) + appcg(p.module, cfsStrData, + "static $5 struct {$n" & + " NI cap; $1 data[$2];$n" & + "} $3 = {$2 | NIM_STRLIT_FLAG$4};$n", [ + getTypeDesc(p.module, base), n.len, payload, data, + if isConst: "const" else: ""]) + result.add "{$1, ($2*)&$3}" % [rope(n.len), getSeqPayloadType(p.module, t), payload] -proc genConstExpr(p: BProc, n: PNode): Rope = +proc genBracedInit(p: BProc, n: PNode; isConst: bool; optionalType: PType; result: var Rope) = case n.kind of nkHiddenStdConv, nkHiddenSubConv: - result = genConstExpr(p, n.sons[1]) - of nkCurly: - var cs: TBitSet - toBitSet(p.config, n, cs) - result = genRawSetData(cs, int(getSize(p.config, n.typ))) - of nkBracket, nkPar, nkTupleConstr, nkClosure: - var t = skipTypes(n.typ, abstractInst) - if t.kind == tySequence: - result = genConstSeq(p, n, n.typ) - elif t.kind == tyProc and t.callConv == ccClosure and not n.sons.isNil and - n.sons[0].kind == nkNilLit and n.sons[1].kind == nkNilLit: - # this hack fixes issue that nkNilLit is expanded to {NIM_NIL,NIM_NIL} - # this behaviour is needed since closure_var = nil must be - # expanded to {NIM_NIL,NIM_NIL} - # in VM closures are initialized with nkPar(nkNilLit, nkNilLit) - # leading to duplicate code like this: - # "{NIM_NIL,NIM_NIL}, {NIM_NIL,NIM_NIL}" - result = ~"{NIM_NIL,NIM_NIL}" - else: - result = genConstSimpleList(p, n) - of nkObjConstr: - result = genConstObjConstr(p, n) - else: - var d: TLoc - initLocExpr(p, n, d) - result = rdLoc(d) + genBracedInit(p, n[1], isConst, n.typ, result) + else: + var ty = tyNone + var typ: PType = nil + if optionalType == nil: + if n.kind in nkStrKinds: + ty = tyString + else: + internalError(p.config, n.info, "node has no type") + else: + typ = skipTypes(optionalType, abstractInstOwned + {tyStatic}) + ty = typ.kind + case ty + of tySet: + let cs = toBitSet(p.config, n) + genRawSetData(cs, int(getSize(p.config, n.typ)), result) + of tySequence: + if optSeqDestructors in p.config.globalOptions: + genConstSeqV2(p, n, typ, isConst, result) + else: + 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` + # guards against the case of `nkSym`, refs bug #14340. + # Conversion: nimcall -> closure. + # this hack fixes issue that nkNilLit is expanded to {NIM_NIL,NIM_NIL} + # this behaviour is needed since closure_var = nil must be + # expanded to {NIM_NIL,NIM_NIL} + # in VM closures are initialized with nkPar(nkNilLit, nkNilLit) + # leading to duplicate code like this: + # "{NIM_NIL,NIM_NIL}, {NIM_NIL,NIM_NIL}" + if n[0].kind == nkNilLit: + result.add "{NIM_NIL,NIM_NIL}" + else: + 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) + result.add rdLoc(d) + of tyArray, tyVarargs: + genConstSimpleList(p, n, isConst, result) + of tyTuple: + 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") + + var data = newRopeAppender() + genConstSimpleList(p, n, isConst, data) + + let payload = getTempName(p.module) + let ctype = getTypeDesc(p.module, typ.elementType) + let arrLen = n.len + appcg(p.module, cfsStrData, + "static $5 $1 $3[$2] = $4;$n", [ + ctype, arrLen, payload, data, + if isConst: "const" else: ""]) + result.add "{($1*)&$2, $3}" % [ctype, payload, rope arrLen] + + of tyObject: + genConstObjConstr(p, n, isConst, result) + of tyString, tyCstring: + if optSeqDestructors in p.config.globalOptions and n.kind != nkNilLit and ty == tyString: + genStringLiteralV2Const(p.module, n, isConst, result) + else: + var d: TLoc = initLocExpr(p, n) + result.add rdLoc(d) + else: + var d: TLoc = initLocExpr(p, n) + result.add rdLoc(d) diff --git a/compiler/ccgliterals.nim b/compiler/ccgliterals.nim index cfe71375e..cbef6771f 100644 --- a/compiler/ccgliterals.nim +++ b/compiler/ccgliterals.nim @@ -7,6 +7,8 @@ # distribution, for details about the copyright. # +# included from cgen.nim + ## This include file contains the logic to produce constant string ## and seq literals. The code here is responsible that ## ``const x = ["a", "b"]`` works without hidden runtime creation code. @@ -19,7 +21,7 @@ template detectVersion(field, corename) = if core == nil or core.kind != skConst: m.g.field = 1 else: - m.g.field = int ast.getInt(core.ast) + m.g.field = toInt(ast.getInt(core.astdef)) result = m.g.field proc detectStrVersion(m: BModule): int = @@ -30,62 +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) - addf(m.s[cfsData], "STRING_LITERAL($1, $2, $3);$n", - [result, makeCString(s), rope(len(s))]) +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)", - [m.tmpBase, rope(id)]) + appcg(m, result, "((#NimStringDesc*) &$1$2)", + [m.tmpBase, id]) # ------ Version 2: destructor based strings and seqs ----------------------- -proc genStringLiteralDataOnlyV2(m: BModule, s: string): Rope = - result = getTempName(m) - addf(m.s[cfsData], " static const NIM_CHAR $1[$2] = $3;$n", - [result, rope(len(s)+1), makeCString(s)]) +proc genStringLiteralDataOnlyV2(m: BModule, s: string; result: Rope; isConst: bool) = + 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): 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) + let tmp = getTempName(m) + result.add tmp + cgsym(m, "NimStrPayload") + cgsym(m, "NimStringV2") # string literal not found in the cache: - let pureLit = genStringLiteralDataOnlyV2(m, n.strVal) - result = getTempName(m) - addf(m.s[cfsData], "static const #NimStringV2 $1 = {$2, $2, $3};$n", - [result, rope(len(n.strVal)+1), pureLit]) + 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 = 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; result: var Rope) = + let id = nodeTableTestOrSet(m.dataCache, n, m.labels) + var pureLit: Rope + if id == m.labels: + pureLit = getTempName(m) + 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.addf "{$1, (NimStrPayload*)&$2}", [rope(n.strVal.len), pureLit] # ------ Version selector --------------------------------------------------- -proc genStringLiteralDataOnly(m: BModule; s: string; info: TLineInfo): Rope = +proc genStringLiteralDataOnly(m: BModule; s: string; info: TLineInfo; + isConst: bool; result: var Rope) = case detectStrVersion(m) - of 0, 1: result = genStringLiteralDataOnlyV1(m, s) - of 2: result = genStringLiteralDataOnlyV2(m, s) + of 0, 1: genStringLiteralDataOnlyV1(m, s, result) + of 2: + 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 genStringLiteralFromData(m: BModule; data: Rope; info: TLineInfo): Rope = - result = ropecg(m, "((#NimStringDesc*) &$1)", - [data]) - -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) + 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.nim b/compiler/ccgmerge_unused.nim index 664f89b73..a1413034f 100644 --- a/compiler/ccgmerge.nim +++ b/compiler/ccgmerge_unused.nim @@ -11,32 +11,29 @@ ## is needed for incremental compilation. import - ast, astalgo, ropes, options, strutils, nimlexbase, msgs, cgendata, rodutils, - intsets, platform, llstream, tables, sighashes + ast, ropes, options, strutils, nimlexbase, cgendata, rodutils, + intsets, llstream, tables, modulegraphs, pathutils # Careful! Section marks need to contain a tabulator so that they cannot # be part of C string literals. 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", - cfsVars: "NIM_merge_VARS", cfsData: "NIM_merge_DATA", + cfsVars: "NIM_merge_VARS", cfsProcs: "NIM_merge_PROCS", 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", @@ -46,11 +43,15 @@ const NimMergeEndMark = "/*\tNIM_merge_END:*/" proc genSectionStart*(fs: TCFileSection; conf: ConfigRef): Rope = + # useful for debugging and only adds at most a few lines in each file + result.add("\n/* section: ") + result.add(CFileSectionNames[fs]) + result.add(" */\n") if compilationCachePresent(conf): result = nil - add(result, "\n/*\t") - add(result, CFileSectionNames[fs]) - add(result, ":*/\n") + result.add("\n/*\t") + result.add(CFileSectionNames[fs]) + result.add(":*/\n") proc genSectionEnd*(fs: TCFileSection; conf: ConfigRef): Rope = if compilationCachePresent(conf): @@ -58,10 +59,10 @@ proc genSectionEnd*(fs: TCFileSection; conf: ConfigRef): Rope = proc genSectionStart*(ps: TCProcSection; conf: ConfigRef): Rope = if compilationCachePresent(conf): - result = rope(nil) - add(result, "\n/*\t") - add(result, CProcSectionNames[ps]) - add(result, ":*/\n") + result = rope("") + result.add("\n/*\t") + result.add(CProcSectionNames[ps]) + result.add(":*/\n") proc genSectionEnd*(ps: TCProcSection; conf: ConfigRef): Rope = if compilationCachePresent(conf): @@ -144,44 +145,36 @@ proc atEndMark(buf: cstring, pos: int): bool = proc readVerbatimSection(L: var TBaseLexer): Rope = var pos = L.bufpos - var buf = L.buf var r = newStringOfCap(30_000) while true: - case buf[pos] + case L.buf[pos] of CR: pos = nimlexbase.handleCR(L, pos) - buf = L.buf r.add('\L') of LF: pos = nimlexbase.handleLF(L, pos) - buf = L.buf r.add('\L') of '\0': doAssert(false, "ccgmerge: expected: " & NimMergeEndMark) break else: - if atEndMark(buf, pos): + if atEndMark(L.buf, pos): inc pos, NimMergeEndMark.len break - r.add(buf[pos]) + r.add(L.buf[pos]) inc pos L.bufpos = pos result = r.rope proc readKey(L: var TBaseLexer, result: var string) = var pos = L.bufpos - var buf = L.buf setLen(result, 0) - while buf[pos] in IdentChars: - result.add(buf[pos]) + while L.buf[pos] in IdentChars: + result.add(L.buf[pos]) inc pos - if buf[pos] != ':': doAssert(false, "ccgmerge: ':' expected") + if L.buf[pos] != ':': doAssert(false, "ccgmerge: ':' expected") L.bufpos = pos + 1 # skip ':' -proc newFakeType(id: int): PType = - new(result) - result.id = id - proc readTypeCache(L: var TBaseLexer, result: var TypeCache) = if ^L.bufpos != '{': doAssert(false, "ccgmerge: '{' expected") inc L.bufpos @@ -190,10 +183,7 @@ proc readTypeCache(L: var TBaseLexer, result: var TypeCache) = var key = decodeStr(L.buf, L.bufpos) if ^L.bufpos != ':': doAssert(false, "ccgmerge: ':' expected") inc L.bufpos - var value = decodeStr(L.buf, L.bufpos) - # XXX implement me - when false: - idTablePut(result, newFakeType(key), value.rope) + discard decodeStr(L.buf, L.bufpos) inc L.bufpos proc readIntSet(L: var TBaseLexer, result: var IntSet) = @@ -223,10 +213,7 @@ proc processMergeInfo(L: var TBaseLexer, m: BModule) = m.flags = cast[set[CodegenFlag]](decodeVInt(L.buf, L.bufpos) != 0) else: doAssert(false, "ccgmerge: unknown key: " & k) -when not defined(nimhygiene): - {.pragma: inject.} - -template withCFile(cfilename: string, body: untyped) = +template withCFile(cfilename: AbsoluteFile, body: untyped) = var s = llStreamOpen(cfilename, fmRead) if s == nil: return var L {.inject.}: TBaseLexer @@ -238,7 +225,7 @@ template withCFile(cfilename: string, body: untyped) = body closeBaseLexer(L) -proc readMergeInfo*(cfilename: string, m: BModule) = +proc readMergeInfo*(cfilename: AbsoluteFile, m: BModule) = ## reads the merge meta information into `m`. withCFile(cfilename): readKey(L, k) @@ -251,7 +238,7 @@ type f: TCFileSections p: TCProcSections -proc readMergeSections(cfilename: string, m: var TMergeSections) = +proc readMergeSections(cfilename: AbsoluteFile, m: var TMergeSections) = ## reads the merge sections into `m`. withCFile(cfilename): readKey(L, k) @@ -280,17 +267,17 @@ proc mergeRequired*(m: BModule): bool = if m.s[i] != nil: #echo "not empty: ", i, " ", m.s[i] return true - for i in low(TCProcSection)..high(TCProcSection): + for i in TCProcSection: if m.initProc.s(i) != nil: #echo "not empty: ", i, " ", m.initProc.s[i] return true -proc mergeFiles*(cfilename: string, m: BModule) = +proc mergeFiles*(cfilename: AbsoluteFile, m: BModule) = ## merges the C file with the old version on hard disc. var old: TMergeSections readMergeSections(cfilename, old) # do the merge; old section before new section: - for i in low(TCFileSection)..high(TCFileSection): + for i in TCFileSection: m.s[i] = old.f[i] & m.s[i] - for i in low(TCProcSection)..high(TCProcSection): + for i in TCProcSection: m.initProc.s(i) = old.p[i] & m.initProc.s(i) diff --git a/compiler/ccgreset.nim b/compiler/ccgreset.nim new file mode 100644 index 000000000..6caeb8084 --- /dev/null +++ b/compiler/ccgreset.nim @@ -0,0 +1,105 @@ +# +# +# The Nim Compiler +# (c) Copyright 2020 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +# included from cgen.nim + +## Code specialization instead of the old, incredibly slow 'genericReset' +## implementation. + +proc specializeResetT(p: BProc, accessor: Rope, typ: PType) + +proc specializeResetN(p: BProc, accessor: Rope, n: PNode; + typ: PType) = + if n == nil: return + case n.kind + of nkRecList: + for i in 0..<n.len: + specializeResetN(p, accessor, n[i], typ) + of nkRecCase: + if (n[0].kind != nkSym): internalError(p.config, n.info, "specializeResetN") + let disc = n[0].sym + 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.snippet]) + for i in 1..<n.len: + let branch = n[i] + assert branch.kind in {nkOfBranch, nkElse} + if branch.kind == nkOfBranch: + genCaseRange(p, branch) + else: + lineF(p, cpsStmts, "default:$n", []) + specializeResetN(p, accessor, lastSon(branch), typ) + lineF(p, cpsStmts, "break;$n", []) + lineF(p, cpsStmts, "} $n", []) + 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.snippet == "": fillObjectFields(p.module, typ) + if field.loc.t == nil: + internalError(p.config, n.info, "specializeResetN()") + 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) = + if typ == nil: return + + case typ.kind + of tyGenericInst, tyGenericBody, tyTypeDesc, tyAlias, tyDistinct, tyInferred, + tySink, tyOwned: + specializeResetT(p, accessor, skipModifier(typ)) + of tyArray: + 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.snippet, arraySize]) + specializeResetT(p, ropecg(p.module, "$1[$2]", [accessor, i.snippet]), typ.elementType) + lineF(p, cpsStmts, "}$n", []) + of tyObject: + 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, 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]) + + of tyProc: + if typ.callConv == ccClosure: + lineCg(p, cpsStmts, "#unsureAsgnRef((void**)&$1.ClE_0, NIM_NIL);$n", [accessor]) + lineCg(p, cpsStmts, "$1.ClP_0 = NIM_NIL;$n", [accessor]) + else: + lineCg(p, cpsStmts, "$1 = NIM_NIL;$n", [accessor]) + of tyChar, tyBool, tyEnum, tyRange, tyInt..tyUInt64: + lineCg(p, cpsStmts, "$1 = 0;$n", [accessor]) + of tyCstring, tyPointer, tyPtr, tyVar, tyLent: + lineCg(p, cpsStmts, "$1 = NIM_NIL;$n", [accessor]) + 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) = + specializeResetT(p, rdLoc(a), a.t) diff --git a/compiler/ccgstmts.nim b/compiler/ccgstmts.nim index f9654bb1f..883108f2c 100644 --- a/compiler/ccgstmts.nim +++ b/compiler/ccgstmts.nim @@ -8,79 +8,134 @@ # # 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 registerGcRoot(p: BProc, v: PSym) = - if p.config.selectedGC in {gcMarkAndSweep, gcGenerational, 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 :-) - let prc = genTraverseProcForGlobal(p.module, v, v.info) + traverseProc = genTraverseProcForGlobal(p.module, v, v.info) + + if traverseProc.len != 0 and not p.hcrOn: if sfThread in v.flags: - appcg(p.module, p.module.initProc.procSec(cpsInit), - "#nimRegisterThreadLocalMarker($1);$n", [prc]) + appcg(p.module, p.module.preInitProc.procSec(cpsInit), + "$n\t#nimRegisterThreadLocalMarker($1);$n$n", [traverseProc]) else: - appcg(p.module, p.module.initProc.procSec(cpsInit), - "#nimRegisterGlobalMarker($1);$n", [prc]) + 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 + + 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 + +template startBlock(p: BProc, start: FormatStr = "{$n", + args: varargs[Rope]): int = + lineCg(p, cpsStmts, start, args) + startBlockInternal(p) + +proc endBlock(p: BProc) + proc genVarTuple(p: BProc, n: PNode) = - var tup, field: TLoc if n.kind != nkVarTuple: internalError(p.config, n.info, "genVarTuple") - var L = sonsLen(n) # if we have a something that's been captured, use the lowering instead: - for i in countup(0, L-3): + for i in 0..<n.len-2: if n[i].kind != nkSym: - genStmts(p, lowerTupleUnpacking(p.module.g.graph, n, p.prc)) + genStmts(p, lowerTupleUnpacking(p.module.g.graph, n, p.module.idgen, p.prc)) return + # check only the first son + var forHcr = treatGlobalDifferentlyForHCR(p.module, n[0].sym) + 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) + forHcr = forHcr and not isGlobalInBlock + + if forHcr: + # check with the boolean if the initializing code for the tuple should be ran + lineCg(p, cpsStmts, "if ($1)$n", [hcrCond]) + startBlock(p) + genLineDir(p, n) - initLocExpr(p, n.sons[L-1], tup) + var tup = initLocExpr(p, n[^1]) var t = tup.t.skipTypes(abstractInst) - for i in countup(0, L-3): - let vn = n.sons[i] + for i in 0..<n.len-2: + let vn = n[i] let v = vn.sym if sfCompileTime in v.flags: continue if sfGlobal in v.flags: - assignGlobalVar(p, vn) - genObjectInit(p, cpsInit, v.typ, v.loc, true) - registerGcRoot(p, v) + assignGlobalVar(p, vn, "") + genObjectInit(p, cpsInit, v.typ, v.loc, constructObj) + registerTraverseProc(p, v) else: assignLocalVar(p, vn) - initLocalVar(p, v, immediateAsgn=isAssignedImmediately(p.config, n[L-1])) - initLoc(field, locExpr, vn, tup.storage) + initLocalVar(p, v, immediateAsgn=isAssignedImmediately(p.config, n[^1])) + var field = initLoc(locExpr, vn, tup.storage) if t.kind == tyTuple: - field.r = "$1.Field$2" % [rdLoc(tup), rope(i)] + field.snippet = "$1.Field$2" % [rdLoc(tup), rope(i)] else: - if t.n.sons[i].kind != nkSym: internalError(p.config, n.info, "genVarTuple") - field.r = "$1.$2" % [rdLoc(tup), mangleRecFieldName(p.module, t.n.sons[i].sym, t)] + if t.n[i].kind != nkSym: internalError(p.config, n.info, "genVarTuple") + field.snippet = "$1.$2" % [rdLoc(tup), mangleRecFieldName(p.module, t.n[i].sym)] putLocIntoDest(p, v.loc, field) + if forHcr or isGlobalInBlock: + hcrGlobals.add((loc: v.loc, tp: "NULL")) + + if forHcr: + # end the block where the tuple gets initialized + endBlock(p) + if forHcr or isGlobalInBlock: + # insert the registration of the globals for the different parts of the tuple at the + # start of the current scope (after they have been iterated) and init a boolean to + # check if any of them is newly introduced and the initializing code has to be ran + 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.snippet, rdLoc(curr.loc), getModuleDllPath(p.module, n[0].sym), curr.tp]) -proc genDeref(p: BProc, e: PNode, d: var TLoc; enforceDeref=false) proc loadInto(p: BProc, le, ri: PNode, a: var TLoc) {.inline.} = - if ri.kind in nkCallKinds and (ri.sons[0].kind != nkSym or - ri.sons[0].sym.magic == mNone): + if ri.kind in nkCallKinds and (ri[0].kind != nkSym or + ri[0].sym.magic == mNone): genAsgnCall(p, le, ri, a) - elif ri.kind in {nkDerefExpr, nkHiddenDeref}: + else: # this is a hacky way to fix #1181 (tmissingderef):: # # var arr1 = cast[ptr array[4, int8]](addr foo)[] @@ -88,26 +143,15 @@ proc loadInto(p: BProc, le, ri: PNode, a: var TLoc) {.inline.} = # However, fixing this properly really requires modelling 'array' as # a 'struct' in C to preserve dereferencing semantics completely. Not # worth the effort until version 1.0 is out. - genDeref(p, ri, a, enforceDeref=true) - else: + a.flags.incl(lfEnforceDeref) expr(p, ri, a) -proc startBlock(p: BProc, start: FormatStr = "{$n", - args: varargs[Rope]): int {.discardable.} = - lineCg(p, cpsStmts, start, args) - inc(p.labels) - result = len(p.blocks) - setLen(p.blocks, result + 1) - p.blocks[result].id = p.labels - p.blocks[result].nestedTryStmts = p.nestedTryStmts.len.int16 - p.blocks[result].nestedExceptStmts = p.inExceptBlockLen.int16 - -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]) @@ -116,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 - add(p.blocks[topBlock-1].sections[cpsStmts], 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 @@ -124,13 +168,14 @@ proc endBlock(p: BProc, blockEnd: Rope) = proc endBlock(p: BProc) = let topBlock = p.blocks.len - 1 - var blockEnd = if p.blocks[topBlock].label != nil: - ropecg(p.module, "} $1: ;$n", p.blocks[topBlock].label) - else: - ~"}$n" let frameLen = p.blocks[topBlock].frameLen + var blockEnd: Rope = "" if frameLen > 0: blockEnd.addf("FR_.len-=$1;$n", [frameLen.rope]) + if p.blocks[topBlock].label.len != 0: + blockEnd.addf("} $1: ;$n", [p.blocks[topBlock].label]) + else: + blockEnd.addf("}$n", []) endBlock(p, blockEnd) proc genSimpleBlock(p: BProc, stmts: PNode) {.inline.} = @@ -152,23 +197,24 @@ proc genState(p: BProc, n: PNode) = internalAssert p.config, n.len == 1 let n0 = n[0] if n0.kind == nkIntLit: - let idx = n.sons[0].intVal - linefmt(p, cpsStmts, "STATE$1: ;$n", idx.rope) + let idx = n[0].intVal + linefmt(p, cpsStmts, "STATE$1: ;$n", [idx]) elif n0.kind == nkStrLit: - linefmt(p, cpsStmts, "$1: ;$n", n0.strVal.rope) + linefmt(p, cpsStmts, "$1: ;$n", [n0.strVal]) proc blockLeaveActions(p: BProc, howManyTrys, howManyExcepts: int) = # Called by return and break stmts. - # Deals with issues faced when jumping out of try/except/finally stmts, + # Deals with issues faced when jumping out of try/except/finally stmts. - var stack = newSeq[tuple[n: PNode, inExcept: bool]](0) + var stack = newSeq[tuple[fin: PNode, inExcept: bool, label: Natural]](0) - for i in countup(1, howManyTrys): + inc p.withinBlockLeaveActions + for i in 1..howManyTrys: let tryStmt = p.nestedTryStmts.pop - if not p.module.compileToCpp or optNoCppExceptions in p.config.globalOptions: + if p.config.exc == excSetjmp: # Pop safe points generated by try if not tryStmt.inExcept: - linefmt(p, cpsStmts, "#popSafePoint();$n") + linefmt(p, cpsStmts, "#popSafePoint();$n", []) # Pop this try-stmt of the list of nested trys # so we don't infinite recurse on it in the next step. @@ -176,19 +222,21 @@ proc blockLeaveActions(p: BProc, howManyTrys, howManyExcepts: int) = # Find finally-stmt for this try-stmt # and generate a copy of its sons - var finallyStmt = lastSon(tryStmt.n) - if finallyStmt.kind == nkFinally: - genStmts(p, finallyStmt.sons[0]) + var finallyStmt = tryStmt.fin + if finallyStmt != nil: + genStmts(p, finallyStmt[0]) + + dec p.withinBlockLeaveActions # push old elements again: for i in countdown(howManyTrys-1, 0): p.nestedTryStmts.add(stack[i]) - if not p.module.compileToCpp or optNoCppExceptions in p.config.globalOptions: - # Pop exceptions that was handled by the - # except-blocks we are in + # Pop exceptions that was handled by the + # except-blocks we are in + if noSafePoints notin p.flags: for i in countdown(howManyExcepts-1, 0): - linefmt(p, cpsStmts, "#popCurrentException();$n") + linefmt(p, cpsStmts, "#popCurrentException();$n", []) proc genGotoState(p: BProc, n: PNode) = # we resist the temptation to translate it into duff's device as it later @@ -196,35 +244,34 @@ proc genGotoState(p: BProc, n: PNode) = # switch (x.state) { # case 0: goto STATE0; # ... - var a: TLoc - initLocExpr(p, n.sons[0], a) + var a: TLoc = initLocExpr(p, n[0]) lineF(p, cpsStmts, "switch ($1) {$n", [rdLoc(a)]) - p.beforeRetNeeded = true + p.flags.incl beforeRetNeeded lineF(p, cpsStmts, "case -1:$n", []) blockLeaveActions(p, howManyTrys = p.nestedTryStmts.len, howManyExcepts = p.inExceptBlockLen) lineF(p, cpsStmts, " goto BeforeRet_;$n", []) - var statesCounter = lastOrd(p.config, n.sons[0].typ) + var statesCounter = lastOrd(p.config, n[0].typ) if n.len >= 2 and n[1].kind == nkIntLit: - statesCounter = n[1].intVal + statesCounter = getInt(n[1]) let prefix = if n.len == 3 and n[2].kind == nkStrLit: n[2].strVal.rope else: rope"STATE" - for i in 0i64 .. statesCounter: + for i in 0i64..toInt64(statesCounter): lineF(p, cpsStmts, "case $2: goto $1$2;$n", [prefix, rope(i)]) lineF(p, cpsStmts, "}$n", []) proc genBreakState(p: BProc, n: PNode, d: var TLoc) = var a: TLoc - initLoc(d, locExpr, n, OnUnknown) + d = initLoc(locExpr, n, OnUnknown) - if n.sons[0].kind == nkClosure: - initLocExpr(p, n.sons[0].sons[1], a) - d.r = "(((NI*) $1)[1] < 0)" % [rdLoc(a)] + if n[0].kind == nkClosure: + a = initLocExpr(p, n[0][1]) + d.snippet = "(((NI*) $1)[1] < 0)" % [rdLoc(a)] else: - initLocExpr(p, n.sons[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}: @@ -232,85 +279,176 @@ proc genGotoVar(p: BProc; value: PNode) = else: lineF(p, cpsStmts, "goto NIMSTATE_$#;$n", [value.intVal.rope]) -proc genSingleVar(p: BProc, a: PNode) = - let vn = a.sons[0] - let v = vn.sym - if sfCompileTime in v.flags: return +proc genBracedInit(p: BProc, n: PNode; isConst: bool; optionalType: PType; result: var 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: + 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 + 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: + 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, a.sons[2]) + 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 valueAsRope = "" + potentialValueInit(p, v, value, valueAsRope) if sfGlobal in v.flags: if v.flags * {sfImportc, sfExportc} == {sfImportc} and - a.sons[2].kind == nkEmpty and + value.kind == nkEmpty and v.loc.flags * {lfHeader, lfNoDecl} != {}: return if sfPure in v.flags: # v.owner.kind != skModule: targetProc = p.module.preInitProc - assignGlobalVar(targetProc, vn) + 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. - genObjectInit(p.module.preInitProc, cpsInit, v.typ, v.loc, true) + 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): + 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) - registerGcRoot(p, v) + registerTraverseProc(p, v) else: - let value = a.sons[2] - 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: - genLineDir(p, a) - let decl = localVarDecl(p, vn) + # generate better code here: 'Foo f = x;' + genLineDir(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.sons[0].typ, abstractInst) - assert(typ.kind == tyProc) - for i in 1..<value.len: - if params != nil: params.add(~", ") - assert(sonsLen(typ) == sonsLen(typ.n)) - add(params, 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 a.sons[2].kind != nkEmpty: - genLineDir(targetProc, a) - loadInto(targetProc, a.sons[0], a.sons[2], v.loc) + 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. + var forHcr = treatGlobalDifferentlyForHCR(p.module, v) + if forHcr and targetProc.blocks.len > 3 and v.owner.kind == skModule: + # 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.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 + + # we close and reopen the global if (nim_hcr_do_init_) blocks in the main Init function + # for the module so we can have globals and top-level code be interleaved and still + # 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.snippet, rdLoc(v.loc), getModuleDllPath(p.module, v), traverseProc]) + startBlock(targetProc) + if value.kind != nkEmpty and valueAsRope.len == 0: + genLineDir(targetProc, vn) + if not isCppCtorCall: + loadInto(targetProc, vn, value, v.loc) + if forHcr: + endBlock(targetProc) + +proc genSingleVar(p: BProc, a: PNode) = + let v = a[0].sym + if sfCompileTime in v.flags: + # fix issue #12640 + # {.global, compileTime.} pragma in proc + if sfGlobal in v.flags and p.prc != nil and p.prc.kind == skProc: + discard + else: + return + genSingleVar(p, v, a[0], a[2]) proc genClosureVar(p: BProc, a: PNode) = - var immediateAsgn = a.sons[2].kind != nkEmpty + var immediateAsgn = a[2].kind != nkEmpty + var v: TLoc = initLocExpr(p, a[0]) + genLineDir(p, a) if immediateAsgn: - var v: TLoc - initLocExpr(p, a.sons[0], v) - genLineDir(p, a) - loadInto(p, a.sons[0], a.sons[2], v) + loadInto(p, a[0], a[2], v) + elif sfNoInit notin a[0][1].sym.flags: + constructLoc(p, v) proc genVarStmt(p: BProc, n: PNode) = for it in n.sons: if it.kind == nkCommentStmt: continue if it.kind == nkIdentDefs: # can be a lifted var nowadays ... - if it.sons[0].kind == nkSym: + if it[0].kind == nkSym: genSingleVar(p, it) else: genClosureVar(p, it) @@ -333,83 +471,99 @@ 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: # bug #4230: avoid false sharing between branches: if d.k == locTemp and isEmptyType(n.typ): d.k = locNone if it.len == 2: - when newScopeForIf: startBlock(p) - initLocExprSingleUse(p, it.sons[0], a) + startBlock(p) + a = initLocExprSingleUse(p, it[0]) lelse = getLabel(p) inc(p.labels) lineF(p, cpsStmts, "if (!$1) goto $2;$n", [rdLoc(a), lelse]) - when not newScopeForIf: startBlock(p) if p.module.compileToCpp: # avoid "jump to label crosses initialization" error: - add(p.s(cpsStmts), "{") - expr(p, it.sons[1], d) - add(p.s(cpsStmts), "}") + p.s(cpsStmts).add "{" + expr(p, it[1], d) + p.s(cpsStmts).add "}" else: - expr(p, it.sons[1], d) + expr(p, it[1], d) endBlock(p) - if sonsLen(n) > 1: + if n.len > 1: lineF(p, cpsStmts, "goto $1;$n", [lend]) fixLabel(p, lelse) elif it.len == 1: startBlock(p) - expr(p, it.sons[0], d) + expr(p, it[0], d) endBlock(p) else: internalError(p.config, n.info, "genIf()") - if sonsLen(n) > 1: fixLabel(p, lend) + if n.len > 1: fixLabel(p, lend) proc genReturnStmt(p: BProc, t: PNode) = if nfPreventCg in t.flags: return - p.beforeRetNeeded = true + p.flags.incl beforeRetNeeded genLineDir(p, t) - if (t.sons[0].kind != nkEmpty): genStmts(p, t.sons[0]) + if (t[0].kind != nkEmpty): genStmts(p, t[0]) blockLeaveActions(p, howManyTrys = p.nestedTryStmts.len, howManyExcepts = p.inExceptBlockLen) - if (p.finallySafePoints.len > 0): + if (p.finallySafePoints.len > 0) and noSafePoints notin p.flags: # If we're in a finally block, and we came here by exception # consume it before we return. - var safePoint = p.finallySafePoints[p.finallySafePoints.len-1] - linefmt(p, cpsStmts, "if ($1.status != 0) #popCurrentException();$n", safePoint) + var safePoint = p.finallySafePoints[^1] + linefmt(p, cpsStmts, "if ($1.status != 0) #popCurrentException();$n", [safePoint]) lineF(p, cpsStmts, "goto BeforeRet_;$n", []) proc genGotoForCase(p: BProc; caseStmt: PNode) = - for i in 1 ..< caseStmt.len: + for i in 1..<caseStmt.len: startBlock(p) - let it = caseStmt.sons[i] - for j in 0 .. it.len-2: - if it.sons[j].kind == nkRange: + let it = caseStmt[i] + for j in 0..<it.len-1: + if it[j].kind == nkRange: localError(p.config, it.info, "range notation not available for computed goto") return - let val = getOrdValue(it.sons[j]) + let val = getOrdValue(it[j]) lineF(p, cpsStmts, "NIMSTATE_$#:$n", [val.rope]) genStmts(p, it.lastSon) endBlock(p) + +iterator fieldValuePairs(n: PNode): tuple[memberSym, valueSym: PNode] = + assert(n.kind in {nkLetSection, nkVarSection}) + for identDefs in n: + if identDefs.kind == nkIdentDefs: + let valueSym = identDefs[^1] + for i in 0..<identDefs.len-2: + let memberSym = identDefs[i] + yield((memberSym: memberSym, valueSym: valueSym)) + proc genComputedGoto(p: BProc; n: PNode) = # first pass: Generate array of computed labels: + + # flatten the loop body because otherwise let and var sections + # wrapped inside stmt lists by inject destructors won't be recognised + let n = n.flattenStmts() var casePos = -1 - var arraySize: int - for i in 0 ..< n.len: - let it = n.sons[i] + var arraySize: int = 0 + for i in 0..<n.len: + let it = n[i] if it.kind == nkCaseStmt: if lastSon(it).kind != nkOfBranch: localError(p.config, it.info, "case statement must be exhaustive for computed goto"); return casePos = i - let aSize = lengthOrd(p.config, it.sons[0].typ) + if enumHasHoles(it[0].typ): + localError(p.config, it.info, + "case statement cannot work on enums with holes for computed goto"); return + let aSize = lengthOrd(p.config, it[0].typ) if aSize > 10_000: localError(p.config, it.info, "case statement has too many cases for computed goto"); return - arraySize = aSize.int - if firstOrd(p.config, it.sons[0].typ) != 0: + arraySize = toInt(aSize) + if firstOrd(p.config, it[0].typ) != 0: localError(p.config, it.info, "case statement has to start at 0 for computed goto"); return if casePos < 0: @@ -419,132 +573,162 @@ proc genComputedGoto(p: BProc; n: PNode) = let tmp = "TMP$1_" % [id.rope] var gotoArray = "static void* $#[$#] = {" % [tmp, arraySize.rope] for i in 1..arraySize-1: - gotoArray.addf("&&TMP$#_, ", [(id+i).rope]) - gotoArray.addf("&&TMP$#_};$n", [(id+arraySize).rope]) + gotoArray.addf("&&TMP$#_, ", [rope(id+i)]) + gotoArray.addf("&&TMP$#_};$n", [rope(id+arraySize)]) line(p, cpsLocals, gotoArray) - let topBlock = p.blocks.len-1 - let oldBody = p.blocks[topBlock].sections[cpsStmts] - p.blocks[topBlock].sections[cpsStmts] = nil - - for j in casePos+1 ..< n.len: genStmts(p, n.sons[j]) - let tailB = p.blocks[topBlock].sections[cpsStmts] - - p.blocks[topBlock].sections[cpsStmts] = nil - for j in 0 .. casePos-1: genStmts(p, n.sons[j]) - let tailA = p.blocks[topBlock].sections[cpsStmts] + for j in 0..<casePos: + genStmts(p, n[j]) - p.blocks[topBlock].sections[cpsStmts] = oldBody & tailA - - let caseStmt = n.sons[casePos] - var a: TLoc - initLocExpr(p, caseStmt.sons[0], a) + let caseStmt = n[casePos] + var a: TLoc = initLocExpr(p, caseStmt[0]) # first goto: lineF(p, cpsStmts, "goto *$#[$#];$n", [tmp, a.rdLoc]) - for i in 1 ..< caseStmt.len: + for i in 1..<caseStmt.len: startBlock(p) - let it = caseStmt.sons[i] - for j in 0 .. it.len-2: - if it.sons[j].kind == nkRange: + let it = caseStmt[i] + for j in 0..<it.len-1: + if it[j].kind == nkRange: localError(p.config, it.info, "range notation not available for computed goto") return - let val = getOrdValue(it.sons[j]) - lineF(p, cpsStmts, "TMP$#_:$n", [intLiteral(val+id+1)]) + + let val = getOrdValue(it[j]) + var lit = newRopeAppender() + intLiteral(toInt64(val)+id+1, lit) + lineF(p, cpsStmts, "TMP$#_:$n", [lit]) + genStmts(p, it.lastSon) - #for j in casePos+1 ..< n.len: genStmts(p, n.sons[j]) # tailB - #for j in 0 .. casePos-1: genStmts(p, n.sons[j]) # tailA - add(p.s(cpsStmts), tailB) - add(p.s(cpsStmts), tailA) - var a: TLoc - initLocExpr(p, caseStmt.sons[0], a) + for j in casePos+1..<n.len: + genStmts(p, n[j]) + + for j in 0..<casePos: + # prevent new local declarations + # compile declarations as assignments + let it = n[j] + if it.kind in {nkLetSection, nkVarSection}: + let asgn = copyNode(it) + asgn.transitionSonsKind(nkAsgn) + asgn.sons.setLen 2 + for sym, value in it.fieldValuePairs: + if value.kind != nkEmpty: + asgn[0] = sym + asgn[1] = value + genStmts(p, asgn) + else: + genStmts(p, it) + + var a: TLoc = initLocExpr(p, caseStmt[0]) lineF(p, cpsStmts, "goto *$#[$#];$n", [tmp, a.rdLoc]) endBlock(p) + for j in casePos+1..<n.len: + genStmts(p, n[j]) + + proc genWhileStmt(p: BProc, t: PNode) = # we don't generate labels here as for example GCC would produce # significantly worse code var a: TLoc - assert(sonsLen(t) == 2) + assert(t.len == 2) inc(p.withinLoop) genLineDir(p, t) preserveBreakIdx: - p.breakIdx = startBlock(p, "while (1) {$n") - p.blocks[p.breakIdx].isLoop = true - initLocExpr(p, t.sons[0], a) - if (t.sons[0].kind != nkIntLit) or (t.sons[0].intVal == 0): - let label = assignLabel(p.blocks[p.breakIdx]) - lineF(p, cpsStmts, "if (!$1) goto $2;$n", [rdLoc(a), label]) - var loopBody = t.sons[1] + var loopBody = t[1] if loopBody.stmtsContainPragma(wComputedGoto) and - hasComputedGoto in CC[p.config.cCompiler].props: - # for closure support weird loop bodies are generated: - if loopBody.len == 2 and loopBody.sons[0].kind == nkEmpty: - loopBody = loopBody.sons[1] + hasComputedGoto in CC[p.config.cCompiler].props: + # for closure support weird loop bodies are generated: + if loopBody.len == 2 and loopBody[0].kind == nkEmpty: + loopBody = loopBody[1] genComputedGoto(p, loopBody) else: + p.breakIdx = startBlock(p, "while (1) {$n") + p.blocks[p.breakIdx].isLoop = true + a = initLocExpr(p, t[0]) + if (t[0].kind != nkIntLit) or (t[0].intVal == 0): + 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: - # invoke at loop body exit: - linefmt(p, cpsStmts, "#nimProfile();$n") - endBlock(p) + if optProfiler in p.options: + # invoke at loop body exit: + linefmt(p, cpsStmts, "#nimProfile();$n", []) + endBlock(p) dec(p.withinLoop) 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 not isEmptyType(n.typ) and d.k == locNone: - getTemp(p, n.typ, d) + if not isEmptyType(n.typ): + # bug #4505: allocate the temp in the outer scope + # so that it can escape the generated {}: + if d.k == locNone: + d = getTemp(p, n.typ) + d.flags.incl(lfEnforceDeref) preserveBreakIdx: p.breakIdx = startBlock(p) - if n.sons[0].kind != nkEmpty: + if n[0].kind != nkEmpty: # named block? - assert(n.sons[0].kind == nkSym) - var sym = n.sons[0].sym + assert(n[0].kind == nkSym) + var sym = n[0].sym sym.loc.k = locOther sym.position = p.breakIdx+1 - expr(p, n.sons[1], d) + expr(p, n[1], d) endBlock(p) proc genParForStmt(p: BProc, t: PNode) = - assert(sonsLen(t) == 3) + assert(t.len == 3) inc(p.withinLoop) genLineDir(p, t) preserveBreakIdx: - let forLoopVar = t.sons[0].sym - var rangeA, rangeB: TLoc - assignLocalVar(p, t.sons[0]) + let forLoopVar = t[0].sym + assignLocalVar(p, t[0]) #initLoc(forLoopVar.loc, locLocalVar, forLoopVar.typ, onStack) #discard mangleName(forLoopVar) - let call = t.sons[1] - initLocExpr(p, call.sons[1], rangeA) - initLocExpr(p, call.sons[2], rangeB) - - lineF(p, cpsStmts, "#pragma omp parallel for $4$n" & - "for ($1 = $2; $1 <= $3; ++$1)", - [forLoopVar.loc.rdLoc, - rangeA.rdLoc, rangeB.rdLoc, - call.sons[3].getStr.rope]) + let call = t[1] + 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) + if call[0].sym.name.s == "||": # `||`(a, b, annotation) + lineF(p, cpsStmts, "$n#pragma omp $4$n" & + "for ($1 = $2; $1 <= $3; ++$1)", + [forLoopVar.loc.rdLoc, + rangeA.rdLoc, rangeB.rdLoc, + call[3].getStr.rope]) + else: + lineF(p, cpsStmts, "$n#pragma $4$n" & + "for ($1 = $2; $1 <= $3; ++$1)", + [forLoopVar.loc.rdLoc, + rangeA.rdLoc, rangeB.rdLoc, + call[3].getStr.rope]) + else: # `||`(a, b, step, annotation) + 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, + rangeA.rdLoc, rangeB.rdLoc, step.rdLoc, + call[4].getStr.rope]) p.breakIdx = startBlock(p) p.blocks[p.breakIdx].isLoop = true - genStmts(p, t.sons[2]) + genStmts(p, t[2]) endBlock(p) dec(p.withinLoop) proc genBreakStmt(p: BProc, t: PNode) = var idx = p.breakIdx - if t.sons[0].kind != nkEmpty: + if t[0].kind != nkEmpty: # named break? - assert(t.sons[0].kind == nkSym) - var sym = t.sons[0].sym + assert(t[0].kind == nkSym) + var sym = t[0].sym doAssert(sym.loc.k == locOther) idx = sym.position-1 else: @@ -552,54 +736,101 @@ 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 + 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_)) goto BeforeRet_;$n", []) + else: + 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 genRaiseStmt(p: BProc, t: PNode) = - if p.module.compileToCpp: - discard cgsym(p.module, "popCurrentExceptionEx") - if p.nestedTryStmts.len > 0 and p.nestedTryStmts[^1].inExcept: +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, # we must execute it before reraising - var finallyBlock = p.nestedTryStmts[^1].n[^1] - if finallyBlock.kind == nkFinally: + let finallyBlock = p.nestedTryStmts[^1].fin + if finallyBlock != nil: genSimpleBlock(p, finallyBlock[0]) + +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.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.add ropecg(p.module, "goto LA$1_;$n", + [p.nestedTryStmts[L-1].label]) + # + ord(p.nestedTryStmts[L-1].inExcept)]) + +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) + 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]) else: - lineCg(p, cpsStmts, "#raiseException((#Exception*)$1, $2);$n", - [e, makeCString(typ.sym.name.s)]) + lineCg(p, cpsStmts, "#raiseExceptionEx((#Exception*)$1, $2, $3, $4, $5);$n", + [e, makeCString(typ.sym.name.s), + makeCString(if p.prc != nil: p.prc.name.s else: p.module.module.name.s), + quotedFilename(p.config, t.info), toLinenumber(t.info)]) + if optOwnedRefs in p.config.globalOptions: + lineCg(p, cpsStmts, "$1 = NIM_NIL;$n", [e]) else: + finallyActions(p) genLineDir(p, t) - # reraise the last exception: - if p.module.compileToCpp and optNoCppExceptions notin p.config.globalOptions: - line(p, cpsStmts, ~"throw;$n") - else: - linefmt(p, cpsStmts, "#reraiseException();$n") + linefmt(p, cpsStmts, "#reraiseException();$n", []) + raiseInstr(p, p.s(cpsStmts)) -proc genCaseGenericBranch(p: BProc, b: PNode, e: TLoc, +template genCaseGenericBranch(p: BProc, b: PNode, e: TLoc, rangeFormat, eqFormat: FormatStr, labl: TLabel) = - var - x, y: TLoc - var length = sonsLen(b) - for i in countup(0, length - 2): - if b.sons[i].kind == nkRange: - initLocExpr(p, b.sons[i].sons[0], x) - initLocExpr(p, b.sons[i].sons[1], y) + var x, y: TLoc + for i in 0..<b.len - 1: + if b[i].kind == nkRange: + 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.sons[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, @@ -609,23 +840,23 @@ proc genCaseSecondPass(p: BProc, t: PNode, d: var TLoc, # bug #4230: avoid false sharing between branches: if d.k == locTemp and isEmptyType(t.typ): d.k = locNone lineF(p, cpsStmts, "LA$1_: ;$n", [rope(labId + i)]) - if t.sons[i].kind == nkOfBranch: - var length = sonsLen(t.sons[i]) - exprBlock(p, t.sons[i].sons[length - 1], d) + if t[i].kind == nkOfBranch: + exprBlock(p, t[i][^1], d) lineF(p, cpsStmts, "goto $1;$n", [lend]) else: - exprBlock(p, t.sons[i].sons[0], d) + exprBlock(p, t[i][0], d) result = lend -proc genIfForCaseUntil(p: BProc, t: PNode, d: var TLoc, +template genIfForCaseUntil(p: BProc, t: PNode, d: var TLoc, rangeFormat, eqFormat: FormatStr, until: int, a: TLoc): TLabel = # generate a C-if statement for a Nim case statement + var res: TLabel var labId = p.labels for i in 1..until: inc(p.labels) - if t.sons[i].kind == nkOfBranch: # else statement - genCaseGenericBranch(p, t.sons[i], a, rangeFormat, eqFormat, + if t[i].kind == nkOfBranch: # else statement + genCaseGenericBranch(p, t[i], a, rangeFormat, eqFormat, "LA" & rope(p.labels) & "_") else: lineF(p, cpsStmts, "goto LA$1_;$n", [rope(p.labels)]) @@ -633,75 +864,94 @@ proc genIfForCaseUntil(p: BProc, t: PNode, d: var TLoc, inc(p.labels) var gotoTarget = p.labels lineF(p, cpsStmts, "goto LA$1_;$n", [rope(gotoTarget)]) - result = genCaseSecondPass(p, t, d, labId, until) + res = genCaseSecondPass(p, t, d, labId, until) lineF(p, cpsStmts, "LA$1_: ;$n", [rope(gotoTarget)]) else: - result = genCaseSecondPass(p, t, d, labId, until) + res = genCaseSecondPass(p, t, d, labId, until) + res -proc genCaseGeneric(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.sons[0], a) - var lend = genIfForCaseUntil(p, t, d, rangeFormat, eqFormat, sonsLen(t)-1, 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 - var length = sonsLen(b) - for i in countup(0, length - 2): - assert(b.sons[i].kind != nkRange) - initLocExpr(p, b.sons[i], x) - assert(b.sons[i].kind in {nkStrLit..nkTripleStrLit}) - var j = int(hashString(p.config, b.sons[i].strVal) and high(branches)) - appcg(p.module, branches[j], "if (#eqStrings($1, $2)) goto $3;$n", + for i in 0..<b.len - 1: + assert(b[i].kind != nkRange) + 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 countup(1, sonsLen(t) - 1): - if t.sons[i].kind == nkOfBranch: inc(strings, sonsLen(t.sons[i]) - 1) + for i in 1..<t.len: + if t[i].kind == nkOfBranch: inc(strings, t[i].len - 1) if strings > stringCaseThreshold: var bitMask = math.nextPowerOfTwo(strings) - 1 var branches: seq[Rope] newSeq(branches, bitMask + 1) - var a: TLoc - initLocExpr(p, t.sons[0], a) # fist pass: gnerate ifs+goto: + var a: TLoc = initLocExpr(p, t[0]) # first pass: generate ifs+goto: var labId = p.labels - for i in countup(1, sonsLen(t) - 1): + for i in 1..<t.len: inc(p.labels) - if t.sons[i].kind == nkOfBranch: - genCaseStringBranch(p, t.sons[i], a, "LA" & rope(p.labels) & "_", - branches) + if t[i].kind == nkOfBranch: + genCaseStringBranch(p, t[i], a, "LA" & rope(p.labels) & "_", + 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), rope(bitMask)) - for j in countup(0, high(branches)): - if branches[j] != nil: + 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] != "": + 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.sons[sonsLen(t)-1].kind != nkOfBranch: + if t[^1].kind != nkOfBranch: lineF(p, cpsStmts, "goto LA$1_;$n", [rope(p.labels)]) # third pass: generate statements - var lend = genCaseSecondPass(p, t, d, labId, sonsLen(t)-1) + 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 = - for i in countup(0, sonsLen(b)-2): + result = false + for it in b: # last son is block - if (b.sons[i].kind == nkRange) and - b.sons[i].sons[1].intVal - b.sons[i].sons[0].intVal > RangeExpandLimit: + if (it.kind == nkRange) and + it[1].intVal - it[0].intVal > RangeExpandLimit: return true proc ifSwitchSplitPoint(p: BProc, n: PNode): int = - for i in 1..n.len-1: + result = 0 + for i in 1..<n.len: var branch = n[i] var stmtBlock = lastSon(branch) if stmtBlock.stmtsContainPragma(wLinearScanEnd): @@ -711,38 +961,42 @@ proc ifSwitchSplitPoint(p: BProc, n: PNode): int = result = i proc genCaseRange(p: BProc, branch: PNode) = - var length = branch.len - for j in 0 .. length-2: + 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.sons[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: lineF(p, cpsStmts, "switch ($1) {$n", [rdCharLoc(a)]) var hasDefault = false - for i in splitPoint+1 ..< n.len: + for i in splitPoint+1..<n.len: # bug #4230: avoid false sharing between branches: if d.k == locTemp and isEmptyType(n.typ): d.k = locNone var branch = n[i] @@ -754,36 +1008,212 @@ 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) - case skipTypes(t.sons[0].typ, abstractVarRange).kind + 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") else: - if t.sons[0].kind == nkSym and sfGoto in t.sons[0].sym.flags: + if t[0].kind == nkSym and sfGoto in t[0].sym.flags: genGotoForCase(p, t) else: genOrdinalCase(p, t, d) proc genRestoreFrameAfterException(p: BProc) = if optStackTrace in p.module.config.options: - if not p.hasCurFramePointer: - p.hasCurFramePointer = true + if hasCurFramePointer notin p.flags: + p.flags.incl hasCurFramePointer p.procSec(cpsLocals).add(ropecg(p.module, "\tTFrame* _nimCurFrame;$n", [])) p.procSec(cpsInit).add(ropecg(p.module, "\t_nimCurFrame = #getFrame();$n", [])) - linefmt(p, cpsStmts, "#setFrame(_nimCurFrame);$n") + linefmt(p, cpsStmts, "#setFrame(_nimCurFrame);$n", []) proc genTryCpp(p: BProc, t: PNode, d: var TLoc) = + #[ code to generate: + + std::exception_ptr error; + try { + body; + } catch (Exception e) { + error = std::current_exception(); + if (ofExpr(e, TypeHere)) { + + error = nullptr; // handled + } else if (...) { + + } else { + throw; + } + } catch(...) { + // C++ exception occured, not under Nim's control. + } + { + /* finally: */ + printf('fin!\n'); + if (error) std::rethrow_exception(error); // re-raise the exception + } + ]# + p.module.includeHeader("<exception>") + + if not isEmptyType(t.typ) and d.k == locNone: + d = getTemp(p, t.typ) + genLineDir(p, t) + + inc(p.labels, 2) + let etmp = p.labels + #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)) + + if t.kind == nkHiddenTryStmt: + lineCg(p, cpsStmts, "try {$n", []) + expr(p, t[0], d) + lineCg(p, cpsStmts, "}$n", []) + else: + startBlock(p, "try {$n") + expr(p, t[0], d) + endBlock(p) + + # First pass: handle Nim based exceptions: + lineCg(p, cpsStmts, "catch (#Exception* T$1_) {$n", [etmp+1]) + genRestoreFrameAfterException(p) + # an unhandled exception happened! + lineCg(p, cpsStmts, "T$1_ = std::current_exception();$n", [etmp]) + p.nestedTryStmts[^1].inExcept = true + var hasImportedCppExceptions = false + var i = 1 + var hasIf = false + var hasElse = false + while (i < t.len) and (t[i].kind == nkExceptBranch): + # bug #4230: avoid false sharing between branches: + if d.k == locTemp and isEmptyType(t.typ): d.k = locNone + if t[i].len == 1: + hasImportedCppExceptions = true + # general except section: + hasElse = true + if hasIf: lineF(p, cpsStmts, "else ", []) + startBlock(p) + # we handled the error: + expr(p, t[i][0], d) + linefmt(p, cpsStmts, "#popCurrentException();$n", []) + endBlock(p) + else: + var orExpr = newRopeAppender() + var exvar = PNode(nil) + for j in 0..<t[i].len - 1: + var typeNode = t[i][j] + if t[i][j].isInfixAs(): + typeNode = t[i][j][1] + exvar = t[i][j][2] # ex1 in `except ExceptType as ex1:` + assert(typeNode.kind == nkType) + if isImportedException(typeNode.typ, p.config): + hasImportedCppExceptions = true + else: + if orExpr.len != 0: orExpr.add("||") + let memberName = if p.module.compileToCpp: "m_type" else: "Sup.m_type" + 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.len != 0: + if hasIf: + startBlock(p, "else if ($1) {$n", [orExpr]) + else: + startBlock(p, "if ($1) {$n", [orExpr]) + hasIf = true + if exvar != nil: + 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: + linefmt(p, cpsStmts, "T$1_ = nullptr;$n", [etmp]) + expr(p, t[i][^1], d) + linefmt(p, cpsStmts, "#popCurrentException();$n", []) + endBlock(p) + inc(i) + if hasIf and not hasElse: + linefmt(p, cpsStmts, "else throw;$n", [etmp]) + linefmt(p, cpsStmts, "}$n", []) + + # Second pass: handle C++ based exceptions: + template genExceptBranchBody(body: PNode) {.dirty.} = + genRestoreFrameAfterException(p) + #linefmt(p, cpsStmts, "T$1_ = std::current_exception();$n", [etmp]) + expr(p, body, d) + + var catchAllPresent = false + incl p.flags, noSafePoints # mark as not needing 'popCurrentException' + if hasImportedCppExceptions: + for i in 1..<t.len: + if t[i].kind != nkExceptBranch: break + + # bug #4230: avoid false sharing between branches: + if d.k == locTemp and isEmptyType(t.typ): d.k = locNone + + if t[i].len == 1: + # general except section: + startBlock(p, "catch (...) {$n", []) + genExceptBranchBody(t[i][0]) + endBlock(p) + catchAllPresent = true + else: + for j in 0..<t[i].len-1: + var typeNode = t[i][j] + if t[i][j].isInfixAs(): + typeNode = t[i][j][1] + if isImportedException(typeNode.typ, p.config): + let exvar = t[i][j][2] # ex1 in `except ExceptType as ex1:` + fillLocalName(p, exvar.sym) + fillLoc(exvar.sym.loc, locTemp, exvar, OnStack) + 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) + elif isImportedException(typeNode.typ, p.config): + startBlock(p, "catch ($1&) {$n", getTypeDesc(p.module, t[i][j].typ)) + genExceptBranchBody(t[i][^1]) # exception handler body will duplicated for every type + endBlock(p) + + excl p.flags, noSafePoints + discard pop(p.nestedTryStmts) + # general finally block: + if t.len > 0 and t[^1].kind == nkFinally: + if not catchAllPresent: + startBlock(p, "catch (...) {$n", []) + genRestoreFrameAfterException(p) + linefmt(p, cpsStmts, "T$1_ = std::current_exception();$n", [etmp]) + endBlock(p) + + startBlock(p) + genStmts(p, t[^1][0]) + linefmt(p, cpsStmts, "if (T$1_) std::rethrow_exception(T$1_);$n", [etmp]) + endBlock(p) + +proc genTryCppOld(p: BProc, t: PNode, d: var TLoc) = + # There are two versions we generate, depending on whether we + # catch C++ exceptions, imported via .importcpp or not. The + # code can be easier if there are no imported C++ exceptions + # to deal with. + # code to generate: # # try @@ -805,10 +1235,11 @@ proc genTryCpp(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") - add(p.nestedTryStmts, (t, false)) + 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") expr(p, t[0], d) endBlock(p) @@ -829,10 +1260,11 @@ proc genTryCpp(p: BProc, t: PNode, d: var TLoc) = genExceptBranchBody(t[i][0]) endBlock(p) else: - for j in 0..t[i].len-2: + 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)) @@ -841,17 +1273,124 @@ proc genTryCpp(p: BProc, t: PNode, d: var TLoc) = discard pop(p.nestedTryStmts) - if not catchAllPresent and t[^1].kind == nkFinally: - # finally requires catch all presence - startBlock(p, "catch (...) {$n") + if t[^1].kind == nkFinally: + # c++ does not have finally, therefore code needs to be generated twice + if not catchAllPresent: + # finally requires catch all presence + startBlock(p, "catch (...) {$n") + genStmts(p, t[^1][0]) + line(p, cpsStmts, "throw;\n") + endBlock(p) + genSimpleBlock(p, t[^1][0]) - line(p, cpsStmts, ~"throw;$n") + +proc bodyCanRaise(p: BProc; n: PNode): bool = + case n.kind + of nkCallKinds: + result = canRaiseDisp(p, n[0]) + if not result: + # also check the arguments: + for i in 1 ..< n.len: + if bodyCanRaise(p, n[i]): return true + of nkRaiseStmt: + result = true + of nkTypeSection, nkProcDef, nkConverterDef, nkMethodDef, nkIteratorDef, + nkMacroDef, nkTemplateDef, nkLambda, nkDo, nkFuncDef: + result = false + else: + for i in 0 ..< safeLen(n): + if bodyCanRaise(p, n[i]): return true + result = false + +proc genTryGoto(p: BProc; t: PNode; d: var TLoc) = + let fin = if t[^1].kind == nkFinally: t[^1] else: nil + inc p.labels + let lab = p.labels + let hasExcept = t[1].kind == nkExceptBranch + if hasExcept: inc p.withinTryWithExcept + p.nestedTryStmts.add((fin, false, Natural lab)) + + p.flags.incl nimErrorFlagAccessed + + if not isEmptyType(t.typ) and d.k == locNone: + d = getTemp(p, t.typ) + + expr(p, t[0], d) + + if 1 < t.len and t[1].kind == nkExceptBranch: + startBlock(p, "if (NIM_UNLIKELY(*nimErr_)) {$n") + else: + startBlock(p) + linefmt(p, cpsStmts, "LA$1_:;$n", [lab]) + + p.nestedTryStmts[^1].inExcept = true + var i = 1 + while (i < t.len) and (t[i].kind == nkExceptBranch): + + inc p.labels + let nextExcept = p.labels + p.nestedTryStmts[^1].label = nextExcept + + # bug #4230: avoid false sharing between branches: + if d.k == locTemp and isEmptyType(t.typ): d.k = locNone + if t[i].len == 1: + # general except section: + if i > 1: lineF(p, cpsStmts, "else", []) + startBlock(p) + # we handled the exception, remember this: + linefmt(p, cpsStmts, "*nimErr_ = NIM_FALSE;$n", []) + expr(p, t[i][0], d) + else: + var orExpr = newRopeAppender() + for j in 0..<t[i].len - 1: + assert(t[i][j].kind == nkType) + if orExpr.len != 0: orExpr.add("||") + let memberName = if p.module.compileToCpp: "m_type" else: "Sup.m_type" + 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]) + # we handled the exception, remember this: + linefmt(p, cpsStmts, "*nimErr_ = NIM_FALSE;$n", []) + expr(p, t[i][^1], d) + + linefmt(p, cpsStmts, "#popCurrentException();$n", []) + linefmt(p, cpsStmts, "LA$1_:;$n", [nextExcept]) endBlock(p) - if t[^1].kind == nkFinally: - genSimpleBlock(p, t[^1][0]) + inc(i) + discard pop(p.nestedTryStmts) + endBlock(p) -proc genTry(p: BProc, t: PNode, d: var TLoc) = + if i < t.len and t[i].kind == nkFinally: + startBlock(p) + if not bodyCanRaise(p, t[i][0]): + # this is an important optimization; most destroy blocks are detected not to raise an + # exception and so we help the C optimizer by not mutating nimErr_ pointlessly: + genStmts(p, t[i][0]) + else: + # pretend we did handle the error for the safe execution of the 'finally' section: + p.procSec(cpsLocals).add(ropecg(p.module, "NIM_BOOL oldNimErrFin$1_;$n", [lab])) + linefmt(p, cpsStmts, "oldNimErrFin$1_ = *nimErr_; *nimErr_ = NIM_FALSE;$n", [lab]) + genStmts(p, t[i][0]) + # this is correct for all these cases: + # 1. finally is run during ordinary control flow + # 2. finally is run after 'except' block handling: these however set the + # error back to nil. + # 3. finally is run for exception handling code without any 'except' + # handler present or only handlers that did not match. + linefmt(p, cpsStmts, "*nimErr_ = oldNimErrFin$1_;$n", [lab]) + endBlock(p) + raiseExit(p) + if hasExcept: inc p.withinTryWithExcept + +proc genTrySetjmp(p: BProc, t: PNode, d: var TLoc) = # code to generate: # # XXX: There should be a standard dispatch algorithm @@ -881,98 +1420,137 @@ proc genTry(p: BProc, t: PNode, d: var TLoc) = # propagateCurrentException(); # if not isEmptyType(t.typ) and d.k == locNone: - getTemp(p, t.typ, d) - p.module.includeHeader("<setjmp.h>") + 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: + p.module.includeHeader("<setjmp.h>") + else: + p.flags.incl noSafePoints genLineDir(p, t) - var safePoint = getTempName(p.module) - discard cgsym(p.module, "Exception") - linefmt(p, cpsLocals, "#TSafePoint $1;$n", safePoint) - linefmt(p, cpsStmts, "#pushSafePoint(&$1);$n", safePoint) - if isDefined(p.config, "nimStdSetjmp"): - 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, "nimRawSetjmp"): - linefmt(p, cpsStmts, "$1.status = _setjmp($1.context);$n", safePoint) + cgsym(p.module, "Exception") + var safePoint: Rope = "" + if not quirkyExceptions: + safePoint = getTempName(p.module) + linefmt(p, cpsLocals, "#TSafePoint $1;$n", [safePoint]) + linefmt(p, cpsStmts, "#pushSafePoint(&$1);$n", [safePoint]) + if isDefined(p.config, "nimStdSetjmp"): + 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"): + 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]) + let fin = if t[^1].kind == nkFinally: t[^1] else: nil + p.nestedTryStmts.add((fin, quirkyExceptions, 0.Natural)) + expr(p, t[0], d) + if not quirkyExceptions: + linefmt(p, cpsStmts, "#popSafePoint();$n", []) + lineCg(p, cpsStmts, "}$n", []) + startBlock(p, "else {$n") + linefmt(p, cpsStmts, "#popSafePoint();$n", []) + genRestoreFrameAfterException(p) + elif 1 < t.len and t[1].kind == nkExceptBranch: + startBlock(p, "if (#nimBorrowCurrentException()) {$n") else: - linefmt(p, cpsStmts, "$1.status = setjmp($1.context);$n", safePoint) - startBlock(p, "if ($1.status == 0) {$n", [safePoint]) - var length = sonsLen(t) - add(p.nestedTryStmts, (t, false)) - expr(p, t.sons[0], d) - linefmt(p, cpsStmts, "#popSafePoint();$n") - endBlock(p) - startBlock(p, "else {$n") - linefmt(p, cpsStmts, "#popSafePoint();$n") - genRestoreFrameAfterException(p) + startBlock(p) p.nestedTryStmts[^1].inExcept = true var i = 1 - while (i < length) and (t.sons[i].kind == nkExceptBranch): + while (i < t.len) and (t[i].kind == nkExceptBranch): # bug #4230: avoid false sharing between branches: if d.k == locTemp and isEmptyType(t.typ): d.k = locNone - var blen = sonsLen(t.sons[i]) - if blen == 1: + if t[i].len == 1: # general except section: if i > 1: lineF(p, cpsStmts, "else", []) startBlock(p) - linefmt(p, cpsStmts, "$1.status = 0;$n", safePoint) - expr(p, t.sons[i].sons[0], d) - linefmt(p, cpsStmts, "#popCurrentException();$n") + if not quirkyExceptions: + linefmt(p, cpsStmts, "$1.status = 0;$n", [safePoint]) + expr(p, t[i][0], d) + linefmt(p, cpsStmts, "#popCurrentException();$n", []) endBlock(p) else: - var orExpr: Rope = nil - for j in countup(0, blen - 2): - assert(t.sons[i].sons[j].kind == nkType) - if orExpr != nil: add(orExpr, "||") - let isObjFormat = if not p.module.compileToCpp: - "#isObj(#getCurrentException()->Sup.m_type, $1)" - else: "#isObj(#getCurrentException()->m_type, $1)" - appcg(p.module, orExpr, isObjFormat, - [genTypeInfo(p.module, t[i][j].typ, t[i][j].info)]) + var orExpr = newRopeAppender() + for j in 0..<t[i].len - 1: + assert(t[i][j].kind == nkType) + if orExpr.len != 0: orExpr.add("||") + let memberName = if p.module.compileToCpp: "m_type" else: "Sup.m_type" + 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]) - linefmt(p, cpsStmts, "$1.status = 0;$n", safePoint) - expr(p, t.sons[i].sons[blen-1], d) - linefmt(p, cpsStmts, "#popCurrentException();$n") + if not quirkyExceptions: + linefmt(p, cpsStmts, "$1.status = 0;$n", [safePoint]) + expr(p, t[i][^1], d) + linefmt(p, cpsStmts, "#popCurrentException();$n", []) endBlock(p) inc(i) discard pop(p.nestedTryStmts) endBlock(p) # end of else block - if i < length and t.sons[i].kind == nkFinally: + if i < t.len and t[i].kind == nkFinally: p.finallySafePoints.add(safePoint) - genSimpleBlock(p, t.sons[i].sons[0]) + startBlock(p) + genStmts(p, t[i][0]) + # pretend we handled the exception in a 'finally' so that we don't + # re-raise the unhandled one but instead keep the old one (it was + # not popped either): + if not quirkyExceptions and getCompilerProc(p.module.g.graph, "nimLeaveFinally") != nil: + linefmt(p, cpsStmts, "if ($1.status != 0) #nimLeaveFinally();$n", [safePoint]) + endBlock(p) discard pop(p.finallySafePoints) - linefmt(p, cpsStmts, "if ($1.status != 0) #reraiseException();$n", safePoint) + 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: @@ -983,166 +1561,150 @@ proc genAsmOrEmitStmt(p: BProc, t: PNode, isAsmStmt=false): Rope = if x[j] in {'"', ':'}: # don't modify the line if already in quotes or # some clobber register list: - add(result, x); add(result, "\L") + result.add(x); result.add("\L") else: # ignore empty lines - add(result, "\"") - add(result, x) - add(result, "\\n\"\n") + result.add("\"") + result.add(x.replace("\"", "\\\"")) + 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: if p.prc == nil: # top level asm statement? - addf(p.module.s[cfsProcHeaders], CC[p.config.cCompiler].asmStmtFrmt, [s]) + p.module.s[cfsProcHeaders].add runtimeFormat(CC[p.config.cCompiler].asmStmtFrmt, [s]) else: - lineF(p, cpsStmts, 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.sons[0].kind in {nkStrLit..nkTripleStrLit}: - let sec = n.sons[0].strVal - if sec.startsWith("/*TYPESECTION*/"): result = cfsTypes + if n.len >= 1 and n[0].kind in {nkStrLit..nkTripleStrLit}: + let sec = n[0].strVal + 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.sons[1]) + var s = newRopeAppender() + genAsmOrEmitStmt(p, t[1], false, s) if p.prc == nil: # top level emit pragma? let section = determineSection(t[1]) genCLineDir(p.module.s[section], t.info, p.config) - add(p.module.s[section], s) + p.module.s[section].add(s) else: genLineDir(p, t) line(p, cpsStmts, s) -proc genBreakPoint(p: BProc, t: PNode) = - var name: string - if optEndb in p.options: - if t.kind == nkExprColonExpr: - assert(t.sons[1].kind in {nkStrLit..nkTripleStrLit}) - name = normalize(t.sons[1].strVal) - else: - inc(p.module.g.breakPointId) - name = "bp" & $p.module.g.breakPointId - genLineDir(p, t) # BUGFIX - appcg(p.module, p.module.g.breakpoints, - "#dbgRegisterBreakpoint($1, (NCSTRING)$2, (NCSTRING)$3);$n", [ - rope(toLinenumber(t.info)), makeCString(toFilename(p.config, t.info)), - makeCString(name)]) - -proc genWatchpoint(p: BProc, n: PNode) = - if optEndb notin p.options: return - var a: TLoc - initLocExpr(p, n.sons[1], a) - let typ = skipTypes(n.sons[1].typ, abstractVarRange) - lineCg(p, cpsStmts, "#dbgRegisterWatchpoint($1, (NCSTRING)$2, $3);$n", - [addrLoc(p.config, a), makeCString(renderTree(n.sons[1])), - genTypeInfo(p.module, typ, n.info)]) - 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 wBreakpoint: genBreakPoint(p, it) - of wWatchPoint: genWatchpoint(p, it) - of wInjectStmt: - var p = newProc(nil, p.module) - p.options = p.options - {optLineTrace, optStackTrace} - genStmts(p, it.sons[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 -proc fieldDiscriminantCheckNeeded(p: BProc, asgn: PNode): bool = - if optFieldCheck in p.options: - var le = asgn.sons[0] - if le.kind == nkCheckedFieldExpr: - var field = le.sons[0].sons[1].sym - result = sfDiscriminant in field.flags - elif le.kind == nkDotExpr: - var field = le.sons[1].sym - result = sfDiscriminant in field.flags proc genDiscriminantCheck(p: BProc, a, tmp: TLoc, objtype: PType, field: PSym) = var t = skipTypes(objtype, abstractVar) assert t.kind == tyObject - discard genTypeInfo(p.module, t, a.lode.info) - var L = lengthOrd(p.config, field.typ) + discard genTypeInfoV1(p.module, t, a.lode.info) if not containsOrIncl(p.module.declaredThings, field.id): appcg(p.module, cfsVars, "extern $1", - discriminatorTableDecl(p.module, t, field)) + [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(L+1)]) + lit]) + if p.config.exc == excGoto: + raiseExit(p) + +when false: + proc genCaseObjDiscMapping(p: BProc, e: PNode, t: PType, field: PSym; d: var TLoc) = + const ObjDiscMappingProcSlot = -5 + var theProc: PSym = nil + for idx, p in items(t.methods): + if idx == ObjDiscMappingProcSlot: + theProc = p + break + if theProc == nil: + theProc = genCaseObjDiscMapping(t, field, e.info, p.module.g.graph, p.module.idgen) + t.methods.add((ObjDiscMappingProcSlot, theProc)) + var call = newNodeIT(nkCall, e.info, getSysType(p.module.g.graph, e.info, tyUInt8)) + call.add newSymNode(theProc) + call.add e + expr(p, call, d) proc asgnFieldDiscriminant(p: BProc, e: PNode) = - var a, tmp: TLoc - var dotExpr = e.sons[0] - if dotExpr.kind == nkCheckedFieldExpr: dotExpr = dotExpr.sons[0] - initLocExpr(p, e.sons[0], a) - getTemp(p, a.t, tmp) - expr(p, e.sons[1], tmp) - genDiscriminantCheck(p, a, tmp, dotExpr.sons[0].typ, dotExpr.sons[1].sym) + var dotExpr = e[0] + if dotExpr.kind == nkCheckedFieldExpr: dotExpr = dotExpr[0] + var a = initLocExpr(p, e[0]) + var tmp: TLoc = getTemp(p, a.t) + expr(p, e[1], tmp) + if p.inUncheckedAssignSection == 0: + let field = dotExpr[1].sym + genDiscriminantCheck(p, a, tmp, dotExpr[0].typ, field) + message(p.config, e.info, warnCaseTransition) genAssignment(p, a, tmp, {}) -proc patchAsgnStmtListExpr(father, orig, n: PNode) = - case n.kind - of nkDerefExpr, nkHiddenDeref: - let asgn = copyNode(orig) - asgn.add orig[0] - asgn.add n - father.add asgn - of nkStmtList, nkStmtListExpr: - for x in n: - patchAsgnStmtListExpr(father, orig, x) - else: - father.add n - proc genAsgn(p: BProc, e: PNode, fastAsgn: bool) = - if e.sons[0].kind == nkSym and sfGoto in e.sons[0].sym.flags: + if e[0].kind == nkSym and sfGoto in e[0].sym.flags: + genLineDir(p, e) + genGotoVar(p, e[1]) + elif optFieldCheck in p.options and isDiscriminantField(e[0]): genLineDir(p, e) - genGotoVar(p, e.sons[1]) - elif not fieldDiscriminantCheckNeeded(p, e): - # this fixes bug #6422 but we really need to change the representation of - # arrays in the backend... + asgnFieldDiscriminant(p, e) + else: let le = e[0] let ri = e[1] - var needsRepair = false - var it = ri - while it.kind in {nkStmtList, nkStmtListExpr}: - it = it.lastSon - needsRepair = true - if it.kind in {nkDerefExpr, nkHiddenDeref} and needsRepair: - var patchedTree = newNodeI(nkStmtList, e.info) - patchAsgnStmtListExpr(patchedTree, e, ri) - genStmts(p, patchedTree) - return - - var a: TLoc - if le.kind in {nkDerefExpr, nkHiddenDeref}: - genDeref(p, le, a, enforceDeref=true) - else: - initLocExpr(p, le, a) + 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) assert(a.t != nil) genLineDir(p, ri) - loadInto(p, e.sons[0], ri, a) - else: - genLineDir(p, e) - asgnFieldDiscriminant(p, e) + 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) expr(p, t, a) - internalAssert p.config, a.k in {locNone, locTemp, locLocalVar} + if isPush: popInfoContext(p.config) + internalAssert p.config, a.k in {locNone, locTemp, locLocalVar, locExpr} diff --git a/compiler/ccgthreadvars.nim b/compiler/ccgthreadvars.nim index 3e8a87041..1f551f022 100644 --- a/compiler/ccgthreadvars.nim +++ b/compiler/ccgthreadvars.nim @@ -7,8 +7,8 @@ # distribution, for details about the copyright. # -## Thread var support for crappy architectures that lack native support for -## thread local storage. (**Thank you Mac OS X!**) +## Thread var support for architectures that lack native support for +## thread local storage. # included from cgen.nim @@ -16,12 +16,12 @@ proc emulatedThreadVars(conf: ConfigRef): bool = result = {optThreads, optTlsEmulation} <= conf.globalOptions proc accessThreadLocalVar(p: BProc, s: PSym) = - if emulatedThreadVars(p.config) and not p.threadVarAccessed: - p.threadVarAccessed = true + if emulatedThreadVars(p.config) and threadVarAccessed notin p.flags: + p.flags.incl threadVarAccessed incl p.module.flags, usesThreadVars - addf(p.procSec(cpsLocals), "\tNimThreadVars* NimTV_;$n", []) - add(p.procSec(cpsInit), - ropecg(p.module, "\tNimTV_ = (NimThreadVars*) #GetThreadLocalVars();$n")) + p.procSec(cpsLocals).addf("\tNimThreadVars* NimTV_;$n", []) + p.procSec(cpsInit).add( + ropecg(p.module, "\tNimTV_ = (NimThreadVars*) #GetThreadLocalVars();$n", [])) proc declareThreadVar(m: BModule, s: PSym, isExtern: bool) = if emulatedThreadVars(m.config): @@ -30,23 +30,30 @@ 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) - addf(m.g.nimtv, "$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: add(m.s[cfsVars], "extern ") - if optThreads in m.config.globalOptions: add(m.s[cfsVars], "NIM_THREADVAR ") - add(m.s[cfsVars], getTypeDesc(m, s.loc.t)) - addf(m.s[cfsVars], " $1;$n", [s.loc.r]) + if isExtern: m.s[cfsVars].add("extern ") + elif lfExportLib in s.loc.flags: m.s[cfsVars].add("N_LIB_EXPORT_VAR ") + else: m.s[cfsVars].add("N_LIB_PRIVATE ") + if optThreads in m.config.globalOptions: + let sym = s.typ.sym + if sym != nil and sfCppNonPod in sym.flags: + 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.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) - addf(m.s[cfsSeqTypes], "typedef struct {$1} NimThreadVars;$n", [m.g.nimtv]) + finishTypeDescriptions(m) + m.s[cfsSeqTypes].addf("typedef struct {$1} NimThreadVars;$n", [m.g.nimtv]) proc generateThreadVarsSize(m: BModule) = - if m.g.nimtv != nil: - let externc = if m.config.cmd == cmdCompileToCpp or + if m.g.nimtv != "": + let externc = if m.config.backend == backendCpp or sfCompileToCpp in m.module.flags: "extern \"C\" " else: "" - addf(m.s[cfsProcs], + m.s[cfsProcs].addf( "$#NI NimThreadVarsSize(){return (NI)sizeof(NimThreadVars);}$n", [externc.rope]) diff --git a/compiler/ccgtrav.nim b/compiler/ccgtrav.nim index 4514ce7dc..ed4c79d9a 100644 --- a/compiler/ccgtrav.nim +++ b/compiler/ccgtrav.nim @@ -7,8 +7,7 @@ # distribution, for details about the copyright. # -## Generates traversal procs for the C backend. Traversal procs are only an -## optimization; the GC works without them too. +## Generates traversal procs for the C backend. # included from cgen.nim @@ -17,27 +16,30 @@ type p: BProc visitorFrmt: string +const + visitorFrmt = "#nimGCvisit((void*)$1, $2);$n" + 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) = if n == nil: return case n.kind of nkRecList: - for i in countup(0, sonsLen(n) - 1): - genTraverseProc(c, accessor, n.sons[i], typ) + for i in 0..<n.len: + genTraverseProc(c, accessor, n[i], typ) of nkRecCase: - if (n.sons[0].kind != nkSym): internalError(c.p.config, n.info, "genTraverseProc") + if (n[0].kind != nkSym): internalError(c.p.config, n.info, "genTraverseProc") var p = c.p - let disc = n.sons[0].sym - if disc.loc.r == nil: fillObjectFields(c.p.module, typ) + let disc = n[0].sym + 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]) - for i in countup(1, sonsLen(n) - 1): - let branch = n.sons[i] + 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} if branch.kind == nkOfBranch: genCaseRange(c.p, branch) @@ -49,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.} = @@ -61,56 +63,69 @@ proc parentObj(accessor: Rope; m: BModule): Rope {.inline.} = else: result = accessor +proc genTraverseProcSeq(c: TTraversalClosure, accessor: Rope, typ: PType) proc genTraverseProc(c: TTraversalClosure, accessor: Rope, typ: PType) = if typ == nil: return var p = c.p case typ.kind of tyGenericInst, tyGenericBody, tyTypeDesc, tyAlias, tyDistinct, tyInferred, - tySink: - genTraverseProc(c, accessor, lastSon(typ)) + tySink, tyOwned: + genTraverseProc(c, accessor, skipModifier(typ)) of tyArray: - let arraySize = lengthOrd(c.p.config, typ.sons[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.rope) + [i.snippet, arraySize]) let oldLen = p.s(cpsStmts).len - genTraverseProc(c, ropecg(c.p.module, "$1[$2]", accessor, i.r), typ.sons[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 countup(0, sonsLen(typ) - 1): - var x = typ.sons[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 countup(0, sonsLen(typ) - 1): - genTraverseProc(c, ropecg(c.p.module, "$1.Field$2", accessor, i.rope), typ.sons[i]) - of tyRef, tyString, tySequence: - lineCg(p, cpsStmts, c.visitorFrmt, accessor) + 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.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]) + #genTraverseProcSeq(c, accessor, typ) + of tyString: + if tfHasAsgn notin typ.flags: + lineCg(p, cpsStmts, visitorFrmt, [accessor, c.visitorFrmt]) of tyProc: if typ.callConv == ccClosure: - lineCg(p, cpsStmts, c.visitorFrmt, ropecg(c.p.module, "$1.ClE_0", accessor)) + lineCg(p, cpsStmts, visitorFrmt, [ropecg(c.p.module, "$1.ClE_0", [accessor]), c.visitorFrmt]) else: discard 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) - lineF(p, cpsStmts, "for ($1 = 0; $1 < $2->$3; $1++) {$n", - [i.r, accessor, rope(if c.p.module.compileToCpp: "len" else: "Sup.len")]) + 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.snippet, lenExpr(c.p, a)]) let oldLen = p.s(cpsStmts).len - genTraverseProc(c, "$1->data[$2]" % [accessor, i.r], typ.sons[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 @@ -118,50 +133,58 @@ 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) - var typ = origTyp.skipTypes(abstractInst) + let + hcrOn = m.hcrOn + typ = origTyp.skipTypes(abstractInstOwned) + markerName = if hcrOn: result & "_actual" else: result + header = "static N_NIMCALL(void, $1)(void* p, NI op)" % [markerName] + t = getTypeDesc(m, typ) - let header = "static N_NIMCALL(void, $1)(void* p, NI op)" % [result] - - let t = getTypeDesc(m, typ) lineF(p, cpsLocals, "$1 a;$n", [t]) lineF(p, cpsInit, "a = ($1)p;$n", [t]) - c.p = p - c.visitorFrmt = "#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.sons[0], typedescInst).kind == tyArray: + if skipTypes(typ.elementType, typedescInst+{tyOwned}).kind == tyArray: # C's arrays are broken beyond repair: - genTraverseProc(c, "a".rope, typ.sons[0]) + genTraverseProc(c, "a".rope, typ.elementType) else: - genTraverseProc(c, "(*a)".rope, typ.sons[0]) + genTraverseProc(c, "(*a)".rope, typ.elementType) - let generatedProc = "$1 {$n$2$3$4}$n" % + let generatedProc = "$1 {$n$2$3$4}\n" % [header, p.s(cpsLocals), p.s(cpsInit), p.s(cpsStmts)] - m.s[cfsProcHeaders].addf("$1;$n", [header]) + m.s[cfsProcHeaders].addf("$1;\n", [header]) m.s[cfsProcs].add(generatedProc) + if hcrOn: + m.s[cfsProcHeaders].addf("N_NIMCALL_PTR(void, $1)(void*, NI);\n", [result]) + m.s[cfsDynLibInit].addf("\t$1 = (N_NIMCALL_PTR(void, )(void*, NI)) hcrRegisterProc($3, \"$1\", (void*)$2);\n", + [result, markerName, getModuleDllPath(m)]) + proc genTraverseProcForGlobal(m: BModule, s: PSym; info: TLineInfo): Rope = - discard genTypeInfo(m, s.loc.t, info) + discard genTypeInfoV1(m, s.loc.t, info) - var c: TTraversalClosure var p = newProc(nil, m) - var sLoc = s.loc.r + var sLoc = rdLoc(s.loc) result = getTempName(m) if sfThread in s.flags and emulatedThreadVars(m.config): accessThreadLocalVar(p, s) sLoc = "NimTV_->" & sLoc - c.visitorFrmt = "#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 82508e37e..2c2556336 100644 --- a/compiler/ccgtypes.nim +++ b/compiler/ccgtypes.nim @@ -11,10 +11,29 @@ # ------------------------- Name Mangling -------------------------------- -import sighashes -from lowerings import createObj +import sighashes, modulegraphs, std/strscans +import ../dist/checksums/src/checksums/md5 +import std/sequtils -proc genProcHeader(m: BModule, prc: PSym): 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,51 +55,72 @@ proc mangleField(m: BModule; name: PIdent): string = if isKeyword(name): result.add "_0" -when false: - proc hashOwner(s: PSym): SigHash = - var m = s - while m.kind != skModule: m = m.owner - let p = m.owner - assert p.kind == skPackage - result = gDebugInfo.register(p.name.s, m.name.s) - -proc mangleName(m: BModule; s: PSym): Rope = - result = s.loc.r - if result == nil: - result = s.name.s.mangle.rope - add(result, idOrSig(s, m.module.name.s, m.sigConflicts)) - s.loc.r = result +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, 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 - if isKeyword(s.name) or m.g.config.cppDefines.contains(res): - res.add "_0" - result = res.rope - s.loc.r = result + 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 + # is newly available. That might lead to changes in the C code in nimcache + # that contain only a parameter name change, but that is enough to mandate + # recompilation of that source file and thus a new shared object will be + # relinked. That may lead to a module getting reloaded which wasn't intended + # and that may be fatal when parts of the current active callstack when + # performCodeReload() was called are from the module being reloaded + # unintentionally - example (3 modules which import one another): + # main => proxy => reloadable + # we call performCodeReload() in proxy to reload only changes in reloadable + # but there is a new import which introduces an importc symbol `socket` + # and a function called in main or proxy uses `socket` as a parameter name. + # That would lead to either needing to reload `proxy` or to overwrite the + # executable file for the main module, which is running (or both!) -> error. + s.loc.snippet = res.rope 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) = @@ -89,40 +129,42 @@ 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 irrelevantForBackend = {tyGenericBody, tyGenericInst, tyGenericInvocation, - tyDistinct, tyRange, tyStatic, tyAlias, tySink, tyInferred} + 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}: 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)) @@ -132,21 +174,25 @@ proc mapSetType(conf: ConfigRef; typ: PType): TCTypeKind = of 8: result = ctInt64 else: result = ctArray -proc mapType(conf: ConfigRef; typ: PType): TCTypeKind = +proc mapType(conf: ConfigRef; typ: PType; isParam: bool): TCTypeKind = ## Maps a Nim type to a C type case typ.kind - of tyNone, tyStmt: result = ctVoid + of tyNone, tyTyped: result = ctVoid of tyBool: result = ctBool of tyChar: result = ctChar + of tyNil: result = ctPtr of tySet: result = mapSetType(conf, typ) - of tyOpenArray, tyArray, tyVarargs: result = ctArray + of tyOpenArray, tyVarargs: + 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) + result = mapType(conf, typ.skipModifier, isParam) of tyGenericBody, tyGenericInst, tyGenericParam, tyDistinct, tyOrdinal, - tyTypeDesc, tyAlias, tySink, tyInferred: - result = mapType(conf, lastSon(typ)) + tyTypeDesc, tyAlias, tySink, tyInferred, tyOwned: + result = mapType(conf, skipModifier(typ), isParam) of tyEnum: if firstOrd(conf, typ) < 0: result = ctInt32 @@ -157,32 +203,36 @@ proc mapType(conf: ConfigRef; typ: PType): TCTypeKind = of 4: result = ctInt32 of 8: result = ctInt64 else: result = ctInt32 - of tyRange: result = mapType(conf, typ.sons[0]) - of tyPtr, tyVar, tyLent, tyRef, tyOptAsRef: - var base = skipTypes(typ.lastSon, typedescInst) + of tyRange: result = mapType(conf, typ.elementType, isParam) + of tyPtr, tyVar, tyLent, tyRef: + var base = skipTypes(typ.elementType, typedescInst) case base.kind - of tyOpenArray, tyArray, tyVarargs: result = ctPtrToArray - #of tySet: - # if mapSetType(base) == ctArray: result = ctPtrToArray - # else: result = ctPtr - # XXX for some reason this breaks the pegs module + of tyOpenArray, tyArray, tyVarargs, tyUncheckedArray: result = ctPtrToArray + of tySet: + if mapSetType(conf, base) == ctArray: result = ctPtrToArray + else: result = ctPtr else: result = ctPtr of tyPointer: result = ctPtr 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) - 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) + result = mapType(conf, typ, false) proc isImportedType(t: PType): bool = result = t.sym != nil and sfImportc in t.sym.flags @@ -192,30 +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): Rope -proc needsComplexAssignment(typ: PType): bool = - result = containsGarbageCollectedRef(typ) +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.sons[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) + 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 = needsComplexAssignment(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 @@ -223,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_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 @@ -231,46 +300,32 @@ 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) = - if isDefined(m.config, "checkabi"): - addf(m.s[cfsTypeInfo], "NIM_CHECK_SIZE($1, $2);$n", [name, rope(getSize(m.config, t))]) +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) + var msg2 = "" + msg2.addQuoted msg # not a hostspot so extra allocation doesn't matter + 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): 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.sons[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 -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: - result = t.sym.loc.r + useHeader(m, t.sym) + 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", @@ -282,67 +337,73 @@ proc getSimpleTypeDesc(m: BModule, typ: PType): Rope = of tyString: case detectStrVersion(m) of 2: - discard cgsym(m, "string") + 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, "0") + 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.sons[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") - of tyGenericInst, tyAlias, tySink: - result = getSimpleTypeDesc(m, lastSon typ) - else: result = nil - - if result != nil and typ.isImportedType(): - let sig = hashType typ - if cacheGetType(m.typeCache, sig) == nil: + 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, skipModifier typ) + else: result = "" + + if result != "" and typ.isImportedType(): + let sig = hashType(typ, m.config) + if cacheGetType(m.typeCache, sig) == "": m.typeCache[sig] = result - addAbiCheck(m, typ, result) -proc pushType(m: BModule, typ: PType) = - add(m.typeStack, typ) +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) + if result == "": result = cacheGetType(m.typeCache, sig) -proc structOrUnion(t: PType): Rope = - let t = t.skipTypes({tyAlias, tySink}) - (if tfUnion in t.flags: rope("union") else: rope("struct")) +proc addForwardStructFormat(m: BModule; structOrUnion: Rope, typename: Rope) = + if m.compileToCpp: + m.s[cfsForwardTypes].addf "$1 $2;$n", [structOrUnion, typename] + else: + m.s[cfsForwardTypes].addf "typedef $1 $2 $2;$n", [structOrUnion, typename] -proc getForwardStructFormat(m: BModule): string = - if m.compileToCpp: result = "$1 $2;$n" - else: result = "typedef $1 $2 $2;$n" +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 - let concrete = typ.skipTypes(abstractInst + {tyOpt}) + if result != "": return + let concrete = typ.skipTypes(abstractInst) case concrete.kind of tySequence, tyTuple, tyObject: result = getTypeName(m, typ, sig) m.forwTypeCache[sig] = result if not isImportedType(concrete): - addf(m.s[cfsForwardTypes], getForwardStructFormat(m), - [structOrUnion(typ), result]) + addForwardStructFormat(m, structOrUnion(typ), result) else: pushType(m, concrete) doAssert m.forwTypeCache[sig] == result else: internalError(m.config, "getTypeForward(" & $typ.kind & ')') -proc getTypeDescWeak(m: BModule; t: PType; check: var IntSet): 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: @@ -350,15 +411,53 @@ proc getTypeDescWeak(m: BModule; t: PType; check: var IntSet): Rope = case etB.kind of tyObject, tyTuple: if isImportedCppType(etB) and t.kind == tyGenericInst: - result = getTypeDescAux(m, t, check) + 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: - result = getTypeForward(m, t, hashType(t)) & "*" - pushType(m, 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 == "": + result = getTypeName(m, t, sig) + if not isImportedType(t): + m.forwTypeCache[sig] = result + addForwardStructFormat(m, rope"struct", result) + let payload = result & "_Content" + addForwardStructFormat(m, rope"struct", payload) + + 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]) + pushType(m, t) + else: + result = getTypeForward(m, t, sig) & seqStar(m) + pushType(m, t) else: - result = getTypeDescAux(m, t, check) + result = getTypeDescAux(m, t, check, kind) + +proc getSeqPayloadType(m: BModule; t: PType): Rope = + var check = initIntSet() + 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, m.config) + let result = cacheGetType(m.typeCache, sig) + if result == "": + discard getTypeDescAux(m, t, check, dkVar) + else: + 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 { @@ -367,210 +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;) = + 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: + 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 = nil - if t.sons[0] == nil or isInvalidReturnType(m.config, t.sons[0]): - rettype = ~"void" + weakDep=false;) = + params = "(" + if t.returnType == nil or isInvalidReturnType(m.config, t): + rettype = "void" else: - rettype = getTypeDescAux(m, t.sons[0], check) - for i in countup(1, sonsLen(t.n) - 1): - if t.n.sons[i].kind != nkSym: internalError(m.config, t.n.info, "genProcParams") - var param = t.n.sons[i].sym + 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: add(params, ~", ") - fillLoc(param.loc, locParam, t.n.sons[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): - add(params, getTypeDescWeak(m, param.typ, check)) - add(params, ~"*") + 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: - add(params, getTypeDescWeak(m, param.typ, check)) + typ = (getTypeDescWeak(m, param.typ, check, descKind)) + else: + typ = (getTypeDescAux(m, param.typ, check, descKind)) + typ.add(" ") + if sfNoalias in param.flags: + typ.add("NIM_NOALIAS ") + if sfCodegenDecl notin param.flags: + params.add(typ) + params.add(param.loc.snippet) else: - add(params, getTypeDescAux(m, param.typ, check)) - add(params, ~" ") - add(params, param.loc.r) + 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}: 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: - addf(params, ", NI $1Len_$2", [param.loc.r, j.rope]) + params.addf(", NI $1Len_$2", [param.loc.snippet, j.rope]) inc(j) - arr = arr.sons[0] - if t.sons[0] != nil and isInvalidReturnType(m.config, t.sons[0]): - var arr = t.sons[0] - if params != nil: add(params, ", ") - if mapReturnType(m.config, t.sons[0]) != ctArray: - add(params, getTypeDescWeak(m, arr, check)) - add(params, "*") + arr = arr[0].skipTypes({tySink}) + 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: - add(params, getTypeDescAux(m, arr, check)) - addf(params, " Result", []) + params.add(getTypeDescAux(m, arr, check, dkResult)) + params.addf(" Result", []) if t.callConv == ccClosure and declareEnvironment: - if params != nil: add(params, ", ") - add(params, "void* ClE_0") + if params != "(": params.add(", ") + params.add("void* ClE_0") if tfVarargs in t.flags: - if params != nil: add(params, ", ") - add(params, "...") - if params == nil: add(params, "void)") - else: add(params, ")") - params = "(" & params - -proc mangleRecFieldName(m: BModule; field: PSym, rectype: PType): Rope = - if (rectype.sym != nil) and - ({sfImportc, sfExportc} * rectype.sym.flags != {}): - result = field.loc.r + if params != "(": params.add(", ") + params.add("...") + if params == "(": params.add("void)") + else: params.add(")") + +proc mangleRecFieldName(m: BModule; field: PSym): Rope = + if {sfImportc, sfExportc} * field.flags != {}: + 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, - accessExpr: Rope, rectype: PType, - check: var IntSet): Rope = - result = nil + 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; result: var Builder; unionPrefix = "") = case n.kind of nkRecList: - for i in countup(0, sonsLen(n) - 1): - add(result, genRecordFieldsAux(m, n.sons[i], accessExpr, rectype, check)) + for i in 0..<n.len: + genRecordFieldsAux(m, n[i], rectype, check, result, unionPrefix) of nkRecCase: - if n.sons[0].kind != nkSym: internalError(m.config, n.info, "genRecordFieldsAux") - add(result, genRecordFieldsAux(m, n.sons[0], accessExpr, rectype, check)) - let uname = rope(mangle(n.sons[0].sym.name.s) & 'U') - let ae = if accessExpr != nil: "$1.$2" % [accessExpr, uname] - else: uname - var unionBody: Rope = nil - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind + if n[0].kind != nkSym: internalError(m.config, n.info, "genRecordFieldsAux") + 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 = "" + for i in 1..<n.len: + case n[i].kind of nkOfBranch, nkElse: - let k = lastSon(n.sons[i]) + let k = lastSon(n[i]) if k.kind != nkSym: - let sname = "S" & rope(i) - let a = genRecordFieldsAux(m, k, "$1.$2" % [ae, sname], rectype, - check) - if a != nil: - if tfPacked notin rectype.flags: - add(unionBody, "struct {") - else: - if hasAttribute in CC[m.config.cCompiler].props: - add(unionBody, "struct __attribute__((__packed__)){" ) - else: - addf(unionBody, "#pragma pack(push, 1)$nstruct{", []) - add(unionBody, a) - addf(unionBody, "} $1;$n", [sname]) - if tfPacked in rectype.flags and hasAttribute notin CC[m.config.cCompiler].props: - addf(unionBody, "#pragma pack(pop)$n", []) + let structName = "_" & mangleRecFieldName(m, n[0].sym) & "_" & $i + var a = newBuilder("") + genRecordFieldsAux(m, k, rectype, check, a, unionPrefix & $structName & ".") + if a.len != 0: + unionBody.addFieldWithStructType(m, rectype, structName): + unionBody.add(a) else: - add(unionBody, genRecordFieldsAux(m, k, ae, rectype, check)) + genRecordFieldsAux(m, k, rectype, check, unionBody, unionPrefix) else: internalError(m.config, "genRecordFieldsAux(record case branch)") - if unionBody != nil: - addf(result, "union{$n$1} $2;$n", [unionBody, uname]) + 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, rectype) - let ae = if accessExpr != nil: "$1.$2" % [accessExpr, sname] - else: sname - fillLoc(field.loc, locField, n, ae, OnUnknown) + let sname = mangleRecFieldName(m, field) + fillLoc(field.loc, locField, n, unionPrefix & sname, OnUnknown) # for importcpp'ed objects, we only need to set field.loc, but don't # have to recurse via 'getTypeDescAux'. And not doing so prevents problems # with heavily templatized C++ code: if not isImportedCppType(rectype): let fieldType = field.loc.lode.typ.skipTypes(abstractInst) - if fieldType.kind == tyArray and tfUncheckedArray in fieldType.flags: - addf(result, "$1 $2[SEQ_DECL_SIZE];$n", - [getTypeDescAux(m, fieldType.elemType, check), sname]) - elif fieldType.kind in {tySequence, tyOpt}: + var typ: Rope = "" + var isFlexArray = false + var initializer = "" + if fieldType.kind == tyUncheckedArray: + typ = getTypeDescAux(m, fieldType.elemType, check, dkField) + isFlexArray = true + elif fieldType.kind == tySequence: # we need to use a weak dependency here for trecursive_table. - addf(result, "$1 $2;$n", [getTypeDescWeak(m, field.loc.t, check), sname]) - elif field.bitsize != 0: - addf(result, "$1 $2:$3;$n", [getTypeDescAux(m, field.loc.t, check), sname, rope($field.bitsize)]) + 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 - addf(result, "$1 $2;$n", [getTypeDescAux(m, field.loc.t, check), sname]) + 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, nil, 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) - else: - result = structOrUnion(typ) - - result.add " " - result.add name - - if typ.kind == tyObject: - - if typ.sons[0] == nil: - if (typ.sym != nil and sfPure in typ.sym.flags) or tfFinal in typ.flags: - appcg(m, result, " {$n", []) - else: - appcg(m, result, " {$n#TNimType* m_type;$n", []) - hasField = true - elif m.compileToCpp: - appcg(m, result, " : public $1 {$n", - [getTypeDescAux(m, typ.sons[0].skipTypes(skipPtrs), check)]) - if typ.isException: - 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() {if(this->raise_id) popCurrentExceptionEx(this->raise_id);}$n", [name]) - # hack: forward declare popCurrentExceptionEx() on top of type description, - # proper request to generate popCurrentExceptionEx not possible for 2 reasons: - # generated function will be below declared Exception type and circular dependency - # between Exception and popCurrentExceptionEx function - result = genProcHeader(m, magicsys.getCompilerProc(m.g.graph, "popCurrentExceptionEx")) & ";" & result - hasField = true - else: - appcg(m, result, " {$n $1 Sup;$n", - [getTypeDescAux(m, typ.sons[0].skipTypes(skipPtrs), check)]) - hasField = true - else: - addf(result, " {$n", [name]) - - let desc = getRecordFields(m, typ, check) - if desc == nil and not hasField: - addf(result, "char dummy;$n", []) + 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: - add(result, desc) - add(result, "};\L") - if tfPacked in typ.flags and hasAttribute notin CC[m.config.cCompiler].props: - result.add "#pragma pack(pop)\L" + var desc = newBuilder("") + desc.addRecordFields(m, typ, check) + result = runtimeFormat(typ.sym.cgDeclFrmt, [name, desc, baseType]) -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 countup(0, sonsLen(typ) - 1): - addf(desc, "$1 Field$2;$n", - [getTypeDescAux(m, typ.sons[i], check), rope(i)]) - if desc == nil: add(result, "char dummy;\L") - else: add(result, desc) - add(result, "};\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 @@ -592,18 +825,31 @@ 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.sons[idx] + result = typ[idx] for i in 1..stars: - if result != nil and result.len > 0: - result = if result.kind == tyGenericInst: result.sons[1] + if result != nil and result.kidsLen > 0: + result = if result.kind == tyGenericInst: result[FirstGenericParamAt] else: result.elemType -proc getTypeDescAux(m: BModule, origTyp: PType, check: var IntSet): Rope = +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 == "": + result = getTypeName(m, t, sig) + m.typeCache[sig] = result + 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: TypeDescKind): Rope = # returns only the type's name - var t = origTyp.skipTypes(irrelevantForBackend) + var t = origTyp.skipTypes(irrelevantForBackend-{tyOwned}) if containsOrIncl(check, t.id): if not (isImportedCppType(origTyp) or isImportedCppType(t)): internalError(m.config, "cannot generate C type for: " & typeToString(origTyp)) @@ -612,154 +858,178 @@ proc getTypeDescAux(m: BModule, origTyp: PType, check: var IntSet): Rope = # 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) - if result != nil: + defer: # defer is the simplest in this case + if isImportedType(t) and not m.typeABICache.containsOrIncl(sig): + addAbiCheck(m, t, result) + + 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, tyOptAsRef, tyPtr, tyVar, tyLent: - var star = if t.kind == tyVar and tfVarIsPtr notin origTyp.flags and + 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 etB.kind in {tyArray, tyOpenArray, tyVarargs}: - # this is correct! sets have no proper base type, so we treat - # ``var set[char]`` in `getParamTypeDesc` - et = elemType(etB) + 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: + et = elemType(etB) etB = et.skipTypes(abstractInst) star[0] = '*' case etB.kind of tyObject, tyTuple: if isImportedCppType(etB) and et.kind == tyGenericInst: - result = getTypeDescAux(m, et, check) & star + 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: - # no restriction! We have a forward declaration for structs - let name = getTypeForward(m, et, hashType et) - result = name & "*" & star - m.typeCache[sig] = result - pushType(m, et) + if optSeqDestructors in m.config.globalOptions: + result = getTypeDescWeak(m, et, check, kind) & star + m.typeCache[sig] = result + else: + # no restriction! We have a forward declaration for structs + let name = getTypeForward(m, et, hashType(et, m.config)) + result = name & seqStar(m) & star + m.typeCache[sig] = result + pushType(m, et) else: # else we have a strong dependency :-( - result = getTypeDescAux(m, et, check) & star + result = getTypeDescAux(m, et, check, kind) & star m.typeCache[sig] = result of tyOpenArray, tyVarargs: - result = getTypeDescWeak(m, t.sons[0], check) & "*" - m.typeCache[sig] = result + 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)): m.typeCache[sig] = result var size: int if firstOrd(m.config, t) < 0: - addf(m.s[cfsTypes], "typedef NI32 $1;$n", [result]) + m.s[cfsTypes].addf("typedef NI32 $1;$n", [result]) size = 4 else: size = int(getSize(m.config, t)) case size - of 1: addf(m.s[cfsTypes], "typedef NU8 $1;$n", [result]) - of 2: addf(m.s[cfsTypes], "typedef NU16 $1;$n", [result]) - of 4: addf(m.s[cfsTypes], "typedef NI32 $1;$n", [result]) - of 8: addf(m.s[cfsTypes], "typedef NI64 $1;$n", [result]) + of 1: m.s[cfsTypes].addf("typedef NU8 $1;$n", [result]) + of 2: m.s[cfsTypes].addf("typedef NU16 $1;$n", [result]) + of 4: m.s[cfsTypes].addf("typedef NI32 $1;$n", [result]) + of 8: m.s[cfsTypes].addf("typedef NI64 $1;$n", [result]) else: internalError(m.config, t.sym.info, "getTypeDescAux: enum") when false: let owner = hashOwner(t.sym) if not gDebugInfo.hasEnum(t.sym.name.s, t.sym.info.line, owner): var vals: seq[(string, int)] = @[] - for i in countup(0, t.n.len - 1): - assert(t.n.sons[i].kind == nkSym) - let field = t.n.sons[i].sym + for i in 0..<t.n.len: + assert(t.n[i].kind == nkSym) + let field = t.n[i].sym vals.add((field.name.s, field.position.int)) gDebugInfo.registerEnum(EnumDesc(size: size, owner: owner, id: t.sym.id, name: t.sym.name.s, values: vals)) 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! - addf(m.s[cfsTypes], "typedef $1_PTR($2, $3) $4;$n", + m.s[cfsTypes].addf("typedef $1_PTR($2, $3) $4;$n", [rope(CallingConvToStr[t.callConv]), rettype, result, desc]) else: - addf(m.s[cfsTypes], "typedef struct {$n" & + m.s[cfsTypes].addf("typedef struct {$n" & "N_NIMCALL_PTR($2, ClP_0) $3;$n" & "void* ClE_0;$n} $1;$n", [result, rettype, desc]) of tySequence: - # 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: - result = getTypeName(m, origTyp, sig) + if optSeqDestructors in m.config.globalOptions: + result = getTypeDescWeak(m, t, check, kind) + else: + # 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 == "": + result = getTypeName(m, origTyp, sig) + if not isImportedType(t): + addForwardStructFormat(m, structOrUnion(t), result) + m.forwTypeCache[sig] = result + assert(cacheGetType(m.typeCache, sig) == "") + m.typeCache[sig] = result & seqStar(m) if not isImportedType(t): - addf(m.s[cfsForwardTypes], getForwardStructFormat(m), - [structOrUnion(t), result]) - m.forwTypeCache[sig] = result - assert(cacheGetType(m.typeCache, sig) == nil) - m.typeCache[sig] = 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)) + of tyUncheckedArray: + result = getTypeName(m, origTyp, sig) + m.typeCache[sig] = result if not isImportedType(t): - if skipTypes(t.sons[0], typedescInst).kind != tyEmpty: - const - cppSeq = "struct $2 : #TGenericSeq {$n" - cSeq = "struct $2 {$n" & - " #TGenericSeq Sup;$n" - appcg(m, m.s[cfsSeqTypes], - (if m.compileToCpp: cppSeq else: cSeq) & - " $1 data[SEQ_DECL_SIZE];$n" & - "};$n", [getTypeDescAux(m, t.sons[0], check), result]) - else: - result = rope("TGenericSeq") - add(result, "*") + let foo = getTypeDescAux(m, t.elementType, check, kind) + m.s[cfsTypes].addf("typedef $1 $2[1];$n", [foo, result]) of tyArray: - var n: BiggestInt = lengthOrd(m.config, t) + var n: BiggestInt = toInt64(lengthOrd(m.config, t)) if n <= 0: n = 1 # make an array of at least one element result = getTypeName(m, origTyp, sig) m.typeCache[sig] = result if not isImportedType(t): - let foo = getTypeDescAux(m, t.sons[1], check) - addf(m.s[cfsTypes], "typedef $1 $2[$3];$n", - [foo, result, rope(n)]) - else: addAbiCheck(m, t, result) + let e = getTypeDescAux(m, t.elementType, check, kind) + m.s[cfsTypes].addf("typedef $1 $2[$3];$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 - while i < cppName.data.len: - if cppName.data[i] == '\'': + + template addResultType(ty: untyped) = + if ty == nil or ty.kind == tyVoid: + 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.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) - if typeInSlot == nil or typeInSlot.kind == tyVoid: - result.add(~"void") - elif typeInSlot.kind == tyStatic: - internalAssert m.config, typeInSlot.n != nil - result.add typeInSlot.n.renderTree - else: - result.add getTypeDescAux(m, typeInSlot, check) + 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-2: - if i > 1: result.add(" COMMA ") - result.add(getTypeDescAux(m, origTyp.sons[i], check)) + 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 @@ -767,122 +1037,206 @@ proc getTypeDescAux(m: BModule, origTyp: PType, check: var IntSet): Rope = # 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 - addf(m.s[cfsTypes], "typedef $1 $2;$n", [result, typedefName]) + let typedefName = "TY" & $sig + m.s[cfsTypes].addf("typedef $1 $2;$n", [result, typedefName]) m.typeCache[sig] = typedefName result = typedefName else: - when false: - if t.sym != nil and t.sym.name.s == "KeyValuePair": - if t == origTyp: - echo "wtf: came here" - writeStackTrace() - quit 1 result = cacheGetType(m.forwTypeCache, sig) - if result == nil: - when false: - if t.sym != nil and t.sym.name.s == "KeyValuePair": - # or {sfImportc, sfExportc} * t.sym.flags == {}: - if t.loc.r != nil: - echo t.kind, " ", hashType t - echo origTyp.kind, " ", sig - assert t.loc.r == nil + if result == "": result = getTypeName(m, origTyp, sig) m.forwTypeCache[sig] = result if not isImportedType(t): - addf(m.s[cfsForwardTypes], getForwardStructFormat(m), - [structOrUnion(t), result]) + addForwardStructFormat(m, structOrUnion(t), result) assert m.forwTypeCache[sig] == result m.typeCache[sig] = result # always call for sideeffects: if not incompleteType(t): let recdesc = if t.kind != tyTuple: getRecordDesc(m, t, result, check) else: getTupleDesc(m, t, result, check) if not isImportedType(t): - add(m.s[cfsTypes], recdesc) - elif tfIncompleteStruct notin t.flags: addAbiCheck(m, t, result) + m.s[cfsTypes].add(recdesc) + elif tfIncompleteStruct notin t.flags: + discard # addAbiCheck(m, t, result) # already handled elsewhere of tySet: - result = $t.kind & '_' & getTypeName(m, t.lastSon, hashType t.lastSon) + # Don't use the imported name as it may be scoped: 'Foo::SomeKind' + 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)) case s - of 1, 2, 4, 8: addf(m.s[cfsTypes], "typedef NU$2 $1;$n", [result, rope(s*8)]) - else: addf(m.s[cfsTypes], "typedef NU8 $1[$2];$n", + of 1, 2, 4, 8: m.s[cfsTypes].addf("typedef NU$2 $1;$n", [result, rope(s*8)]) + else: m.s[cfsTypes].addf("typedef NU8 $1[$2];$n", [result, rope(getSize(m.config, t))]) - of tyGenericInst, tyDistinct, tyOrdinal, tyTypeDesc, tyAlias, tySink, + of tyGenericInst, tyDistinct, tyOrdinal, tyTypeDesc, tyAlias, tySink, tyOwned, tyUserTypeClass, tyUserTypeClassInst, tyInferred: - result = getTypeDescAux(m, lastSon(t), check) + 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): Rope = + +proc getTypeDesc(m: BModule; typ: PType; kind = dkParam): Rope = var check = initIntSet() - result = getTypeDescAux(m, typ, check) + result = getTypeDescAux(m, typ, check, kind) type - TClosureTypeKind = enum - clHalf, clHalfWithEnv, clFull + TClosureTypeKind = enum ## In C closures are mapped to 3 different things. + clHalf, ## fn(args) type without the trailing 'void* env' parameter + 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: - addf(m.s[cfsTypes], "typedef $1_PTR($2, $3) $4;$n", + m.s[cfsTypes].addf("typedef $1_PTR($2, $3) $4;$n", [rope(CallingConvToStr[t.callConv]), rettype, result, desc]) else: - addf(m.s[cfsTypes], "typedef struct {$n" & + m.s[cfsTypes].addf("typedef struct {$n" & "N_NIMCALL_PTR($2, ClP_0) $3;$n" & "void* ClE_0;$n} $1;$n", [result, rettype, desc]) proc finishTypeDescriptions(m: BModule) = var i = 0 - while i < len(m.typeStack): - discard getTypeDesc(m, m.typeStack[i]) + var check = initIntSet() + while i < m.typeStack.len: + let t = m.typeStack[i] + if optSeqDestructors in m.config.globalOptions and t.skipTypes(abstractInst).kind == tySequence: + seqV2ContentType(m, t, check) + else: + discard getTypeDescAux(m, t, check, dkParam) inc(i) + m.typeStack.setLen 0 + +proc isReloadable(m: BModule; prc: PSym): bool = + return m.hcrOn and sfNonReloadable notin prc.flags + +proc isNonReloadable(m: BModule; prc: PSym): bool = + return m.hcrOn and sfNonReloadable in prc.flags + +proc parseVFunctionDecl(val: string; name, params, retType, superCall: var string; isFnConst, isOverride, isMemberVirtual, 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: + 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] -template cgDeclFrmt*(s: PSym): string = s.constraint.strVal + 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): Rope = - var - rettype, params: Rope - genCLineDir(result, prc.info, m.config) +proc genProcHeader(m: BModule; prc: PSym; result: var Rope; asPtr: bool = false) = # using static is needed for inline procs - 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: - result.add "static " - elif {sfImportc, sfExportc} * prc.flags == {}: - result.add "N_LIB_PRIVATE " 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.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: - addf(result, "$1($2, $3)$4", - [rope(CallingConvToStr[prc.typ.callConv]), rettype, prc.loc.r, + 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: - result = prc.cgDeclFrmt % [rettype, prc.loc.r, params] + let asPtrStr = if asPtr: (rope("(*") & name & ")") else: name + result.add runtimeFormat(prc.cgDeclFrmt, [rettype, asPtrStr, params]) + # ------------------ type info generation ------------------------------------- -proc genTypeInfo(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 = + return if m.hcrOn: "(*".rope & name & ")" else: name + proc genTypeInfoAuxBase(m: BModule; typ, origType: PType; name, base: Rope; info: TLineInfo) = var nimtypeKind: int @@ -892,229 +1246,245 @@ proc genTypeInfoAuxBase(m: BModule; typ, origType: PType; else: nimtypeKind = ord(typ.kind) + let nameHcr = tiNameForHcr(m, name) + var size: Rope - if tfIncompleteStruct in typ.flags: size = rope"void*" - else: size = getTypeDesc(m, origType) - addf(m.s[cfsTypeInit3], - "$1.size = sizeof($2);$n" & "$1.kind = $3;$n" & "$1.base = $4;$n", - [name, size, rope(nimtypeKind), base]) + if tfIncompleteStruct in typ.flags: + size = rope"void*" + else: + 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] + ) # 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: - addf(m.s[cfsTypeInit3], "$1.flags = $2;$n", [name, rope(flags)]) - discard cgsym(m, "TNimType") + m.s[cfsTypeInit3].addf("$1.flags = $2;$n", [nameHcr, rope(flags)]) + cgsym(m, "TNimType") if isDefined(m.config, "nimTypeNames"): var typename = typeToString(if origType.typeInst != nil: origType.typeInst else: origType, preferName) if typename == "ref object" and origType.skipTypes(skipPtrs).sym != nil: typename = "anon ref object from " & m.config$origType.skipTypes(skipPtrs).sym.info - addf(m.s[cfsTypeInit3], "$1.name = $2;$n", - [name, makeCstring typename]) - discard cgsym(m, "nimTypeRoot") - addf(m.s[cfsTypeInit3], "$1.nextType = nimTypeRoot; nimTypeRoot=&$1;$n", - [name]) - addf(m.s[cfsVars], "TNimType $1;$n", [name]) - -proc genTypeInfoAux(m: BModule, typ, origType: PType, name: Rope; + m.s[cfsTypeInit3].addf("$1.name = $2;$n", + [nameHcr, makeCString typename]) + cgsym(m, "nimTypeRoot") + m.s[cfsTypeInit3].addf("$1.nextType = nimTypeRoot; nimTypeRoot=&$1;$n", + [nameHcr]) + + if m.hcrOn: + 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[cfsStrData].addf("N_LIB_PRIVATE TNimType $1;$n", [name]) + +proc genTypeInfoAux(m: BModule; typ, origType: PType, name: Rope; info: TLineInfo) = var base: Rope - if sonsLen(typ) > 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") else: - base = genTypeInfo(m, x, info) + base = genTypeInfoV1(m, x, info) else: 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 + var objtype = objtype.skipTypes(abstractPtrs) while lookupInRecord(objtype.n, d.name) == nil: - objtype = objtype.sons[0] + 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 discriminatorTableDecl(m: BModule, objtype: PType, d: PSym): Rope = - discard cgsym(m, "TNimNode") +proc rope(arg: Int128): Rope = rope($arg) + +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 genObjectFields(m: BModule, typ, origType: PType, n: PNode, expr: 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", + [name, size, getModuleDllPath(m, m.module)]) + else: + m.s[cfsTypeInit1].addf("static TNimNode* $1[$2];$n", [name, size]) + +proc genObjectFields(m: BModule; typ, origType: PType, n: PNode, expr: Rope; info: TLineInfo) = case n.kind of nkRecList: - var L = sonsLen(n) - if L == 1: - genObjectFields(m, typ, origType, n.sons[0], expr, info) - elif L > 0: - var tmp = getTempName(m) - addf(m.s[cfsTypeInit1], "static TNimNode* $1[$2];$n", [tmp, rope(L)]) - for i in countup(0, L-1): + if n.len == 1: + genObjectFields(m, typ, origType, n[0], expr, info) + elif n.len > 0: + var tmp = getTempName(m) & "_" & $n.len + genTNimNodeArray(m, tmp, rope(n.len)) + for i in 0..<n.len: var tmp2 = getNimNode(m) - addf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", [tmp, rope(i), tmp2]) - genObjectFields(m, typ, origType, n.sons[i], tmp2, info) - addf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n", - [expr, rope(L), tmp]) + m.s[cfsTypeInit3].addf("$1[$2] = &$3;$n", [tmp, rope(i), tmp2]) + genObjectFields(m, typ, origType, n[i], tmp2, info) + m.s[cfsTypeInit3].addf("$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n", + [expr, rope(n.len), tmp]) else: - addf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2;$n", [expr, rope(L)]) + m.s[cfsTypeInit3].addf("$1.len = $2; $1.kind = 2;$n", [expr, rope(n.len)]) of nkRecCase: - assert(n.sons[0].kind == nkSym) - var field = n.sons[0].sym + assert(n[0].kind == nkSym) + var field = n[0].sym 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") - addf(m.s[cfsTypeInit3], "$1.kind = 3;$n" & + 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), field.loc.r, - genTypeInfo(m, field.typ, info), + "$1.len = $7;$n", [expr, getTypeDesc(m, origType, dkVar), field.loc.snippet, + genTypeInfoV1(m, field.typ, info), makeCString(field.name.s), tmp, rope(L)]) - addf(m.s[cfsData], "TNimNode* $1[$2];$n", [tmp, rope(L+1)]) - for i in countup(1, sonsLen(n)-1): - var b = n.sons[i] # branch + m.s[cfsData].addf("TNimNode* $1[$2];$n", [tmp, rope(L+1)]) + for i in 1..<n.len: + var b = n[i] # branch var tmp2 = getNimNode(m) genObjectFields(m, typ, origType, lastSon(b), tmp2, info) case b.kind of nkOfBranch: - if sonsLen(b) < 2: + if b.len < 2: internalError(m.config, b.info, "genObjectFields; nkOfBranch broken") - for j in countup(0, sonsLen(b) - 2): - if b.sons[j].kind == nkRange: - var x = int(getOrdValue(b.sons[j].sons[0])) - var y = int(getOrdValue(b.sons[j].sons[1])) + for j in 0..<b.len - 1: + if b[j].kind == nkRange: + var x = toInt(getOrdValue(b[j][0])) + var y = toInt(getOrdValue(b[j][1])) while x <= y: - addf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", [tmp, rope(x), tmp2]) + m.s[cfsTypeInit3].addf("$1[$2] = &$3;$n", [tmp, rope(x), tmp2]) inc(x) else: - addf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", - [tmp, rope(getOrdValue(b.sons[j])), tmp2]) + m.s[cfsTypeInit3].addf("$1[$2] = &$3;$n", + [tmp, rope(getOrdValue(b[j])), tmp2]) of nkElse: - addf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", + m.s[cfsTypeInit3].addf("$1[$2] = &$3;$n", [tmp, rope(L), tmp2]) else: internalError(m.config, n.info, "genObjectFields(nkRecCase)") of nkSym: var field = n.sym + # 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") - addf(m.s[cfsTypeInit3], "$1.kind = 1;$n" & + 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), - field.loc.r, genTypeInfo(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) - addf(m.s[cfsTypeInit3], "$1.node = &$2;$n", [name, tmp]) - var t = typ.sons[0] + m.s[cfsTypeInit3].addf("$1.node = &$2;$n", [tiNameForHcr(m, name), tmp]) + var t = typ.baseClass while t != nil: t = t.skipTypes(skipPtrs) t.flags.incl tfObjHasKids - t = t.sons[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) - var length = sonsLen(typ) - if length > 0: - var tmp = getTempName(m) - addf(m.s[cfsTypeInit1], "static TNimNode* $1[$2];$n", [tmp, rope(length)]) - for i in countup(0, length - 1): - var a = typ.sons[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) - addf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", [tmp, rope(i), tmp2]) - addf(m.s[cfsTypeInit3], "$1.kind = 1;$n" & + 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), rope(i), genTypeInfo(m, a, info)]) - addf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n", - [expr, rope(length), tmp]) + [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.kidsLen), tmp]) else: - addf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2;$n", - [expr, rope(length)]) - addf(m.s[cfsTypeInit3], "$1.node = &$2;$n", [name, expr]) + m.s[cfsTypeInit3].addf("$1.len = $2; $1.kind = 2;$n", + [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 # positions will be reset after the loop. genTypeInfoAux(m, typ, typ, name, info) - var nodePtrs = getTempName(m) - var length = sonsLen(typ.n) - addf(m.s[cfsTypeInit1], "static TNimNode* $1[$2];$n", - [nodePtrs, rope(length)]) - var enumNames, specialCases: Rope + var nodePtrs = getTempName(m) & "_" & $typ.n.len + genTNimNodeArray(m, nodePtrs, rope(typ.n.len)) + var enumNames, specialCases: Rope = "" var firstNimNode = m.typeNodes var hasHoles = false - for i in countup(0, length - 1): - assert(typ.n.sons[i].kind == nkSym) - var field = typ.n.sons[i].sym + for i in 0..<typ.n.len: + assert(typ.n[i].kind == nkSym) + var field = typ.n[i].sym var elemNode = getNimNode(m) if field.ast == nil: # no explicit string literal for the enum field, so use field.name: - add(enumNames, makeCString(field.name.s)) + enumNames.add(makeCString(field.name.s)) else: - add(enumNames, makeCString(field.ast.strVal)) - if i < length - 1: add(enumNames, ", \L") + enumNames.add(makeCString(field.ast.strVal)) + if i < typ.n.len - 1: enumNames.add(", \L") if field.position != i or tfEnumHasHoles in typ.flags: - addf(specialCases, "$1.offset = $2;$n", [elemNode, rope(field.position)]) + specialCases.addf("$1.offset = $2;$n", [elemNode, rope(field.position)]) hasHoles = true var enumArray = getTempName(m) var counter = getTempName(m) - addf(m.s[cfsTypeInit1], "NI $1;$n", [counter]) - addf(m.s[cfsTypeInit1], "static char* NIM_CONST $1[$2] = {$n$3};$n", - [enumArray, rope(length), enumNames]) - addf(m.s[cfsTypeInit3], "for ($1 = 0; $1 < $2; $1++) {$n" & + m.s[cfsTypeInit1].addf("NI $1;$n", [counter]) + m.s[cfsTypeInit1].addf("static char* NIM_CONST $1[$2] = {$n$3};$n", + [enumArray, rope(typ.n.len), enumNames]) + m.s[cfsTypeInit3].addf("for ($1 = 0; $1 < $2; $1++) {$n" & "$3[$1+$4].kind = 1;$n" & "$3[$1+$4].offset = $1;$n" & "$3[$1+$4].name = $5[$1];$n" & "$6[$1] = &$3[$1+$4];$n" & "}$n", [counter, - rope(length), m.typeNodesName, rope(firstNimNode), enumArray, nodePtrs]) - add(m.s[cfsTypeInit3], specialCases) - addf(m.s[cfsTypeInit3], + rope(typ.n.len), m.typeNodesName, rope(firstNimNode), enumArray, nodePtrs]) + m.s[cfsTypeInit3].add(specialCases) + m.s[cfsTypeInit3].addf( "$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n$4.node = &$1;$n", - [getNimNode(m), rope(length), nodePtrs, name]) + [getNimNode(m), rope(typ.n.len), nodePtrs, tiNameForHcr(m, name)]) if hasHoles: # 1 << 2 is {ntfEnumHole} - addf(m.s[cfsTypeInit3], "$1.flags = 1<<2;$n", [name]) + m.s[cfsTypeInit3].addf("$1.flags = 1<<2;$n", [tiNameForHcr(m, name)]) -proc genSetInfo(m: BModule, typ: PType, name: Rope; info: TLineInfo) = - assert(typ.sons[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) - addf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 0;$n" & "$3.node = &$1;$n", - [tmp, rope(firstOrd(m.config, typ)), name]) + 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, genTypeInfo(m, typ.sons[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, owner) - result.rawAddSon(newType(tyPointer, owner)) - var r = newType(tyRef, owner) - let obj = createObj(m.g.graph, owner, owner.info, final=false) + 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) @@ -1122,79 +1492,440 @@ include ccgtrav proc genDeepCopyProc(m: BModule; s: PSym; result: Rope) = genProc(m, s) - addf(m.s[cfsTypeInit3], "$1.deepcopy =(void* (N_RAW_NIMCALL*)(void*))$2;$n", - [result, s.loc.r]) + m.s[cfsTypeInit3].addf("$1.deepcopy =(void* (N_RAW_NIMCALL*)(void*))$2;$n", + [result, s.loc.snippet]) + +proc declareNimType(m: BModule; name: string; str: Rope, module: int) = + let nr = rope(name) + if m.hcrOn: + 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[cfsStrData].addf("extern $2 $1;$n", [str, nr]) + +proc genTypeInfo2Name(m: BModule; t: PType): Rope = + var it = t + 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: + 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 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 + # finalizer is: ``proc (x: ref T) {.nimcall.}``. We need to check the calling + # convention at least: + if theProc.typ == nil or theProc.typ.callConv != ccNimCall: + localError(m.config, info, + theProc.name.s & " needs to have the 'nimcall' calling convention") + + 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 + containsGarbageCollectedRef(t): + # 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.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]) + + 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) -proc genTypeInfo(m: BModule, t: PType; info: TLineInfo): Rope = + addf(typeEntry, "; $1.traceImpl = (void*)", [name]) + genHook(m, t, info, attachedTrace, 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)) + + 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 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 = + 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, m.config) + result = m.typeInfoMarkerV2.getOrDefault(sig) + if result != "": + return prefixTI.rope & result & ")".rope + + let marker = m.g.typeInfoMarkerV2.getOrDefault(sig) + if marker.str != "": + cgsym(m, "TNimTypeV2") + declareNimType(m, "TNimTypeV2", marker.str, marker.owner) + # also store in local type section: + m.typeInfoMarkerV2[sig] = marker.str + return prefixTI.rope & marker.str & ")".rope + + result = "NTIv2$1_" % [rope($sig)] + m.typeInfoMarkerV2[sig] = result + + let owner = t.skipTypes(typedescPtrs).itemId.module + 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 + cgsym(m, "TNimTypeV2") + declareNimType(m, "TNimTypeV2", result, owner) + return prefixTI.rope & result & ")".rope + + m.g.typeInfoMarkerV2[sig] = (str: result, owner: owner) + 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, 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) + +proc typeToC(t: PType): string = + ## Just for more readable names, the result doesn't have + ## to be unique. + let s = typeToString(t) + result = newStringOfCap(s.len) + for c in s: + case c + of 'a'..'z': + result.add c + of 'A'..'Z': + result.add toLowerAscii(c) + of ' ': + discard + of ',': + result.add '_' + of '.': + result.add 'O' + of '[', '(', '{': + result.add 'L' + of ']', ')', '}': + result.add 'T' + else: + # We mangle upper letters and digits too so that there cannot + # be clashes with our special meanings + result.addInt ord(c) + +proc genTypeInfoV1(m: BModule; t: PType; info: TLineInfo): Rope = let origType = t var t = skipTypes(origType, irrelevantForBackend + tyUserTypeClasses) - let sig = hashType(origType) + let prefixTI = if m.hcrOn: "(" else: "(&" + + let sig = hashType(origType, m.config) result = m.typeInfoMarker.getOrDefault(sig) - if result != nil: - return "(&".rope & result & ")".rope - - result = m.g.typeInfoMarker.getOrDefault(sig) - if result != nil: - discard cgsym(m, "TNimType") - discard cgsym(m, "TNimNode") - addf(m.s[cfsVars], "extern TNimType $1;$n", [result]) + if result != "": + return prefixTI.rope & result & ")".rope + + let marker = m.g.typeInfoMarker.getOrDefault(sig) + 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] = result - return "(&".rope & result & ")".rope + m.typeInfoMarker[sig] = marker.str + return prefixTI.rope & marker.str & ")".rope - result = "NTI$1_" % [rope($sig)] + result = "NTI$1$2_" % [rope(typeToC(t)), rope($sig)] m.typeInfoMarker[sig] = result - let owner = t.skipTypes(typedescPtrs).owner.getModule - if owner != m.module: + let old = m.g.graph.emittedTypeInfo.getOrDefault($result) + if old != FileIndex(0): + 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.g.graph, FileIndex owner): # make sure the type info is created in the owner module - discard genTypeInfo(m.g.modules[owner.position], origType, info) + discard genTypeInfoV1(m.g.modules[owner], origType, info) # reference the type info as extern here - discard cgsym(m, "TNimType") - discard cgsym(m, "TNimNode") - addf(m.s[cfsVars], "extern TNimType $1;$n", [result]) - return "(&".rope & result & ")".rope + cgsym(m, "TNimType") + cgsym(m, "TNimNode") + declareNimType(m, "TNimType", result, owner) + return prefixTI.rope & result & ")".rope + else: + owner = m.module.position.int32 + + m.g.typeInfoMarker[sig] = (str: result, owner: owner) + rememberEmittedTypeInfo(m.g.graph, FileIndex(owner), $result) - m.g.typeInfoMarker[sig] = result 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 = genTypeInfo(m, lastSon t, info) - else: internalError(m.config, "genTypeInfo(" & $t.kind & ')') + 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 genTypeInfo(m, t.lastSon, info) + return genTypeInfoV1(m, t.skipModifier, info) of tyProc: if t.callConv != ccClosure: genTypeInfoAuxBase(m, t, t, result, rope"0", info) else: let x = fakeClosureType(m, t.owner) genTupleInfo(m, x, x, result, info) - of tySequence, tyRef, tyOptAsRef: + of tySequence: genTypeInfoAux(m, t, t, result, info) - if m.config.selectedGC >= gcMarkAndSweep: + if m.config.selectedGC in {gcMarkAndSweep, gcRefc, gcGo}: let markerProc = genTraverseProc(m, origType, sig) - addf(m.s[cfsTypeInit3], "$1.marker = $2;$n", [result, markerProc]) - of tyPtr, tyRange: genTypeInfoAux(m, t, t, result, info) + 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, 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) of tyArray: genArrayInfo(m, t, result, info) of tySet: genSetInfo(m, t, result, info) of tyEnum: genEnumInfo(m, t, result, info) - of tyObject: genObjectInfo(m, t, origType, result, info) + of tyObject: + genObjectInfo(m, t, origType, result, info) of tyTuple: # if t.n != nil: genObjectInfo(m, t, result) # else: # BUGFIX: use consistently RTTI without proper field names; otherwise # results are not deterministic! genTupleInfo(m, t, origType, result, info) - else: internalError(m.config, "genTypeInfo(" & $t.kind & ')') - if t.deepCopy != nil: - genDeepCopyProc(m, t.deepCopy, result) - elif origType.deepCopy != nil: - genDeepCopyProc(m, origType.deepCopy, result) - result = "(&".rope & result & ")".rope + of tyOpenArray: + let x = openArrayToTuple(m, t) + genTupleInfo(m, x, origType, result, info) + else: internalError(m.config, "genTypeInfoV1(" & $t.kind & ')') + + var op = getAttachedOp(m.g.graph, t, attachedDeepCopy) + if op == nil: + op = getAttachedOp(m.g.graph, origType, attachedDeepCopy) + if op != nil: + genDeepCopyProc(m, op, result) + + if optTinyRtti in m.config.globalOptions and t.kind == tyObject and sfImportc notin t.sym.flags: + let v2info = genTypeInfoV2(m, origType, info) + addf(m.s[cfsTypeInit3], "$1->typeInfoV1 = (void*)&$2; $2.typeInfoV2 = (void*)$1;$n", [ + v2info, result]) + + 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 75cd3d35d..c0e574186 100644 --- a/compiler/ccgutils.nim +++ b/compiler/ccgutils.nim @@ -10,47 +10,55 @@ # This module declares some helpers for the C code generator. import - ast, astalgo, ropes, hashes, strutils, types, 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: - for i in 0 ..< n.len: + result = nil + for i in 0..<n.len: result = getPragmaStmt(n[i], w) if result != nil: break of nkPragma: - for i in 0 ..< n.len: + 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 proc hashString*(conf: ConfigRef; s: string): BiggestInt = - # has to be the same algorithm as system.hashString! + # has to be the same algorithm as strmantle.hashString! if CPU[conf.target.targetCPU].bit == 64: # we have to use the same bitwidth # as the target CPU - var b = 0'i64 - for i in countup(0, len(s) - 1): - b = b +% ord(s[i]) - b = b +% `shl`(b, 10) - b = b xor `shr`(b, 6) - b = b +% `shl`(b, 3) - b = b xor `shr`(b, 11) - b = b +% `shl`(b, 15) - result = b + var b = 0'u64 + for i in 0..<s.len: + b = b + uint(s[i]) + b = b + (b shl 10) + b = b xor (b shr 6) + b = b + (b shl 3) + b = b xor (b shr 11) + b = b + (b shl 15) + result = cast[Hash](b) else: - var a = 0'i32 - for i in countup(0, len(s) - 1): - a = a +% ord(s[i]).int32 - a = a +% `shl`(a, 10'i32) - a = a xor `shr`(a, 6'i32) - a = a +% `shl`(a, 3'i32) - a = a xor `shr`(a, 11'i32) - a = a +% `shl`(a, 15'i32) - result = a + var a = 0'u32 + for i in 0..<s.len: + a = a + uint32(s[i]) + a = a + (a shl 10) + a = a xor (a shr 6) + a = a + (a shl 3) + a = a xor (a shr 11) + a = a + (a shl 15) + result = cast[Hash](uint(a)) template getUniqueType*(key: PType): PType = key @@ -60,48 +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-1): - let c = name[i] - case c - of 'a'..'z', '0'..'9', 'A'..'Z': - add(result, 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: - add(result, 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 "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: - add(result, "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 cd344f096..091f5c842 100644 --- a/compiler/cgen.nim +++ b/compiler/cgen.nim @@ -10,18 +10,34 @@ ## This module implements the C code generator. import - ast, astalgo, hashes, trees, platform, magicsys, extccomp, options, intsets, - nversion, nimsets, msgs, std / sha1, bitsets, idents, types, - ccgutils, os, ropes, math, passes, wordrecg, treetab, cgmeth, - condsyms, rodutils, renderer, idgen, cgendata, ccgmerge, semfold, aliases, - lowerings, semparallel, tables, sets, ndi, lineinfos + ast, astalgo, trees, platform, magicsys, extccomp, options, + nversion, nimsets, msgs, bitsets, idents, types, + ccgutils, ropes, wordrecg, treetab, cgmeth, + rodutils, renderer, cgendata, aliases, + lowerings, ndi, lineinfos, pathutils, transf, + injectdestructors, astmsgs, modulepaths, pushpoppragmas, + mangleutils -import strutils except `%` # collides with ropes.`%` +from expanddefaults import caseObjDefaultBranch -from modulegraphs import ModuleGraph -from lineinfos import - warnGcMem, errXMustBeCompileTime, hintDependency, errGenerated, errCannotOpenFile -import dynlib +import pipelineutils + +when defined(nimPreviewSlimSystem): + import std/assertions + +when not defined(leanCompiler): + import spawn, semparallel + +import std/strutils except `%`, addf # collides with ropes.`%` + +from ic / ic import ModuleBackendFlag +import std/[dynlib, math, tables, sets, os, intsets, hashes] + +const + # we use some ASCII control characters to insert directives that will be converted to real code in a postprocessing pass + postprocessDirStart = '\1' + postprocessDirSep = '\31' + postprocessDirEnd = '\23' when not declared(dynlib.libCandidates): proc libCandidates(s: string, dest: var seq[string]) = @@ -34,35 +50,44 @@ when not declared(dynlib.libCandidates): for middle in split(substr(s, le + 1, ri - 1), '|'): libCandidates(prefix & middle & suffix, dest) else: - add(dest, s) + dest.add(s) when options.hasTinyCBackend: import tccgen -# implementation +proc hcrOn(m: BModule): bool = m.config.hcrOn +proc hcrOn(p: BProc): bool = p.module.config.hcrOn proc addForwardedProc(m: BModule, prc: PSym) = - m.forwardedProcs.add(prc) - inc(m.g.forwardedProcsCounter) + m.g.forwardedProcs.add(prc) proc findPendingModule(m: BModule, s: PSym): BModule = - var ms = getModule(s) - result = m.g.modules[ms.position] + # 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: @@ -80,121 +105,195 @@ proc isSimpleConst(typ: PType): bool = {tyTuple, tyObject, tyArray, tySet, tySequence} and not (t.kind == tyProc and t.callConv == ccClosure) -proc useStringh(m: BModule) = - if includesStringh notin m.flags: - incl m.flags, includesStringh - m.includeHeader("<string.h>") - proc useHeader(m: BModule, sym: PSym) = if lfHeader in sym.loc.flags: assert(sym.annex != nil) 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 + +proc getModuleDllPath(m: BModule): Rope = + let (dir, name, ext) = splitFile(getCFile(m)) + let filename = strutils.`%`(platform.OS[m.g.config.target.targetOS].dllFrmt, [name & ext]) + result = makeCString(dir.string & "/" & filename) + +proc getModuleDllPath(m: BModule, module: int): Rope = + result = getModuleDllPath(m.g.modules[module]) + +proc getModuleDllPath(m: BModule, s: PSym): Rope = + result = getModuleDllPath(m.g.modules[s.itemId.module]) + +import std/macros + +proc cgFormatValue(result: var string; value: string) = + result.add value + +proc cgFormatValue(result: var string; value: BiggestInt) = + result.addInt value -proc ropecg(m: BModule, frmt: FormatStr, args: varargs[Rope]): Rope = - assert m != nil +proc cgFormatValue(result: var string; value: Int128) = + result.addInt128 value + +# TODO: please document +macro ropecg(m: BModule, frmt: static[FormatStr], args: untyped): Rope = + args.expectKind nnkBracket + # echo "ropecg ", newLit(frmt).repr, ", ", args.repr var i = 0 - var length = len(frmt) - result = nil + result = nnkStmtListExpr.newTree() + + result.add quote do: + assert `m` != nil + + let resVar = genSym(nskVar, "res") + # during `koch boot` the median of all generates strings from this + # macro is around 40 bytes in length. + result.add newVarStmt(resVar, newCall(bindSym"newStringOfCap", newLit(80))) + let formatValue = bindSym"cgFormatValue" + var num = 0 - while i < length: + var strLit = "" + + template flushStrLit() = + if strLit != "": + result.add newCall(ident "add", resVar, newLit(strLit)) + strLit.setLen 0 + + while i < frmt.len: if frmt[i] == '$': inc(i) # skip '$' case frmt[i] of '$': - add(result, "$") + strLit.add '$' inc(i) of '#': + flushStrLit() inc(i) - add(result, args[num]) + 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: j = (j * 10) + ord(frmt[i]) - ord('0') inc(i) - if i >= length or not (frmt[i] in {'0'..'9'}): break + if i >= frmt.len or not (frmt[i] in {'0'..'9'}): break num = j - if j > high(args) + 1: - internalError(m.config, "ropes: invalid format string $" & $j) - add(result, args[j-1]) + if j > args.len: + error("ropes: invalid format string " & newLit(frmt).repr & " args.len: " & $args.len) + + flushStrLit() + result.add newCall(formatValue, resVar, args[j-1]) of 'n': - if optLineDir notin m.config.options: add(result, "\L") + flushStrLit() + result.add quote do: + if optLineDir notin `m`.config.options: + `resVar`.add("\L") inc(i) of 'N': - add(result, "\L") + strLit.add "\L" inc(i) - else: internalError(m.config, "ropes: invalid format string $" & frmt[i]) + else: + error("ropes: invalid format string $" & frmt[i]) elif frmt[i] == '#' and frmt[i+1] in IdentStartChars: inc(i) var j = i while frmt[j] in IdentChars: inc(j) - var ident = substr(frmt, i, j-1) + var ident = newLit(substr(frmt, i, j-1)) i = j - add(result, cgsym(m, ident)) + flushStrLit() + result.add newCall(formatValue, resVar, newCall(ident"cgsymValue", m, ident)) elif frmt[i] == '#' and frmt[i+1] == '$': inc(i, 2) var j = 0 while frmt[i] in Digits: j = (j * 10) + ord(frmt[i]) - ord('0') inc(i) - add(result, cgsym(m, $args[j-1])) - var start = i - while i < length: - if frmt[i] != '$' and frmt[i] != '#': inc(i) - else: break - if i - 1 >= start: - add(result, substr(frmt, start, i - 1)) + let ident = args[j-1] + flushStrLit() + 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) -proc indentLine(p: BProc, r: Rope): Rope = - result = r - for i in countup(0, p.blocks.len-1): - prepend(result, "\t".rope) + flushStrLit() + result.add newCall(ident"rope", resVar) -proc appcg(m: BModule, c: var Rope, frmt: FormatStr, - args: varargs[Rope]) = - add(c, ropecg(m, frmt, args)) +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 -proc appcg(m: BModule, s: TCFileSection, frmt: FormatStr, - args: varargs[Rope]) = - add(m.s[s], ropecg(m, frmt, args)) +template appcg(m: BModule, c: var Rope, frmt: FormatStr, + args: untyped) = + c.add(ropecg(m, frmt, args)) -proc appcg(p: BProc, s: TCProcSection, frmt: FormatStr, - args: varargs[Rope]) = - add(p.s(s), ropecg(p.module, frmt, args)) +template appcg(m: BModule, sec: TCFileSection, frmt: FormatStr, + args: untyped) = + m.s[sec].add(ropecg(m, frmt, args)) -proc line(p: BProc, s: TCProcSection, r: Rope) = - add(p.s(s), indentLine(p, r)) +template appcg(p: BProc, sec: TCProcSection, frmt: FormatStr, + args: untyped) = + p.s(sec).add(ropecg(p.module, frmt, args)) -proc line(p: BProc, s: TCProcSection, r: string) = - add(p.s(s), indentLine(p, r.rope)) +template line(p: BProc, sec: TCProcSection, r: string) = + addIndent p, p.s(sec) + p.s(sec).add(r) -proc lineF(p: BProc, s: TCProcSection, frmt: FormatStr, - args: openarray[Rope]) = - add(p.s(s), indentLine(p, frmt % args)) +template lineF(p: BProc, sec: TCProcSection, frmt: FormatStr, + args: untyped) = + addIndent p, p.s(sec) + p.s(sec).add(frmt % args) -proc lineCg(p: BProc, s: TCProcSection, frmt: FormatStr, - args: varargs[Rope]) = - add(p.s(s), indentLine(p, ropecg(p.module, frmt, args))) +template lineCg(p: BProc, sec: TCProcSection, frmt: FormatStr, + args: untyped) = + addIndent p, p.s(sec) + p.s(sec).add(ropecg(p.module, frmt, args)) -proc linefmt(p: BProc, s: TCProcSection, frmt: FormatStr, - args: varargs[Rope]) = - add(p.s(s), indentLine(p, ropecg(p.module, frmt, args))) +template linefmt(p: BProc, sec: TCProcSection, frmt: FormatStr, + args: untyped) = + 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: - addf(r, "$N#line $2 $1$N", - [rope(makeSingleLineCString(filename)), rope(line)]) + if optLineDir in conf.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, 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 @@ -202,53 +301,107 @@ 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: - add(p.s(cpsStmts), ~"//" & sourceLine(p.config, t.info) & "\L") - genCLineDir(p.s(cpsStmts), toFullPath(p.config, t.info), line, p.config) - if ({optStackTrace, optEndb} * p.options == {optStackTrace, optEndb}) and - (p.prc == nil or sfPure notin p.prc.flags): - if freshLineInfo(p, t.info): - linefmt(p, cpsStmts, "#endb($1, $2);$N", - line.rope, makeCString(toFilename(p.config, t.info))) - elif ({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.rope, quotedFilename(p.config, t.info)) - -proc postStmtActions(p: BProc) {.inline.} = - add(p.s(cpsStmts), p.module.injectStmt) + 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 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; result: var Rope) template compileToCpp(m: BModule): untyped = - m.config.cmd == cmdCompileToCpp or sfCompileToCpp in m.module.flags + m.config.backend == backendCpp or sfCompileToCpp in m.module.flags proc getTempName(m: BModule): Rope = result = m.tmpBase & rope(m.labels) inc m.labels +proc rdLoc(a: TLoc): Rope = + # 'read' location (deref if indirect) + if lfIndirect in a.flags: + result = "(*" & a.snippet & ")" + else: + result = a.snippet + +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 = + if optSeqDestructors in p.config.globalOptions: + result = rdLoc(a) & ".len" + 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 # ------------------------------ Manager of temporaries ------------------ -proc rdLoc(a: TLoc): Rope = - # 'read' location (deref if indirect) - result = a.r - if lfIndirect in a.flags: result = "(*$1)" % [result] +template mapTypeChooser(n: PNode): TSymKind = + (if n.kind == nkSym: n.sym.kind else: skVar) + +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) != 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 = + if lfIndirect notin a.flags and mapType(p.config, a.t, mapTypeChooser(a) == skParam) != ctArray and not + p.module.compileToCpp: + result = "(&" & a.snippet & ")" + else: + result = a.snippet proc rdCharLoc(a: TLoc): Rope = # read a location that may need a char-cast: @@ -256,87 +409,146 @@ proc rdCharLoc(a: TLoc): Rope = if skipTypes(a.t, abstractRange).kind == tyChar: result = "((NU8)($1))" % [result] -proc genObjectInit(p: BProc, section: TCProcSection, t: PType, a: TLoc, - takeAddr: bool) = - if p.module.compileToCpp and t.isException and not isDefined(p.config, "noCppExceptions"): - # init vtable in Exception object for polymorphic exceptions - includeHeader(p.module, "<new>") - linefmt(p, section, "new ($1) $2;$n", rdLoc(a), getTypeDesc(p.module, t)) +type + TAssignmentFlag = enum + needToCopy + needToCopySinkParam + needTempForOpenArray + needAssignCall + TAssignmentFlags = set[TAssignmentFlag] + +proc genObjConstr(p: BProc, e: PNode, d: var TLoc) +proc rawConstExpr(p: BProc, n: PNode; d: var TLoc) +proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) + +type + ObjConstrMode = enum + constructObj, + constructRefObj +proc genObjectInit(p: BProc, section: TCProcSection, t: PType, a: var TLoc, + mode: ObjConstrMode) = + #if optNimV2 in p.config.globalOptions: return case analyseObjectWithTypeField(t) of frNone: discard of frHeader: var r = rdLoc(a) - if not takeAddr: r = "(*$1)" % [r] + if mode == constructRefObj: r = "(*$1)" % [r] var s = skipTypes(t, abstractInst) if not p.module.compileToCpp: - while (s.kind == tyObject) and (s.sons[0] != nil): - add(r, ".Sup") - s = skipTypes(s.sons[0], skipPtrs) - linefmt(p, section, "$1.m_type = $2;$n", r, genTypeInfo(p.module, t, a.lode.info)) + while s.kind == tyObject and s[0] != nil: + r.add(".Sup") + s = skipTypes(s[0], skipPtrs) + if optTinyRtti in p.config.globalOptions: + linefmt(p, section, "$1.m_type = $2;$n", [r, genTypeInfoV2(p.module, t, a.lode.info)]) + else: + linefmt(p, section, "$1.m_type = $2;$n", [r, genTypeInfoV1(p.module, t, a.lode.info)]) of frEmbedded: - # worst case for performance: - var r = if takeAddr: addrLoc(p.config, a) else: rdLoc(a) - linefmt(p, section, "#objectInit($1, $2);$n", r, genTypeInfo(p.module, t, a.lode.info)) + if optTinyRtti in p.config.globalOptions: + 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, descKindFromSymKind mapTypeChooser(a))]) + else: + rawConstExpr(p, newNodeIT(nkType, a.lode.info, t), tmp) + genAssignment(p, a, tmp, {}) + else: + # worst case for performance: + var r = if mode == constructObj: addrLoc(p.config, a) else: rdLoc(a) + linefmt(p, section, "#objectInit($1, $2);$n", [r, genTypeInfoV1(p.module, t, a.lode.info)]) -type - TAssignmentFlag = enum - needToCopy, afDestIsNil, afDestIsNotNil, afSrcIsNil, afSrcIsNotNil - TAssignmentFlags = set[TAssignmentFlag] + if isException(t): + var r = rdLoc(a) + if mode == constructRefObj: r = "(*$1)" % [r] + var s = skipTypes(t, abstractInst) + if not p.module.compileToCpp: + while s.kind == tyObject and s[0] != nil and s.sym.magic != mException: + r.add(".Sup") + s = skipTypes(s[0], skipPtrs) + linefmt(p, section, "$1.name = $2;$n", [r, makeCString(t.skipTypes(abstractInst).sym.name.s)]) -proc genRefAssign(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) +proc genRefAssign(p: BProc, dest, src: TLoc) proc isComplexValueType(t: PType): bool {.inline.} = - let t = t.skipTypes(abstractInst) - result = t.kind in {tyArray, tySet, tyTuple, tyObject} or + let t = t.skipTypes(abstractInst + tyUserTypeClasses) + result = t.kind in {tyArray, tySet, tyTuple, tyObject, tyOpenArray} or (t.kind == tyProc and t.callConv == ccClosure) +include ccgreset + proc resetLoc(p: BProc, loc: var TLoc) = - let containsGcRef = containsGarbageCollectedRef(loc.t) + let containsGcRef = optSeqDestructors notin p.config.globalOptions and containsGarbageCollectedRef(loc.t) let typ = skipTypes(loc.t, abstractVarRange) - if isImportedCppType(typ): return - if not isComplexValueType(typ): + if isImportedCppType(typ): + var didGenTemp = false + linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(loc), genCppInitializer(p.module, p, typ, didGenTemp)]) + return + if optSeqDestructors in p.config.globalOptions and typ.kind in {tyString, tySequence}: + assert loc.snippet != "" + + let atyp = skipTypes(loc.t, abstractInst) + if atyp.kind in {tyVar, tyLent}: + linefmt(p, cpsStmts, "$1->len = 0; $1->p = NIM_NIL;$n", [rdLoc(loc)]) + else: + 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") - genRefAssign(p, loc, nilLoc, {afSrcIsNil}) + 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)) + linefmt(p, cpsStmts, "$1 = 0;$n", [rdLoc(loc)]) else: - if optNilCheck in p.options: - linefmt(p, cpsStmts, "#chckNil((void*)$1);$n", addrLoc(p.config, loc)) - if loc.storage != OnStack: - linefmt(p, cpsStmts, "#genericReset((void*)$1, $2);$n", - addrLoc(p.config, loc), genTypeInfo(p.module, loc.t, loc.lode.info)) + if loc.storage != OnStack and containsGcRef: + specializeReset(p, loc) + when false: + linefmt(p, cpsStmts, "#genericReset((void*)$1, $2);$n", + [addrLoc(p.config, loc), genTypeInfoV1(p.module, loc.t, loc.lode.info)]) # XXX: generated reset procs should not touch the m_type # field, so disabling this should be safe: - genObjectInit(p, cpsStmts, loc.t, loc, true) + genObjectInit(p, cpsStmts, loc.t, loc, constructObj) else: - useStringh(p.module) # array passed as argument decayed into pointer, bug #7332 # so we use getTypeDesc here rather than rdLoc(loc) - linefmt(p, cpsStmts, "memset((void*)$1, 0, sizeof($2));$n", - addrLoc(p.config, loc), getTypeDesc(p.module, loc.t)) + 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, true) + genObjectInit(p, cpsStmts, loc.t, loc, constructObj) -proc constructLoc(p: BProc, loc: TLoc, isTemp = false) = +proc constructLoc(p: BProc, loc: var TLoc, isTemp = false) = let typ = loc.t - if not isComplexValueType(typ): - linefmt(p, cpsStmts, "$1 = ($2)0;$n", rdLoc(loc), - getTypeDesc(p.module, typ)) + 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): + 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): - # don't use memset for temporary values for performance if we can + 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): - useStringh(p.module) - linefmt(p, cpsStmts, "memset((void*)$1, 0, sizeof($2));$n", - addrLoc(p.config, loc), getTypeDesc(p.module, typ)) - genObjectInit(p, cpsStmts, loc.t, loc, true) + if not isOrHasImportedCppType(typ): + linefmt(p, cpsStmts, "#nimZeroMem((void*)$1, sizeof($2));$n", + [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) = if sfNoInit notin v.flags: @@ -350,178 +562,253 @@ 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), 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. + if getSize(p.config, t) > 1024 * 1024: + if p.prc != nil: + echo "ENORMOUS TEMPORARY! ", p.config $ p.prc.info + else: + echo "ENORMOUS TEMPORARY! ", p.config $ p.lastLineInfo + writeStackTrace() + +proc getTempCpp(p: BProc, t: PType, value: Rope): TLoc = + inc(p.labels) + 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, result: var TLoc) = +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 = {} - -proc initGCFrame(p: BProc): Rope = - if p.gcFrameId > 0: result = "struct {$1} GCFRAME_;$n" % [p.gcFrameType] - -proc deinitGCFrame(p: BProc): Rope = - if p.gcFrameId > 0: - result = ropecg(p.module, - "if (((NU)&GCFRAME_) < 4096) #nimGCFrame(&GCFRAME_);$n") - -proc localDebugInfo(p: BProc, s: PSym) = - if {optStackTrace, optEndb} * p.options != {optStackTrace, optEndb}: return - # XXX work around a bug: No type information for open arrays possible: - if skipTypes(s.typ, abstractVar).kind in {tyOpenArray, tyVarargs}: return - var a = "&" & s.loc.r - if s.kind == skParam and ccgIntroducedPtr(p.config, s): a = s.loc.r - lineF(p, cpsInit, - "FR_.s[$1].address = (void*)$3; FR_.s[$1].typ = $4; FR_.s[$1].name = $2;$n", - [p.maxFrameLen.rope, makeCString(normalize(s.name.s)), a, - genTypeInfo(p.module, s.loc.t, s.info)]) - inc(p.maxFrameLen) - inc p.blocks[p.blocks.len-1].frameLen + 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) - result = getTypeDesc(p.module, s.typ) - if s.constraint.isNil: - if sfRegister in s.flags: add(result, " register") + if s.kind in {skLet, skVar, skField, skForVar} and s.alignment > 0: + result.addf("NIM_ALIGN($1) ", [rope(s.alignment)]) + + 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: - # add(decl, " GC_GUARD") - if sfVolatile in s.flags: add(result, " volatile") - add(result, " ") - add(result, s.loc.r) + # 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.snippet) else: - result = 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) - localDebugInfo(p, n.sym) include ccgthreadvars proc varInDynamicLib(m: BModule, sym: PSym) -proc mangleDynLibProc(sym: PSym): Rope -proc assignGlobalVar(p: BProc, n: PNode) = +proc treatGlobalDifferentlyForHCR(m: BModule, s: PSym): bool = + return m.hcrOn and {sfThread, sfGlobal} * s.flags == {sfGlobal} and + ({lfNoDecl, lfHeader} * s.loc.flags == {}) + # 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: var q = findPendingModule(p.module, s) if q != nil and not containsOrIncl(q.declaredThings, s.id): varInDynamicLib(q, s) else: - s.loc.r = mangleDynLibProc(s) + s.loc.snippet = mangleDynLibProc(s) + if value != "": + internalError(p.config, n.info, ".dynlib variables cannot have a value") return useHeader(p.module, s) if lfNoDecl in s.loc.flags: return - if sfThread in s.flags: - declareThreadVar(p.module, s, sfImportc in s.flags) - else: - var decl: Rope = nil - var td = getTypeDesc(p.module, s.loc.t) - if s.constraint.isNil: - if sfImportc in s.flags: add(decl, "extern ") - add(decl, td) - if sfRegister in s.flags: add(decl, " register") - if sfVolatile in s.flags: add(decl, " volatile") - addf(decl, " $1;$n", [s.loc.r]) + if not containsOrIncl(p.module.declaredThings, s.id): + if sfThread in s.flags: + declareThreadVar(p.module, s, sfImportc in s.flags) + if value != "": + internalError(p.config, n.info, ".threadvar variables cannot have a value") else: - decl = (s.cgDeclFrmt & ";$n") % [td, s.loc.r] - add(p.module.s[cfsVars], decl) - if p.withinLoop > 0: + var decl: Rope = "" + let td = getTypeDesc(p.module, s.loc.t, dkVar) + genGlobalVarDecl(p, n, td, value, decl) + if s.constraint.isNil: + 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.snippet]) + + p.module.s[cfsVars].add(decl) + if p.withinLoop > 0 and value == "": # fixes tests/run/tzeroarray: resetLoc(p, s.loc) - if p.module.module.options * {optStackTrace, optEndb} == - {optStackTrace, optEndb}: - appcg(p.module, p.module.s[cfsDebugInit], - "#dbgRegisterGlobal($1, &$2, $3);$n", - [makeCString(normalize(s.owner.name.s & '.' & s.name.s)), - s.loc.r, genTypeInfo(p.module, s.typ, n.info)]) - -proc assignParam(p: BProc, s: PSym) = - assert(s.loc.r != nil) + +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.snippet != "") scopeMangledParam(p, s) - localDebugInfo(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 genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) -proc intLiteral(i: BiggestInt): Rope -proc genLiteral(p: BProc, n: PNode): Rope -proc genOtherArg(p: BProc; ri: PNode; i: int; typ: PType): Rope -proc initLocExpr(p: BProc, e: PNode, result: var TLoc) = - initLoc(result, locNone, e, OnUnknown) +proc putLocIntoDest(p: BProc, d: var TLoc, s: TLoc) +proc intLiteral(i: BiggestInt; result: var Rope) +proc genLiteral(p: BProc, n: PNode; result: var Rope) +proc genOtherArg(p: BProc; ri: PNode; i: int; typ: PType; result: var Rope; argsCounter: var int) +proc raiseExit(p: BProc) +proc raiseExitCleanup(p: BProc, destroy: string) + +proc initLocExpr(p: BProc, e: PNode, flags: TLocFlags = {}): TLoc = + result = initLoc(locNone, e, OnUnknown, flags) expr(p, e, result) -proc initLocExprSingleUse(p: BProc, e: PNode, result: var TLoc) = - initLoc(result, locNone, e, OnUnknown) - result.flags.incl lfSingleUse +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" + # We may need to consider that 'f(g())' cannot be rewritten to 'tmp = g(); f(tmp)' + # if 'tmp' lacks a move/assignment operator. + if e[0].kind == nkSym and sfCompileToCpp in e[0].sym.flags: + result.flags.incl lfSingleUse + else: + result.flags.incl lfSingleUse expr(p, e, result) -proc lenField(p: BProc): Rope = - result = rope(if p.module.compileToCpp: "len" else: "Sup.len") - include ccgcalls, "ccgstmts.nim" proc initFrame(p: BProc, procname, filename: Rope): Rope = - discard cgsym(p.module, "nimFrame") - if p.maxFrameLen > 0: - discard cgsym(p.module, "VarSlot") - result = ropecg(p.module, "\tnimfrs_($1, $2, $3, $4);$n", - procname, filename, p.maxFrameLen.rope, - p.blocks[0].frameLen.rope) - else: - result = ropecg(p.module, "\tnimfr_($1, $2);$n", procname, filename) + const frameDefines = """ +$1define nimfr_(proc, file) \ + TFrame FR_; \ + FR_.procname = proc; FR_.filename = file; FR_.line = 0; FR_.len = 0; #nimFrame(&FR_); + +$1define nimln_(n) \ + FR_.line = n; + +$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, ["#"]) + + 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") - addf(p.blocks[0].sections[cpsLocals], "TFrame $1;$n", [frame]) + 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", - frame, procname, filename, rope(line)) + [frame, procname, filename, line]) proc deinitFrameNoDebug(p: BProc; frame: Rope): Rope = - result = ropecg(p.module, "\t#popFrameOfAddr(&$1);$n", frame) + result = ropecg(p.module, "\t#popFrameOfAddr(&$1);$n", [frame]) proc deinitFrame(p: BProc): Rope = - result = ropecg(p.module, "\t#popFrame();$n") + result = ropecg(p.module, "\t#popFrame();$n", []) include ccgexprs @@ -538,141 +825,166 @@ 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 - addf(m.s[cfsVars], "static void* $1;$n", [tmp]) + 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 - for i in countup(0, high(s)): + var loadlib: Rope = "" + for i in 0..high(s): inc(m.labels) - if i > 0: add(loadlib, "||") + 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 = p.options - {optStackTrace, optEndb} - var dest: TLoc - initLocExpr(p, lib.path, dest) - add(m.s[cfsVars], p.s(cpsLocals)) - add(m.s[cfsDynLibInit], p.s(cpsInit)) - add(m.s[cfsDynLibInit], p.s(cpsStmts)) + p.options.excl optStackTrace + p.flags.incl nimErrorFlagDisabled + 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, dkVar), rdLoc(dest)]) + expr(p, lib.path, dest) + + m.s[cfsVars].add(p.s(cpsLocals)) + m.s[cfsDynLibInit].add(p.s(cpsInit)) + m.s[cfsDynLibInit].add(p.s(cpsStmts)) appcg(m, m.s[cfsDynLibInit], "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 = "Dl_$1_" % [rope(sym.id)] + result = rope(strutils.`%`("Dl_$1_", $sym.id)) 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-2: - initLocExpr(m.initProc, n[i], a) + for i in 1..<n.len-1: + 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), params, makeCString($extname)] + [tmp, getTypeDesc(m, sym.typ, dkVar), params, makeCString($extname)] var last = lastSon(n) - if last.kind == nkHiddenStdConv: last = last.sons[1] + if last.kind == nkHiddenStdConv: last = last[1] internalAssert(m.config, last.kind == nkStrLit) let idx = last.strVal if idx.len == 0: - add(m.initProc.s(cpsStmts), load) + m.initProc.s(cpsStmts).add(load) elif idx.len == 1 and idx[0] in {'0'..'9'}: - add(m.extensionLoaders[idx[0]], load) + m.extensionLoaders[idx[0]].add(load) else: internalError(m.config, sym.info, "wrong index: " & idx) else: appcg(m, m.s[cfsDynLibInit], "\t$1 = ($2) #nimGetProcAddr($3, $4);$n", - [tmp, getTypeDesc(m, sym.typ), lib.name, makeCString($extname)]) - addf(m.s[cfsVars], "$2 $1;$n", [sym.loc.r, getTypeDesc(m, sym.loc.t)]) + [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), lib.name, makeCString($extname)]) - addf(m.s[cfsVars], "$2* $1;$n", - [sym.loc.r, getTypeDesc(m, sym.loc.t)]) + [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 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) = - add(m.s[cfsHeaders], "\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] == '#': - add(m.s[cfsHeaders], rope(it.replace('`', '"') & "\L")) - elif it[0] notin {'\"', '<'}: - addf(m.s[cfsHeaders], "#include \"$1\"$N", [rope(it)]) + m.s[cfsHeaders].add(rope(it.replace('`', '"') & "\L")) + elif it[0] notin {'"', '<'}: + m.s[cfsHeaders].addf("#include \"$1\"$N", [rope(it)]) else: - addf(m.s[cfsHeaders], "#include $1$N", [rope(it)]) - add(m.s[cfsHeaders], "#undef LANGUAGE_C\L") - add(m.s[cfsHeaders], "#undef MIPSEB\L") - add(m.s[cfsHeaders], "#undef MIPSEL\L") - add(m.s[cfsHeaders], "#undef PPC\L") - add(m.s[cfsHeaders], "#undef R3000\L") - add(m.s[cfsHeaders], "#undef R4000\L") - add(m.s[cfsHeaders], "#undef i386\L") - add(m.s[cfsHeaders], "#undef linux\L") - add(m.s[cfsHeaders], "#undef mips\L") - add(m.s[cfsHeaders], "#undef near\L") - add(m.s[cfsHeaders], "#undef powerpc\L") - add(m.s[cfsHeaders], "#undef unix\L") - -proc openNamespaceNim(): Rope = - result.add("namespace Nim {\L") - -proc closeNamespaceNim(): Rope = + m.s[cfsHeaders].addf("#include $1$N", [rope(it)]) + m.s[cfsHeaders].add("""#undef LANGUAGE_C +#undef MIPSEB +#undef MIPSEL +#undef PPC +#undef R3000 +#undef R4000 +#undef i386 +#undef linux +#undef mips +#undef near +#undef far +#undef powerpc +#undef unix +""") + +proc openNamespaceNim(namespace: string; result: var Rope) = + result.add("namespace ") + result.add(namespace) + result.add(" {\L") + +proc closeNamespaceNim(result: var Rope) = result.add("}\L") proc closureSetup(p: BProc, prc: PSym) = @@ -685,25 +997,41 @@ proc closureSetup(p: BProc, prc: PSym) = #echo "created environment: ", env.id, " for ", prc.name.s assignLocalVar(p, ls) # generate cast assignment: - linefmt(p, cpsStmts, "$1 = ($2) ClE_0;$n", - rdLoc(env.loc), getTypeDesc(p.module, env.typ)) + if p.config.selectedGC == gcGo: + linefmt(p, cpsStmts, "#unsureAsgnRef((void**) $1, ($2) ClE_0);$n", + [addrLoc(p.config, env.loc), getTypeDesc(p.module, env.typ)]) + else: + 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 proc easyResultAsgn(n: PNode): PNode = - const harmless = {nkConstSection, nkTypeSection, nkEmpty, nkCommentStmt} + - declarativeDefs + 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] @@ -713,143 +1041,354 @@ proc easyResultAsgn(n: PNode): PNode = if result != nil: incl n.flags, nfPreventCg else: discard -proc genProcAux(m: BModule, prc: PSym) = +type + InitResultEnum = enum Unknown, InitSkippable, InitRequired + +proc allPathsAsgnResult(p: BProc; n: PNode): InitResultEnum = + # Exceptions coming from calls don't have not be considered here: + # + # proc bar(): string = raise newException(...) + # + # proc foo(): string = + # # optimized out: 'reset(result)' + # result = bar() + # + # try: + # a = foo() + # except: + # echo "a was not written to" + # + template allPathsInBranch(it) = + let a = allPathsAsgnResult(p, it) + case a + of InitRequired: return InitRequired + of InitSkippable: discard + of Unknown: + # sticky, but can be overwritten by InitRequired: + result = Unknown + + result = Unknown + case n.kind + of nkStmtList, nkStmtListExpr: + for it in n: + result = allPathsAsgnResult(p, it) + if result != Unknown: return result + of nkAsgn, nkFastAsgn, nkSinkAsgn: + if n[0].kind == nkSym and n[0].sym.kind == skResult: + if not containsResult(n[1]): + 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: + # This is a bare `return` statement, if `result` was not initialized + # anywhere else (or if we're not sure about this) let's require it to be + # initialized. This avoids cases like #9286 where this heuristic lead to + # wrong code being generated. + result = InitRequired + else: result = allPathsAsgnResult(p, n[0]) + of nkIfStmt, nkIfExpr: + var exhaustive = false + result = InitSkippable + for it in n: + # Every condition must not use 'result': + if it.len == 2 and containsResult(it[0]): + return InitRequired + if it.len == 1: exhaustive = true + allPathsInBranch(it.lastSon) + # if the 'if' statement is not exhaustive and yet it touched 'result' + # in some way, say Unknown. + if not exhaustive: result = Unknown + of nkCaseStmt: + if containsResult(n[0]): return InitRequired + result = InitSkippable + var exhaustive = skipTypes(n[0].typ, + abstractVarRange-{tyTypeDesc}).kind notin {tyFloat..tyFloat128, tyString, tyCstring} + for i in 1..<n.len: + let it = n[i] + allPathsInBranch(it.lastSon) + if it.kind == nkElse: exhaustive = true + if not exhaustive: result = Unknown + of nkWhileStmt: + # some dubious code can assign the result in the 'while' + # condition and that would be fine. Everything else isn't: + result = allPathsAsgnResult(p, n[0]) + if result == Unknown: + 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: + result = Unknown + of nkGotoState, nkBreakState: + # give up for now. + result = InitRequired + of nkSym: + # some path reads from 'result' before it was written to! + if n.sym.kind == skResult: result = InitRequired + of nkTryStmt, nkHiddenTryStmt: + # We need to watch out for the following problem: + # try: + # result = stuffThatRaises() + # except: + # discard "result was not set" + # + # So ... even if the assignment to 'result' is the very first + # assignment this is not good enough! The only pattern we allow for + # is 'finally: result = x' + result = InitSkippable + allPathsInBranch(n[0]) + for i in 1..<n.len: + if n[i].kind == nkFinally: + 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]) + +proc getProcTypeCast(m: BModule, prc: PSym): Rope = + result = getTypeDesc(m, prc.loc.t) + if prc.typ.callConv == ccClosure: + 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, 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", [])) + +proc isNoReturn(m: BModule; s: PSym): bool {.inline.} = + sfNoReturn in s.flags and m.config.exc != excGoto + +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) - if sfPure notin prc.flags and prc.typ.sons[0] != nil: + + var procBody = transformBody(m.g.graph, m.idgen, prc, {}) + if sfInjectDestructors in prc.flags: + procBody = injectDestructorCalls(m.g.graph, m.idgen, prc, procBody) + + 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.sons[resultPos] + let resNode = prc.ast[resultPos] let res = resNode.sym # get result symbol - if not isInvalidReturnType(m.config, prc.typ.sons[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(prc.getBody); val != nil): + 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) - linefmt(p, cpsStmts, "$1 = $2;$n", decl, rdLoc(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) - returnStmt = ropecg(p.module, "\treturn $1;$n", rdLoc(res.loc)) + 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) - if sfNoInit notin prc.flags: resetLoc(p, res.loc) + 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 + # the 'unsureAsgn' is a nop. If it points to a global variable the + # 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(p, procBody) == InitSkippable: discard + else: + resetLoc(p, res.loc) if skipTypes(res.typ, abstractInst).kind == tyArray: #incl(res.loc.flags, lfIndirect) res.loc.storage = OnUnknown - for i in countup(1, sonsLen(prc.typ.n) - 1): - let param = prc.typ.n.sons[i].sym + for i in 1..<prc.typ.n.len: + let param = prc.typ.n[i].sym if param.typ.isCompileTimeOnly: continue - assignParam(p, param) + assignParam(p, param, prc.typ.returnType) closureSetup(p, prc) - genStmts(p, prc.getBody) # modifies p.locals, p.init, etc. - var generatedProc: Rope - if sfNoReturn in prc.flags: - if hasDeclspec in extccomp.CC[p.config.cCompiler].props: + genProcBody(p, procBody) + + 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 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 = ropecg(p.module, "$N$1 {$n$2$3$4}$N$N", - header, p.s(cpsLocals), p.s(cpsInit), p.s(cpsStmts)) + generatedProc.add ropecg(p.module, "$1 {$n$2$3$4}$N$N", + [header, p.s(cpsLocals), p.s(cpsInit), p.s(cpsStmts)]) else: - generatedProc = ropecg(p.module, "$N$1 {$N", header) - add(generatedProc, initGCFrame(p)) + if m.hcrOn and isReloadable(m, prc): + # Add forward declaration for "_actual"-suffixed functions defined in the same module (or inline). + # This fixes the use of methods and also the case when 2 functions within the same module + # call each other using directly the "_actual" versions (an optimization) - see issue #11608 + m.s[cfsProcHeaders].addf("$1;\n", [header]) + generatedProc.add ropecg(p.module, "$1 {$n", [header]) if optStackTrace in prc.options: - add(generatedProc, p.s(cpsLocals)) + generatedProc.add(p.s(cpsLocals)) var procname = makeCString(prc.name.s) - add(generatedProc, initFrame(p, procname, quotedFilename(p.config, prc.info))) + generatedProc.add(initFrame(p, procname, quotedFilename(p.config, prc.info))) else: - add(generatedProc, p.s(cpsLocals)) + generatedProc.add(p.s(cpsLocals)) if optProfiler in prc.options: # invoke at proc entry for recursion: appcg(p, cpsInit, "\t#nimProfile();$n", []) - if p.beforeRetNeeded: add(generatedProc, "{") - add(generatedProc, p.s(cpsInit)) - add(generatedProc, p.s(cpsStmts)) - if p.beforeRetNeeded: add(generatedProc, ~"\t}BeforeRet_: ;$n") - add(generatedProc, deinitGCFrame(p)) - if optStackTrace in prc.options: add(generatedProc, deinitFrame(p)) - add(generatedProc, returnStmt) - add(generatedProc, ~"}$N") - add(m.s[cfsProcs], generatedProc) + # this pair of {} is required for C++ (C++ is weird with its + # control flow integrity checks): + 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 optStackTrace in prc.options: generatedProc.add(deinitFrame(p)) + generatedProc.add(returnStmt) + 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.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 sfCompileToCpp notin sym.getModule().flags and - m.config.cmd != cmdCompileToCpp) or ( - sym.flags * {sfImportc, sfInfixCall, sfCompilerProc} == {sfImportc} and + m.config.backend != backendCpp) or ( + sym.flags * {sfInfixCall, sfCompilerProc, sfMangleCpp} == {} and + sym.flags * {sfImportc, sfExportc} != {} and sym.magic == mNone and - m.config.cmd == cmdCompileToCpp) + m.config.backend == backendCpp) 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 getModule(sym).id != m.module.id and + if sym.itemId.module != m.module.position and not containsOrIncl(m.declaredThings, sym.id): - add(m.s[cfsVars], ropecg(m, "extern $1 $2;$n", - getTypeDesc(m, sym.loc.t), mangleDynLibProc(sym))) + m.s[cfsVars].add(ropecg(m, "$1 $2 $3;$n", + [(if isReloadable(m, sym): "static" else: "extern"), + getTypeDesc(m, sym.loc.t), mangleDynLibProc(sym)])) + if isReloadable(m, sym): + m.s[cfsDynLibInit].addf("\t$1 = ($2) hcrGetProc($3, \"$1\");$n", + [mangleDynLibProc(sym), getTypeDesc(m, sym.loc.t), getModuleDllPath(m, sym)]) elif not containsOrIncl(m.declaredProtos, sym.id): - var header = genProcHeader(m, sym) - if sfNoReturn in sym.flags and hasDeclspec in extccomp.CC[m.config.cCompiler].props: - header = "__declspec(noreturn) " & header - if sym.typ.callConv != ccInline and requiresExternC(m, sym): - header = "extern \"C\" " & header - if sfPure in sym.flags and hasAttribute in CC[m.config.cCompiler].props: - header.add(" __attribute__((naked))") - if sfNoReturn in sym.flags and hasAttribute in CC[m.config.cCompiler].props: - header.add(" __attribute__((noreturn))") - add(m.s[cfsProcHeaders], ropecg(m, "$1;$n", header)) - + let asPtr = isReloadable(m, sym) + 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 + if sym.typ.callConv != ccInline and requiresExternC(m, sym): + header = "extern \"C\" " & header + if sfPure in sym.flags and hasAttribute in CC[m.config.cCompiler].props: + header.add(" __attribute__((naked))") + if isNoReturn(m, sym) and hasAttribute in CC[m.config.cCompiler].props: + header.add(" __attribute__((noreturn))") + m.s[cfsProcHeaders].add(ropecg(m, "$1;$N", [header])) + +# TODO: figure out how to rename this - it DOES generate a forward declaration proc genProcNoForward(m: BModule, prc: PSym) = if lfImportCompilerProc in prc.loc.flags: 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]) - useHeader(m, prc) 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 # a check for ``m.declaredThings``. if not containsOrIncl(m.declaredThings, prc.id): #if prc.loc.k == locNone: - fillProcLoc(m, prc.ast[namePos]) + # mangle the inline proc based on the module where it is defined - + # not on the first module that uses it + let m2 = if m.config.symbolFiles != disabledSf: m + else: findPendingModule(m, prc) + fillProcLoc(m2, prc.ast[namePos]) #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) - useHeader(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]) - useHeader(m, prc) - genProcPrototype(m, prc) - if q != nil and not containsOrIncl(q.declaredThings, prc.id): - symInDynamicLib(q, prc) - else: - symInDynamicLibPartial(m, prc) elif sfImportc notin prc.flags: var q = findPendingModule(m, prc) fillProcLoc(q, prc.ast[namePos]) - useHeader(m, prc) + # generate a getProc call to initialize the pointer for this + # externally-to-the-current-module defined proc, also important + # to do the declaredProtos check before the call to genProcPrototype + 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.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 + # which will actually become a function pointer + if isReloadable(m, prc): + genProcPrototype(q, prc) genProcAux(q, prc) else: fillProcLoc(m, prc.ast[namePos]) @@ -857,25 +1396,16 @@ proc genProcNoForward(m: BModule, prc: PSym) = if sfInfixCall notin prc.flags: genProcPrototype(m, prc) proc requestConstImpl(p: BProc, sym: PSym) = - var m = p.module - useHeader(m, sym) - if sym.loc.k == locNone: - fillLoc(sym.loc, locData, sym.ast, mangleName(p.module, sym), OnStatic) - if lfNoDecl in sym.loc.flags: return - # declare implementation: - var q = findPendingModule(m, sym) - if q != nil and not containsOrIncl(q.declaredThings, sym.id): - assert q.initProc.module == q - addf(q.s[cfsData], "NIM_CONST $1 $2 = $3;$n", - [getTypeDesc(q, sym.typ), sym.loc.r, genConstExpr(q.initProc, sym.ast)]) - # declare header: - if q != m and not containsOrIncl(m.declaredThings, sym.id): - assert(sym.loc.r != nil) - let headerDecl = "extern NIM_CONST $1 $2;$n" % - [getTypeDesc(m, sym.loc.t), sym.loc.r] - add(m.s[cfsData], headerDecl) - if sfExportc in sym.flags and p.module.g.generatedHeader != nil: - add(p.module.g.generatedHeader.s[cfsData], headerDecl) + if genConstSetup(p, sym): + let m = p.module + # declare implementation: + var q = findPendingModule(m, sym) + if q != nil and not containsOrIncl(q.declaredThings, sym.id): + assert q.initProc.module == q + genConstDefinition(q, p, sym) + # declare header: + if q != m and not containsOrIncl(m.declaredThings, sym.id): + genConstHeader(m, q, p, sym) proc isActivated(prc: PSym): bool = prc.typ != nil @@ -897,103 +1427,176 @@ 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) - if (lfNoDecl in sym.loc.flags) or containsOrIncl(m.declaredThings, sym.id): + 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: - add(m.s[cfsVars], "extern ") - add(m.s[cfsVars], getTypeDesc(m, sym.loc.t)) - if lfDynamicLib in sym.loc.flags: add(m.s[cfsVars], "*") - if sfRegister in sym.flags: add(m.s[cfsVars], " register") - if sfVolatile in sym.flags: add(m.s[cfsVars], " volatile") - addf(m.s[cfsVars], " $1;$n", [sym.loc.r]) - -proc addIntTypes(result: var Rope; conf: ConfigRef) {.inline.} = - addf(result, "#define NIM_NEW_MANGLING_RULES\L" & - "#define NIM_INTBITS $1\L", [ + 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, 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.snippet]) + if m.hcrOn: m.initProc.procSec(cpsLocals).addf( + "\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", [ platform.CPU[conf.target.targetCPU].intSize.rope]) - if optUseNimNamespace in conf.globalOptions: result.add("#define USE_NIM_NAMESPACE\L") + if conf.cppCustomNamespace.len > 0: + result.add("#define USE_NIM_NAMESPACE ") + result.add(conf.cppCustomNamespace) + result.add("\L") + if conf.isDefined("nimEmulateOverflowChecks"): + result.add("#define NIM_EmulateOverflowChecks\L") + +proc headerTop(): Rope = + result = "/* Generated by Nim Compiler v$1 */$N" % [rope(VersionAsString)] proc getCopyright(conf: ConfigRef; cfile: Cfile): Rope = - if optCompileOnly in conf.globalOptions: - result = ("/* Generated by Nim Compiler v$1 */$N" & - "/* (c) " & copyrightYear & " Andreas Rumpf */$N" & - "/* The generated code is subject to the original license. */$N") % - [rope(VersionAsString)] - else: - result = ("/* Generated by Nim Compiler v$1 */$N" & - "/* (c) " & copyrightYear & " Andreas Rumpf */$N" & - "/* The generated code is subject to the original license. */$N" & - "/* Compiled for: $2, $3, $4 */$N" & - "/* Command for C compiler:$n $5 */$N") % - [rope(VersionAsString), - rope(platform.OS[conf.target.targetOS].name), + result = headerTop() + if optCompileOnly notin conf.globalOptions: + result.add ("/* Compiled for: $1, $2, $3 */$N" & + "/* Command for C compiler:$n $4 */$N") % + [rope(platform.OS[conf.target.targetOS].name), rope(platform.CPU[conf.target.targetCPU].name), rope(extccomp.CC[conf.cCompiler].name), rope(getCompileCFileCmd(conf, cfile))] proc getFileHeader(conf: ConfigRef; cfile: Cfile): Rope = result = getCopyright(conf, cfile) - addIntTypes(result, conf) + if conf.hcrOn: result.add("#define NIM_HOT_CODE_RELOADING\L") + addNimDefines(result, conf) + +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) + else: + result = "" + result.add suffix -proc genFilenames(m: BModule): Rope = - discard cgsym(m, "dbgRegisterFilename") - result = nil - for i in 0..<m.config.m.fileInfos.len: - result.addf("dbgRegisterFilename($1);$N", [m.config.m.fileInfos[i].projPath.makeCString]) +proc getInitName(m: BModule): Rope = + if sfMainModule in m.module.flags: + # generate constant name for main module, for "easy" debugging. + result = rope(m.config.nimMainPrefix) & rope"NimMainModule" + else: + result = getSomeInitName(m, "Init000") + +proc getDatInitName(m: BModule): Rope = getSomeInitName(m, "DatInit000") +proc getHcrInitName(m: BModule): Rope = getSomeInitName(m, "HcrInit000") + +proc hcrGetProcLoadCode(m: BModule, sym, prefix, handle, getProcFunc: string): Rope 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 = "" + 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, strLit]) + + preMainCode.add(loadLib("hcr_handle", "hcrGetProc")) + 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("\t$1PreMain();\L" % [rope m.config.nimMainPrefix]) + + 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 = - "void PreMainInner(void) {$N" & - "\tsystemInit000();$N" & - "$1" & + + PreMainBody = "$N" & + "N_LIB_PRIVATE void $3PreMainInner(void) {$N" & "$2" & - "$3" & "}$N$N" & - "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" & - "\tsystemDatInit000();$N" & - "\tinner = PreMainInner;$N" & - "$4$5" & + "\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 nim_program_result;$N" + MainProcs & ("\treturn $1nim_program_result;$N") - NimMainInner = "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" & - "\tPreMain();$N" & - "\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 - PosixNimMain = - "int cmdCount;$N" & - "char** cmdLine;$N" & - "char** gEnv;$N" & - NimMainBody - PosixCMain = "int main(int argc, char** args, char** env) {$N" & "\tcmdLine = args;$N" & @@ -1020,19 +1623,19 @@ 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 PosixCDllMain = - "void NIM_POSIX_INIT NimMainInit(void) {$N" & + "N_LIB_PRIVATE void NIM_POSIX_INIT NimMainInit(void) {$N" & MainProcs & "}$N$N" 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 = @@ -1047,180 +1650,413 @@ proc genMainProc(m: BModule) = "\t});$N" & "}$N$N" - var nimMain, otherMain: FormatStr if m.config.target.targetOS == osWindows and m.config.globalOptions * {optGenGuiApp, optGenDynLib} != {}: - if optGenGuiApp in m.config.globalOptions: - nimMain = WinNimMain - otherMain = WinCMain - else: - nimMain = WinNimDllMain - otherMain = WinCDllMain m.includeHeader("<windows.h>") elif m.config.target.targetOS == osGenode: - nimMain = GenodeNimMain - otherMain = ComponentConstruct m.includeHeader("<libc/component.h>") - elif optGenDynLib in m.config.globalOptions: - nimMain = PosixNimDllMain - otherMain = PosixCDllMain - elif m.config.target.targetOS == osStandalone: - nimMain = PosixNimMain - otherMain = StandaloneCMain - else: - nimMain = PosixNimMain - otherMain = PosixCMain - if m.g.breakpoints != nil: discard cgsym(m, "dbgRegisterBreakpoint") - if optEndb in m.config.options: - m.g.breakpoints.add(m.genFilenames) let initStackBottomCall = - if m.config.target.targetOS == osStandalone or m.config.selectedGC == gcNone: "".rope - else: ropecg(m, "\t#initStackBottomWith((void *)&inner);$N") + 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.breakpoints, m.g.otherModsInit, - if emulatedThreadVars(m.config) and m.config.target.targetOS != osStandalone: - ropecg(m, "\t#initThreadVarsEmulation();$N") - else: - "".rope, - initStackBottomCall]) - - appcg(m, m.s[cfsProcs], nimMain, - [m.g.mainModInit, initStackBottomCall, rope(m.labels)]) - if optNoMain notin m.config.globalOptions: - if optUseNimNamespace in m.config.globalOptions: - m.s[cfsProcs].add closeNamespaceNim() & "using namespace Nim;\L" - - appcg(m, m.s[cfsProcs], otherMain, []) - if optUseNimNamespace in m.config.globalOptions: m.s[cfsProcs].add openNamespaceNim() - -proc getSomeInitName(m: PSym, suffix: string): 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 - result.add suffix -proc getInitName(m: PSym): Rope = - if sfMainModule in m.flags: - # generate constant name for main module, for "easy" debugging. - result = rope"NimMainModule" + 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.config.nimMainPrefix, isVolatile]) + else: + const nimMain = WinNimDllMain + appcg(m, m.s[cfsProcs], nimMain, + [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.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, m.config.nimMainPrefix, isVolatile]) else: - result = getSomeInitName(m, "Init000") + const nimMain = NimMainBody + appcg(m, m.s[cfsProcs], nimMain, + [m.g.mainModInit, initStackBottomCall, m.labels, preMainCode, m.config.nimMainPrefix, isVolatile]) + + if optNoMain notin m.config.globalOptions: + if m.config.cppCustomNamespace.len > 0: + 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: "", m.config.nimMainPrefix]) + else: + const otherMain = WinCDllMain + appcg(m, m.s[cfsProcs], otherMain, [m.config.nimMainPrefix]) + elif m.config.target.targetOS == osGenode: + const otherMain = ComponentConstruct + appcg(m, m.s[cfsProcs], otherMain, [m.config.nimMainPrefix]) + elif optGenDynLib in m.config.globalOptions: + const otherMain = PosixCDllMain + appcg(m, m.s[cfsProcs], otherMain, [m.config.nimMainPrefix]) + elif m.config.target.targetOS == osStandalone: + const otherMain = StandaloneCMain + appcg(m, m.s[cfsProcs], otherMain, [m.config.nimMainPrefix]) + else: + const otherMain = PosixCMain + appcg(m, m.s[cfsProcs], otherMain, [if m.hcrOn: "*" else: "", m.config.nimMainPrefix]) + + if m.config.cppCustomNamespace.len > 0: + 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 getDatInitName(m: PSym): Rope = getSomeInitName(m, "DatInit000") +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: PSym) = - var +proc registerModuleToMain(g: BModuleList; m: BModule) = + let init = m.getInitName datInit = m.getDatInitName - addf(g.mainModProcs, "N_LIB_PRIVATE N_NIMCALL(void, $1)(void);$N", [init]) - addf(g.mainModProcs, "N_LIB_PRIVATE N_NIMCALL(void, $1)(void);$N", [datInit]) - if sfSystemModule notin m.flags: - addf(g.mainDatInit, "\t$1();$N", [datInit]) + + if m.hcrOn: + var hcrModuleMeta = "$nN_LIB_PRIVATE const char* hcr_module_list[] = {$n" % [] + let systemModulePath = getModuleDllPath(m, g.modules[g.graph.config.m.systemFileIdx.int].module) + let mainModulePath = getModuleDllPath(m, m.module) + if sfMainModule in m.module.flags: + hcrModuleMeta.addf("\t$1,$n", [systemModulePath]) + g.graph.importDeps.withValue(FileIndex(m.module.position), deps): + for curr in deps[]: + hcrModuleMeta.addf("\t$1,$n", [getModuleDllPath(m, g.modules[curr.int].module)]) + 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, m.config)).rope]) + if sfMainModule in m.module.flags: + g.mainModProcs.add(hcrModuleMeta) + g.mainModProcs.addf("static void* hcr_handle;$N", []) + g.mainModProcs.addf("N_LIB_EXPORT N_NIMCALL(void, $1)(void);$N", [init]) + g.mainModProcs.addf("N_LIB_EXPORT N_NIMCALL(void, $1)(void);$N", [datInit]) + g.mainModProcs.addf("N_LIB_EXPORT N_NIMCALL(void, $1)(void*, N_NIMCALL_PTR(void*, getProcAddr)(void*, char*));$N", [m.getHcrInitName]) + g.mainModProcs.addf("N_LIB_EXPORT N_NIMCALL(void, HcrCreateTypeInfos)(void);$N", []) + g.mainModInit.addf("\t$1();$N", [init]) + g.otherModsInit.addf("\thcrInit((void**)hcr_module_list, $1, $2, $3, hcr_handle, nimGetProcAddr);$n", + [mainModulePath, systemModulePath, datInit]) + g.mainDatInit.addf("\t$1(hcr_handle, nimGetProcAddr);$N", [m.getHcrInitName]) + g.mainDatInit.addf("\thcrAddModule($1);\n", [mainModulePath]) + g.mainDatInit.addf("\tHcrCreateTypeInfos();$N", []) + # nasty nasty hack to get the command line functionality working with HCR + # register the 2 variables on behalf of the os module which might not even + # be loaded (in which case it will get collected but that is not a problem) + # EDIT: indeed, this hack, in combination with another un-necessary one + # (`makeCString` was doing line wrap of string litterals) was root cause for + # bug #16265. + let osModulePath = ($systemModulePath).replace("stdlib_system", "stdlib_os").rope + g.mainDatInit.addf("\thcrAddModule($1);\n", [osModulePath]) + g.mainDatInit.add("\tint* cmd_count;\n") + g.mainDatInit.add("\tchar*** cmd_line;\n") + g.mainDatInit.addf("\thcrRegisterGlobal($1, \"cmdCount\", sizeof(cmd_count), NULL, (void**)&cmd_count);$N", [osModulePath]) + g.mainDatInit.addf("\thcrRegisterGlobal($1, \"cmdLine\", sizeof(cmd_line), NULL, (void**)&cmd_line);$N", [osModulePath]) + g.mainDatInit.add("\t*cmd_count = cmdCount;\n") + g.mainDatInit.add("\t*cmd_line = cmdLine;\n") + else: + m.s[cfsInitProc].add(hcrModuleMeta) + return + + if m.s[cfsDatInitProc].len > 0: + g.mainModProcs.addf("N_LIB_PRIVATE N_NIMCALL(void, $1)(void);$N", [datInit]) + g.mainDatInit.addf("\t$1();$N", [datInit]) + + # Initialization of TLS and GC should be done in between + # systemDatInit and systemInit calls if any + 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, gcAtomicArc, gcOrc}: + g.mainDatInit.add(ropecg(m, "\t#initStackBottomWith((void *)&inner);$N", [])) + + if m.s[cfsInitProc].len > 0: + g.mainModProcs.addf("N_LIB_PRIVATE N_NIMCALL(void, $1)(void);$N", [init]) let initCall = "\t$1();$N" % [init] - if sfMainModule in m.flags: - add(g.mainModInit, initCall) + if sfMainModule in m.module.flags: + g.mainModInit.add(initCall) + elif sfSystemModule in m.module.flags: + g.mainDatInit.add(initCall) # systemInit must called right after systemDatInit if any else: - add(g.otherModsInit, initCall) + g.otherModsInit.add(initCall) + +proc genDatInitCode(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 moduleDatInitRequired = m.hcrOn + + var prc = "$1 N_NIMCALL(void, $2)(void) {$N" % + [rope(if m.hcrOn: "N_LIB_EXPORT" else: "N_LIB_PRIVATE"), getDatInitName(m)] + + # 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, InvalidFileIdx, 999999, m.config) + + for i in cfsTypeInit1..cfsDynLibInit: + if m.s[i].len != 0: + moduleDatInitRequired = true + prc.add(m.s[i]) + + prc.addf("}$N$N", []) + + 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 +proc hcrGetProcLoadCode(m: BModule, sym, prefix, handle, getProcFunc: string): Rope = + let prc = magicsys.getCompilerProc(m.g.graph, sym) + assert prc != nil + fillProcLoc(m, prc.ast[namePos]) + + var extname = prefix & sym + var tmp = mangleDynLibProc(prc) + 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.snippet, getTypeDesc(m, prc.loc.t, dkVar)]) + + result = "\t$1 = ($2) $3($4, $5);$n" % + [tmp, getTypeDesc(m, prc.typ, dkVar), getProcFunc.rope, handle.rope, makeCString(prefix & sym)] proc genInitCode(m: BModule) = - var initname = getInitName(m.module) - var prc = "N_LIB_PRIVATE N_NIMCALL(void, $1)(void) {$N" % [initname] + ## 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 moduleInitRequired = m.hcrOn + let initname = getInitName(m) + var prc = "$1 N_NIMCALL(void, $2)(void) {$N" % + [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, InvalidFileIdx, 999999, m.config) if m.typeNodes > 0: - appcg(m, m.s[cfsTypeInit1], "static #TNimNode $1[$2];$n", - [m.typeNodesName, rope(m.typeNodes)]) + if m.hcrOn: + appcg(m, m.s[cfsTypeInit1], "\t#TNimNode* $1;$N", [m.typeNodesName]) + appcg(m, m.s[cfsTypeInit1], "\thcrRegisterGlobal($3, \"$1_$2\", sizeof(TNimNode) * $2, NULL, (void**)&$1);$N", + [m.typeNodesName, m.typeNodes, getModuleDllPath(m, m.module)]) + else: + appcg(m, m.s[cfsTypeInit1], "static #TNimNode $1[$2];$n", + [m.typeNodesName, m.typeNodes]) if m.nimTypes > 0: appcg(m, m.s[cfsTypeInit1], "static #TNimType $1[$2];$n", - [m.nimTypesName, rope(m.nimTypes)]) - - add(prc, initGCFrame(m.initProc)) - - add(prc, genSectionStart(cpsLocals, m.config)) - add(prc, m.preInitProc.s(cpsLocals)) - add(prc, m.initProc.s(cpsLocals)) - add(prc, m.postInitProc.s(cpsLocals)) - add(prc, genSectionEnd(cpsLocals, m.config)) - - if optStackTrace in m.initProc.options and frameDeclared notin m.flags: - # BUT: the generated init code might depend on a current frame, so - # declare it nevertheless: - incl m.flags, frameDeclared - if preventStackTrace notin m.flags: - var procname = makeCString(m.module.name.s) - add(prc, initFrame(m.initProc, procname, quotedFilename(m.config, m.module.info))) - else: - add(prc, ~"\tTFrame FR_; FR_.len = 0;$N") - - add(prc, genSectionStart(cpsInit, m.config)) - add(prc, m.preInitProc.s(cpsInit)) - add(prc, m.initProc.s(cpsInit)) - add(prc, m.postInitProc.s(cpsInit)) - add(prc, genSectionEnd(cpsInit, m.config)) - - add(prc, genSectionStart(cpsStmts, m.config)) - add(prc, m.preInitProc.s(cpsStmts)) - add(prc, m.initProc.s(cpsStmts)) - add(prc, m.postInitProc.s(cpsStmts)) - add(prc, genSectionEnd(cpsStmts, m.config)) - if optStackTrace in m.initProc.options and preventStackTrace notin m.flags: - add(prc, deinitFrame(m.initProc)) - add(prc, deinitGCFrame(m.initProc)) - addf(prc, "}$N$N", []) - - prc.addf("N_LIB_PRIVATE N_NIMCALL(void, $1)(void) {$N", - [getDatInitName(m.module)]) + [m.nimTypesName, m.nimTypes]) + + if m.hcrOn: + prc.addf("\tint* nim_hcr_dummy_ = 0;$n" & + "\tNIM_BOOL nim_hcr_do_init_ = " & + "hcrRegisterGlobal($1, \"module_initialized_\", 1, NULL, (void**)&nim_hcr_dummy_);$n", + [getModuleDllPath(m, m.module)]) + + template writeSection(thing: untyped, section: TCProcSection, addHcrGuards = false) = + if m.thing.s(section).len > 0: + moduleInitRequired = true + if addHcrGuards: prc.add("\tif (nim_hcr_do_init_) {\n\n") + prc.add(m.thing.s(section)) + if addHcrGuards: prc.add("\n\t} // nim_hcr_do_init_\n") + + if m.preInitProc.s(cpsInit).len > 0 or m.preInitProc.s(cpsStmts).len > 0: + # 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") + + writeSection(preInitProc, cpsLocals) + writeSection(preInitProc, cpsInit, m.hcrOn) + writeSection(preInitProc, cpsStmts) + prc.addf("}/* preInitProc end */$N", []) + when false: + m.initProc.blocks[0].sections[cpsLocals].add m.preInitProc.s(cpsLocals) + m.initProc.blocks[0].sections[cpsInit].prepend m.preInitProc.s(cpsInit) + m.initProc.blocks[0].sections[cpsStmts].prepend m.preInitProc.s(cpsStmts) + + # add new scope for following code, because old vcc compiler need variable + # be defined at the top of the block + prc.addf("{$N", []) + writeSection(initProc, cpsLocals) + + if m.initProc.s(cpsInit).len > 0 or m.initProc.s(cpsStmts).len > 0: + moduleInitRequired = true + if optStackTrace in m.initProc.options and frameDeclared notin m.flags: + # BUT: the generated init code might depend on a current frame, so + # declare it nevertheless: + incl m.flags, frameDeclared + if preventStackTrace notin m.flags: + 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") - for i in cfsTypeInit1..cfsDynLibInit: - add(prc, genSectionStart(i, m.config)) - add(prc, m.s[i]) - add(prc, genSectionEnd(i, m.config)) + writeSection(initProc, cpsInit, m.hcrOn) + writeSection(initProc, cpsStmts) + + if beforeRetNeeded in m.initProc.flags: + prc.add("\tBeforeRet_: ;\n") + + if m.config.exc == excGoto: + if getCompilerProc(m.g.graph, "nimTestErrorFlag") != nil: + m.appcg(prc, "\t#nimTestErrorFlag();$n", []) + + if optStackTrace in m.initProc.options and preventStackTrace notin m.flags: + prc.add(deinitFrame(m.initProc)) + + prc.addf("}$N", []) + + prc.addf("}$N$N", []) - addf(prc, "}$N$N", []) # we cannot simply add the init proc to ``m.s[cfsProcs]`` anymore because # that would lead to a *nesting* of merge sections which the merger does # not support. So we add it to another special section: ``cfsInitProc`` - add(m.s[cfsInitProc], prc) + + if m.hcrOn: + var procsToLoad = @["hcrRegisterProc", "hcrGetProc", "hcrRegisterGlobal", "hcrGetGlobal"] + + m.s[cfsInitProc].addf("N_LIB_EXPORT N_NIMCALL(void, $1)(void* handle, N_NIMCALL_PTR(void*, getProcAddr)(void*, char*)) {$N", [getHcrInitName(m)]) + if sfMainModule in m.module.flags: + # additional procs to load + procsToLoad.add("hcrInit") + procsToLoad.add("hcrAddModule") + # load procs + for curr in procsToLoad: + m.s[cfsInitProc].add(hcrGetProcLoadCode(m, curr, "", "handle", "getProcAddr")) + 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] - add(m.s[cfsInitProc], ex) + moduleInitRequired = true + prc.add(ex) + + if moduleInitRequired or sfMainModule in m.module.flags: + m.s[cfsInitProc].add(prc) + #rememberFlag(m.g.graph, m.module, HasModuleInitProc) + + genDatInitCode(m) + + if m.hcrOn: + m.s[cfsInitProc].addf("N_LIB_EXPORT N_NIMCALL(void, HcrCreateTypeInfos)(void) {$N", []) + m.s[cfsInitProc].add(m.hcrCreateTypeInfosProc) + m.s[cfsInitProc].addf("}$N$N", []) + + 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 + result = getFileHeader(m.config, cfile) - result.add(genMergeInfo(m)) generateThreadLocalStorage(m) generateHeaders(m) - for i in countup(cfsHeaders, cfsProcs): - add(result, genSectionStart(i, m.config)) - add(result, m.s[i]) - add(result, genSectionEnd(i, m.config)) - if optUseNimNamespace in m.config.globalOptions and i == cfsHeaders: - result.add openNamespaceNim() - add(result, m.s[cfsInitProc]) - if optUseNimNamespace in m.config.globalOptions: result.add closeNamespaceNim() - -proc newPreInitProc(m: BModule): BProc = - result = newProc(nil, m) - # little hack so that unique temporaries are generated: - result.labels = 100_000 - -proc newPostInitProc(m: BModule): BProc = - result = newProc(nil, m) - # little hack so that unique temporaries are generated: - result.labels = 200_000 + result.add(m.s[cfsHeaders]) + if m.config.cppCustomNamespace.len > 0: + openNamespaceNim(m.config.cppCustomNamespace, result) + if m.s[cfsFrameDefines].len > 0: + result.add(m.s[cfsFrameDefines]) + + for i in cfsForwardTypes..cfsProcs: + if m.s[i].len > 0: + moduleIsEmpty = false + result.add(m.s[i]) + + if m.s[cfsInitProc].len > 0: + moduleIsEmpty = false + result.add(m.s[cfsInitProc]) + if m.s[cfsDatInitProc].len > 0 or m.hcrOn: + moduleIsEmpty = false + result.add(m.s[cfsDatInitProc]) + + if m.config.cppCustomNamespace.len > 0: + closeNamespaceNim(result) + + if optLineDir in m.config.options: + var srcFileDefs = "" + for fi in 0..m.config.m.fileInfos.high: + srcFileDefs.add("#define FX_" & $fi & " " & makeSingleLineCString(toFullPath(m.config, fi.FileIndex)) & "\n") + result = srcFileDefs & result + + if moduleIsEmpty: + result = "" + + postprocessCode(m.config, result) proc initProcOptions(m: BModule): TOptions = let opts = m.config.options if sfSystemModule in m.module.flags: opts-{optStackTrace} else: opts -proc rawNewModule(g: BModuleList; module: PSym, filename: string): BModule = +proc rawNewModule(g: BModuleList; module: PSym, filename: AbsoluteFile): BModule = new(result) result.g = g result.tmpBase = rope("TM" & $hashOwner(module) & "_") @@ -1235,76 +2071,28 @@ proc rawNewModule(g: BModuleList; module: PSym, filename: string): 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 = newPreInitProc(result) - result.postInitProc = newPostInitProc(result) - initNodeTable(result.dataCache) + result.preInitProc = newProc(nil, result) + result.preInitProc.flags.incl nimErrorFlagDisabled + result.preInitProc.labels = 100_000 # little hack so that unique temporaries are generated + result.dataCache = initNodeTable() result.typeStack = @[] - result.forwardedProcs = @[] result.typeNodesName = getTempName(result) result.nimTypesName = getTempName(result) # no line tracing for the init sections of the system module so that we - # don't generate a TFrame which can confuse the stack botton initialization: + # don't generate a TFrame which can confuse the stack bottom initialization: if sfSystemModule in module.flags: incl result.flags, preventStackTrace excl(result.preInitProc.options, optStackTrace) - excl(result.postInitProc.options, optStackTrace) - let ndiName = if optCDebug in g.config.globalOptions: changeFileExt(completeCFilePath(g.config, filename), "ndi") - else: "" + let ndiName = if optCDebug in g.config.globalOptions: changeFileExt(completeCfilePath(g.config, filename), "ndi") + else: AbsoluteFile"" open(result.ndi, ndiName, g.config) -proc nullify[T](arr: var T) = - for i in low(arr)..high(arr): - arr[i] = Rope(nil) - -proc resetModule*(m: BModule) = - # between two compilations in CAAS mode, we can throw - # away all the data that was written to disk - m.headerFiles = @[] - m.declaredProtos = initIntSet() - m.forwTypeCache = initTable[SigHash, Rope]() - m.initProc = newProc(nil, m) - m.initProc.options = initProcOptions(m) - m.preInitProc = newPreInitProc(m) - m.postInitProc = newPostInitProc(m) - initNodeTable(m.dataCache) - m.typeStack = @[] - m.forwardedProcs = @[] - m.typeNodesName = getTempName(m) - m.nimTypesName = getTempName(m) - if sfSystemModule in m.module.flags: - incl m.flags, preventStackTrace - else: - excl m.flags, preventStackTrace - nullify m.s - m.typeNodes = 0 - m.nimTypes = 0 - nullify m.extensionLoaders - - # indicate that this is now cached module - # the cache will be invalidated by nullifying gModules - #m.fromCache = true - m.g = nil - - # we keep only the "merge info" information for the module - # and the properties that can't change: - # m.filename - # m.cfilename - # m.isHeaderFile - # m.module ? - # m.typeCache - # m.declaredThings - # m.typeInfoMarker - # m.labels - # m.FrameDeclared - -proc resetCgenModules*(g: BModuleList) = - for m in cgenModules(g): resetModule(m) - proc rawNewModule(g: BModuleList; module: PSym; conf: ConfigRef): BModule = - result = rawNewModule(g, module, toFullPath(conf, module.position.FileIndex)) + result = rawNewModule(g, module, AbsoluteFile toFullPath(conf, module.position.FileIndex)) -proc newModule(g: BModuleList; module: PSym; conf: ConfigRef): BModule = +proc newModule*(g: BModuleList; module: PSym; conf: ConfigRef): BModule = # we should create only one cgen module for each module sym result = rawNewModule(g, module, conf) if module.position >= g.modules.len: @@ -1317,49 +2105,45 @@ template injectG() {.dirty.} = graph.backend = newModuleList(graph) let g = BModuleList(graph.backend) -proc myOpen(graph: ModuleGraph; module: PSym): PPassContext = +proc setupCgen*(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext = injectG() result = newModule(g, module, graph.config) + result.idgen = idgen if optGenIndex in graph.config.globalOptions and g.generatedHeader == nil: - let f = if graph.config.headerFile.len > 0: graph.config.headerFile + let f = if graph.config.headerFile.len > 0: AbsoluteFile graph.config.headerFile else: graph.config.projectFull g.generatedHeader = rawNewModule(g, module, - changeFileExt(completeCFilePath(graph.config, f), hExt)) + changeFileExt(completeCfilePath(graph.config, f), hExt)) incl g.generatedHeader.flags, isHeaderFile proc writeHeader(m: BModule) = - var result = ("/* Generated by Nim Compiler v$1 */$N" & - "/* (c) 2017 Andreas Rumpf */$N" & - "/* The generated code is subject to the original license. */$N") % - [rope(VersionAsString)] - + var result = headerTop() var guard = "__$1__" % [m.filename.splitFile.name.rope] result.addf("#ifndef $1$n#define $1$n", [guard]) - addIntTypes(result, m.config) + addNimDefines(result, m.config) generateHeaders(m) generateThreadLocalStorage(m) - for i in countup(cfsHeaders, cfsProcs): - add(result, genSectionStart(i, m.config)) - add(result, m.s[i]) - add(result, genSectionEnd(i, m.config)) - if optUseNimNamespace in m.config.globalOptions and i == cfsHeaders: result.add openNamespaceNim() - add(result, m.s[cfsInitProc]) + for i in cfsHeaders..cfsProcs: + result.add(m.s[i]) + 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 optUseNimNamespace in m.config.globalOptions: 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) + rawMessage(m.config, errCannotOpenFile, m.filename.string) -proc getCFile(m: BModule): string = +proc getCFile(m: BModule): AbsoluteFile = let ext = - if m.compileToCpp: ".cpp" - elif m.config.cmd == cmdCompileToOC or sfCompileToObjC in m.module.flags: ".m" - else: ".c" - result = changeFileExt(completeCFilePath(m.config, withPackageName(m.config, m.cfilename)), ext) + 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, mangleModuleName(m.config, m.cfilename).AbsoluteFile), ext) when false: proc myOpenCached(graph: ModuleGraph; module: PSym, rd: PRodReader): PPassContext = @@ -1368,48 +2152,63 @@ when false: readMergeInfo(getCFile(m), m) result = m -proc myProcess(b: PPassContext, n: PNode): PNode = - result = n - if b == nil: return - var m = BModule(b) - if passes.skipCodegen(m.config, n): return +proc addHcrInitGuards(p: BProc, n: PNode, inInitGuard: var bool) = + if n.kind == nkStmtList: + for child in n: + addHcrInitGuards(p, child, inInitGuard) + else: + let stmtShouldExecute = n.kind in {nkVarSection, nkLetSection} or + nfExecuteOnReload in n.flags + if inInitGuard: + if stmtShouldExecute: + endBlock(p) + inInitGuard = false + else: + if not stmtShouldExecute: + line(p, cpsStmts, "if (nim_hcr_do_init_)\n") + startBlock(p) + inInitGuard = true + + genStmts(p, n) + +proc genTopLevelStmt*(m: BModule; n: PNode) = + ## Also called from `ic/cbackend.nim`. + 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! - genStmts(m.initProc, n) + var transformedN = transformStmt(m.g.graph, m.idgen, m.module, n) + if sfInjectDestructors in m.module.flags: + transformedN = injectDestructorCalls(m.g.graph, m.idgen, m.module, transformedN) -proc finishModule(m: BModule) = - var i = 0 - while i <= high(m.forwardedProcs): - # Note: ``genProc`` may add to ``m.forwardedProcs``, so we cannot use - # a ``for`` loop here - var prc = m.forwardedProcs[i] - if sfForward in prc.flags: - internalError(m.config, prc.info, "still forwarded: " & prc.name.s) - genProcNoForward(m, prc) - inc(i) - assert(m.g.forwardedProcsCounter >= i) - dec(m.g.forwardedProcsCounter, i) - setLen(m.forwardedProcs, 0) + if m.hcrOn: + addHcrInitGuards(m.initProc, transformedN, m.inHcrInitGuard) + else: + genProcBody(m.initProc, transformedN) proc shouldRecompile(m: BModule; code: Rope, cfile: Cfile): bool = - result = true if optForceFullMake notin m.config.globalOptions: - if not equalsFile(code, cfile.cname): - if isDefined(m.config, "nimdiff"): + if not moduleHasChanged(m.g.graph, m.module): + result = false + elif not equalsFile(code, cfile.cname): + when false: + #m.config.symbolFiles == readOnlySf: #isDefined(m.config, "nimdiff"): if fileExists(cfile.cname): - copyFile(cfile.cname, cfile.cname & ".backup") - echo "diff ", cfile.cname, ".backup ", cfile.cname + copyFile(cfile.cname.string, cfile.cname.string & ".backup") + echo "diff ", cfile.cname.string, ".backup ", cfile.cname.string else: - echo "new file ", cfile.cname + echo "new file ", cfile.cname.string if not writeRope(code, cfile.cname): - rawMessage(m.config, errCannotOpenFile, cfile.cname) - return - if existsFile(cfile.obj) and os.fileNewer(cfile.obj, cfile.cname): + rawMessage(m.config, errCannotOpenFile, cfile.cname.string) + result = true + elif fileExists(cfile.obj) and os.fileNewer(cfile.obj.string, cfile.cname.string): result = false + else: + result = true else: if not writeRope(code, cfile.cname): - rawMessage(m.config, errCannotOpenFile, cfile.cname) + rawMessage(m.config, errCannotOpenFile, cfile.cname.string) + result = true # We need 2 different logics here: pending modules (including # 'nim__dat') may require file merging for the combination of dead code @@ -1418,94 +2217,144 @@ proc shouldRecompile(m: BModule; code: Rope, cfile: Cfile): bool = # it would generate multiple 'main' procs, for instance. proc writeModule(m: BModule, pending: bool) = - # generate code for the init statements of the module: + template onExit() = close(m.ndi, m.config) let cfile = getCFile(m) - - if true or optForceFullMake in m.config.globalOptions: + if moduleHasChanged(m.g.graph, m.module): genInitCode(m) finishTypeDescriptions(m) if sfMainModule in m.module.flags: # generate main file: - add(m.s[cfsProcHeaders], m.g.mainModProcs) + genMainProc(m) + m.s[cfsProcHeaders].add(m.g.mainModProcs) generateThreadVarsSize(m) - var cf = Cfile(cname: cfile, obj: completeCFilePath(m.config, toObjFile(m.config, cfile)), flags: {}) - var code = genModule(m, cf) + 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 != "" or m.config.symbolFiles != disabledSf: when hasTinyCBackend: - if conf.cmd == cmdRun: - tccgen.compileCCode($code) + if m.config.cmd == cmdTcc: + tccgen.compileCCode($code, m.config) + onExit() return if not shouldRecompile(m, code, cf): cf.flags = {CfileFlag.Cached} addFileToCompile(m.config, cf) - elif pending and mergeRequired(m) and sfMainModule notin m.module.flags: - let cf = Cfile(cname: cfile, obj: completeCFilePath(m.config, toObjFile(m.config, cfile)), flags: {}) - mergeFiles(cfile, m) - genInitCode(m) - finishTypeDescriptions(m) - var code = genModule(m, cf) - if not writeRope(code, cfile): - rawMessage(m.config, errCannotOpenFile, cfile) - addFileToCompile(m.config, cf) - else: - # Consider: first compilation compiles ``system.nim`` and produces - # ``system.c`` but then compilation fails due to an error. This means - # that ``system.o`` is missing, so we need to call the C compiler for it: - var cf = Cfile(cname: cfile, obj: completeCFilePath(m.config, toObjFile(m.config, cfile)), flags: {}) - if not existsFile(cf.obj): cf.flags = {CfileFlag.Cached} - addFileToCompile(m.config, cf) - close(m.ndi) + onExit() proc updateCachedModule(m: BModule) = let cfile = getCFile(m) - var cf = Cfile(cname: cfile, obj: completeCFilePath(m.config, toObjFile(m.config, cfile)), flags: {}) - - if mergeRequired(m) and sfMainModule notin m.module.flags: - mergeFiles(cfile, m) - genInitCode(m) - finishTypeDescriptions(m) - - var code = genModule(m, cf) - if not writeRope(code, cfile): - rawMessage(m.config, errCannotOpenFile, cfile) - else: - cf.flags = {CfileFlag.Cached} + var cf = Cfile(nimname: m.module.name.s, cname: cfile, + obj: completeCfilePath(m.config, toObjFile(m.config, cfile)), flags: {}) + if sfMainModule notin m.module.flags: + genMainProc(m) + cf.flags = {CfileFlag.Cached} addFileToCompile(m.config, cf) -proc myClose(graph: ModuleGraph; b: PPassContext, n: PNode): PNode = - result = n - if b == nil: return - var m = BModule(b) - if passes.skipCodegen(m.config, n): return - # if the module is cached, we don't regenerate the main proc - # nor the dispatchers? But if the dispatchers changed? - # XXX emit the dispatchers into its own .c file? - if n != nil: - m.initProc.options = initProcOptions(m) - genStmts(m.initProc, n) - # cached modules need to registered too: - registerModuleToMain(m.g, m.module) - +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: - if m.g.forwardedProcsCounter == 0: - incl m.flags, objHasKidsValid - let disp = generateMethodDispatchers(graph) - for x in disp: genProcAux(m, x.sym) - genMainProc(m) + # 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: + cgsym(m, "nimTestErrorFlag") + + if {optGenStaticLib, optGenDynLib, optNoMain} * m.config.globalOptions == {}: + for i in countdown(high(graph.globalDestructors), 0): + n.add graph.globalDestructors[i] + else: + var body = newNodeI(nkStmtList, m.module.info) + for i in countdown(high(graph.globalDestructors), 0): + body.add graph.globalDestructors[i] + body.flags.incl nfTransf # should not be further transformed + let dtor = generateLibraryDestroyGlobals(graph, m, body, optGenDynLib in m.config.globalOptions) + genProcAux(m, dtor) + if pipelineutils.skipCodegen(m.config, n): return + if moduleHasChanged(graph, m.module): + # if the module is cached, we don't regenerate the main proc + # nor the dispatchers? But if the dispatchers changed? + # XXX emit the dispatchers into its own .c file? + if n != nil: + m.initProc.options = initProcOptions(m) + genProcBody(m.initProc, n) + + if m.hcrOn: + # make sure this is pulled in (meaning hcrGetGlobal() is called for it during init) + 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) + + if sfMainModule in m.module.flags: + if m.hcrOn: + # pull ("define" since they are inline when HCR is on) these functions in the main file + # 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 + 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 notin {gcNone, gcArc, gcAtomicArc, gcOrc}: + cgsym(m, "initStackBottomWith") + if emulatedThreadVars(m.config) and m.config.target.targetOS != osStandalone: + cgsym(m, "initThreadVarsEmulation") + + if m.g.forwardedProcs.len == 0: + incl m.flags, objHasKidsValid + 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 genForwardedProcs(g: BModuleList) = + # Forward declared proc:s lack bodies when first encountered, so they're given + # a second pass here + # Note: ``genProcNoForward`` may add to ``forwardedProcs`` + while g.forwardedProcs.len > 0: + let + prc = g.forwardedProcs.pop() + m = g.modules[prc.itemId.module] + if sfForward in prc.flags: + internalError(m.config, prc.info, "still forwarded: " & prc.name.s) + + genProcNoForward(m, prc) proc cgenWriteModules*(backend: RootRef, config: ConfigRef) = let g = BModuleList(backend) + g.config = config + # we need to process the transitive closure because recursive module # deps are allowed (and the system module is processed in the wrong # order anyway) - g.config = config - if g.generatedHeader != nil: finishModule(g.generatedHeader) - while g.forwardedProcsCounter > 0: - for m in cgenModules(g): - finishModule(m) + genForwardedProcs(g) + for m in cgenModules(g): 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 a526a0f00..5368e9dc7 100644 --- a/compiler/cgendata.nim +++ b/compiler/cgendata.nim @@ -10,35 +10,32 @@ ## This module contains the data structures for the C code generation phase. import - ast, astalgo, ropes, passes, options, intsets, platform, sighashes, - tables, ndi, lineinfos + ast, ropes, options, + ndi, lineinfos, pathutils, modulegraphs -from modulegraphs import ModuleGraph +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 cfsTypes, # section for C typedefs cfsSeqTypes, # section for sequence types only # this is needed for strange type generation # reasons - cfsFieldInfo, # section for field information - cfsTypeInfo, # section for type information + cfsTypeInfo, # section for type information (ag ABI checks) cfsProcHeaders, # section for C procs prototypes - cfsVars, # section for C variable declarations + 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, @@ -58,21 +55,27 @@ type id*: int # the ID of the label; positive means that it label*: Rope # generated text for the label # nil if label is not used - sections*: TCProcSections # the code beloging + sections*: TCProcSections # the code belonging isLoop*: bool # whether block is a loop nestedTryStmts*: int16 # how many try statements is it nested into nestedExceptStmts*: int16 # how many except statements is it nested into frameLen*: int16 + TCProcFlag* = enum + beforeRetNeeded, + threadVarAccessed, + hasCurFramePointer, + noSafePoints, + nimErrorFlagAccessed, + nimErrorFlagDeclared, + nimErrorFlagDisabled + TCProc = object # represents C proc that is currently generated prc*: PSym # the Nim proc that this C proc belongs to - beforeRetNeeded*: bool # true iff 'BeforeRet' label for proc is needed - threadVarAccessed*: bool # true if the proc already accessed some threadvar - hasCurFramePointer*: bool # true if _nimCurFrame var needed to recover after - # exception is generated + flags*: set[TCProcFlag] lastLineInfo*: TLineInfo # to avoid generating excessive 'nimln' statements currLineInfo*: TLineInfo # AST codegen will make this superfluous - nestedTryStmts*: seq[tuple[n: PNode, inExcept: bool]] + nestedTryStmts*: seq[tuple[fin: PNode, inExcept: bool, label: Natural]] # in how many nested try statements we are # (the vars must be volatile then) # bool is true when are in the except part of a try block @@ -85,20 +88,22 @@ type options*: TOptions # options that should be used for code # generation; this is the same as prc.options # unless prc == nil - maxFrameLen*: int # max length of frame descriptor + 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 # requires 'T x = T()' to become 'T x; x = T()' # (yes, C++ is weird like that) - gcFrameId*: Natural # for the GC stack marking - gcFrameType*: Rope # the struct {} we put the GC markers into + 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] + TypeCacheWithOwner* = Table[SigHash, tuple[str: Rope, owner: int32]] - Codegenflag* = enum + CodegenFlag* = enum preventStackTrace, # true if stack traces need to be prevented usesThreadVars, # true if the module uses a thread var frameDeclared, # hack for ROD support so that we don't declare @@ -106,17 +111,18 @@ type isHeaderFile, # C source file is the header file includesStringh, # C source file already includes ``<string.h>`` objHasKidsValid # whether we can rely on tfObjHasKids - + useAliveDataFromDce # use the `alive: IntSet` field instead of + # computing alive data on our own. BModuleList* = ref object of RootObj mainModProcs*, mainModInit*, otherModsInit*, mainDatInit*: Rope mapping*: Rope # the generated mapping file (if requested) modules*: seq[BModule] # list of all compiled modules - forwardedProcsCounter*: int + modulesClosed*: seq[BModule] # list of the same compiled modules, but in the order they were closed + forwardedProcs*: seq[PSym] # proc:s that did not yet have a body generatedHeader*: BModule - breakPointId*: int - breakpoints*: Rope # later the breakpoints are inserted into the main proc - typeInfoMarker*: TypeCache + typeInfoMarker*: TypeCacheWithOwner + typeInfoMarkerV2*: TypeCacheWithOwner config*: ConfigRef graph*: ModuleGraph strVersion*, seqVersion*: int # version of the string/seq implementation to use @@ -131,39 +137,46 @@ 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 TPassContext # represents a C source file + TCGen = object of PPassContext # represents a C source file s*: TCFileSections # sections of the C file - flags*: set[Codegenflag] + flags*: set[CodegenFlag] module*: PSym - filename*: string - cfilename*: string # filename of the module (including path, + filename*: AbsoluteFile + cfilename*: AbsoluteFile # filename of the module (including path, # without extension) tmpBase*: Rope # base for temp identifier generation typeCache*: TypeCache # cache the generated types + 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 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 + alive*: IntSet # symbol IDs of alive data as computed by `dce.nim` headerFiles*: seq[string] # needed headers to include typeInfoMarker*: TypeCache # needed for generating type information + typeInfoMarkerV2*: TypeCache initProc*: BProc # code for init procedure - postInitProc*: BProc # code to be executed after the init proc preInitProc*: BProc # code executed before the init proc + hcrCreateTypeInfosProc*: Rope # type info globals are in here when HCR=on + inHcrInitGuard*: bool # We are currently within a HCR reloading guard. typeStack*: TTypeSeq # used for type generation dataCache*: TNodeTable - forwardedProcs*: TSymSeq # keep forwarded procs here typeNodes*, nimTypes*: int # used for type info generation typeNodesName*, nimTypesName*: Rope # used for type info generation labels*: Natural # for generating unique module-scope names extensionLoaders*: array['0'..'9', Rope] # special procs for the - # OpenGL wrapper - injectStmt*: Rope + # OpenGL wrapper 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: @@ -171,30 +184,35 @@ proc includeHeader*(this: BModule; header: string) = proc s*(p: BProc, s: TCProcSection): var Rope {.inline.} = # section in the current block - result = p.blocks[p.blocks.len-1].sections[s] + result = p.blocks[^1].sections[s] 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 - if prc != nil: result.options = prc.options - else: result.options = 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(modules: @[], typeInfoMarker: initTable[SigHash, Rope](), config: g.config, - graph: g, nimtvDeps: @[], nimtvDeclared: initIntSet()) + BModuleList(typeInfoMarker: initTable[SigHash, tuple[str: Rope, owner: int32]](), + config: g.config, graph: g, nimtvDeclared: initIntSet()) iterator cgenModules*(g: BModuleList): BModule = - for i in 0..high(g.modules): - # ultimately, we are iterating over the file ids here. - # some "files" won't have an associated cgen module (like stdin) - # and we must skip over them. - if g.modules[i] != nil: yield g.modules[i] + for m in g.modulesClosed: + # iterate modules in the order they were closed + yield m diff --git a/compiler/cgmeth.nim b/compiler/cgmeth.nim index 5b58e6498..ca97d0494 100644 --- a/compiler/cgmeth.nim +++ b/compiler/cgmeth.nim @@ -7,11 +7,18 @@ # distribution, for details about the copyright. # -## This module implements code generation for multi methods. +## This module implements code generation for methods. import - intsets, options, ast, astalgo, 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) @@ -23,11 +30,11 @@ proc genConv(n: PNode, d: PType, downcast: bool; conf: ConfigRef): PNode = result = n elif diff < 0: result = newNodeIT(nkObjUpConv, n.info, d) - addSon(result, n) + result.add n if downcast: internalError(conf, n.info, "cgmeth.genConv: no upcast allowed") elif diff > 0: result = newNodeIT(nkObjDownConv, n.info, d) - addSon(result, n) + result.add n if not downcast: internalError(conf, n.info, "cgmeth.genConv: no downcast allowed") else: @@ -37,53 +44,58 @@ proc genConv(n: PNode, d: PType, downcast: bool; conf: ConfigRef): PNode = proc getDispatcher*(s: PSym): PSym = ## can return nil if is has no dispatcher. - let dispn = lastSon(s.ast) - if dispn.kind == nkSym: - let disp = dispn.sym - if sfDispatcher in disp.flags: result = disp + 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.sons[0].sym) + let disp = getDispatcher(result[0].sym) if disp != nil: - result.sons[0].sym = disp + result[0].typ = disp.typ + result[0].sym = disp # change the arguments to up/downcasts to fit the dispatcher's parameters: - for i in countup(1, sonsLen(result)-1): - result.sons[i] = genConv(result.sons[i], disp.typ.sons[i], true, conf) + for i in 1..<result.len: + result[i] = genConv(result[i], disp.typ[i], true, conf) else: - localError(conf, n.info, "'" & $result.sons[0] & "' lacks a dispatcher") + localError(conf, n.info, "'" & $result[0] & "' lacks a dispatcher") type MethodResult = enum No, Invalid, Yes -proc sameMethodBucket(a, b: PSym): MethodResult = +proc sameMethodBucket(a, b: PSym; multiMethods: bool): MethodResult = + result = No if a.name.id != b.name.id: return - if sonsLen(a.typ) != sonsLen(b.typ): + if a.typ.signatureLen != b.typ.signatureLen: return - for i in countup(1, sonsLen(a.typ) - 1): - var aa = a.typ.sons[i] - var bb = b.typ.sons[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}: - aa = aa.lastSon - bb = bb.lastSon + if aa.kind == bb.kind and aa.kind in {tyVar, tyPtr, tyRef, tyLent, tySink}: + aa = aa.elementType + bb = bb.elementType else: break - if sameType(aa, bb): + if sameType(x, y): if aa.kind == tyObject and result != Invalid: result = Yes - elif aa.kind == tyObject and bb.kind == tyObject: + elif aa.kind == tyObject and bb.kind == tyObject and (i == 1 or multiMethods): let diff = inheritanceDiff(bb, aa) if diff < 0: if result != Invalid: result = Yes else: return No - elif diff != high(int): + elif diff != high(int) and sfFromGeneric notin (a.flags+b.flags): result = Invalid else: return No @@ -91,40 +103,45 @@ proc sameMethodBucket(a, b: PSym): MethodResult = return No if result == Yes: # check for return type: - if not sameTypeOrNil(a.typ.sons[0], b.typ.sons[0]): - if b.typ.sons[0] != nil and b.typ.sons[0].kind == tyExpr: + # 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.sons[0] = a.typ.sons[0] + b.typ.setReturnType a.typ.returnType else: return No proc attachDispatcher(s: PSym, dispatcher: PNode) = - var L = s.ast.len-1 - var x = s.ast.sons[L] - if x.kind == nkSym and sfDispatcher in x.sym.flags: + if dispatcherPos < s.ast.len: # we've added a dispatcher already, so overwrite it - s.ast.sons[L] = dispatcher + s.ast[dispatcherPos] = dispatcher else: - s.ast.add(dispatcher) + setLen(s.ast.sons, dispatcherPos+1) + if s.ast[resultPos] == nil: + s.ast[resultPos] = newNodeI(nkEmpty, s.info) + s.ast[dispatcherPos] = dispatcher -proc createDispatcher(s: PSym): PSym = - var disp = copySym(s) +proc createDispatcher(s: PSym; g: ModuleGraph; idgen: IdGenerator): PSym = + var disp = copySym(s, idgen) incl(disp.flags, sfDispatcher) excl(disp.flags, sfExported) - disp.typ = copyType(disp.typ, disp.typ.owner, false) + let old = disp.typ + 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 = ccDefault + if disp.typ.callConv == ccInline: disp.typ.callConv = ccNimCall disp.ast = copyTree(s.ast) - disp.ast.sons[bodyPos] = newNodeI(nkEmpty, s.info) - disp.loc.r = nil - if s.typ.sons[0] != nil: - if disp.ast.sonsLen > resultPos: - disp.ast.sons[resultPos].sym = copySym(s.ast.sons[resultPos].sym) + disp.ast[bodyPos] = newNodeI(nkEmpty, s.info) + disp.loc.snippet = "" + if s.typ.returnType != nil: + if disp.ast.len > resultPos: + 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 # be updated in fixupDispatcher(). - disp.ast.addSon(newNodeI(nkEmpty, s.info)) + disp.ast.add newNodeI(nkEmpty, s.info) attachDispatcher(s, newSymNode(disp)) # attach to itself to prevent bugs: attachDispatcher(disp, newSymNode(disp)) @@ -136,36 +153,26 @@ proc fixupDispatcher(meth, disp: PSym; conf: ConfigRef) = # from later definitions, particularly the resultPos slot. Also, # the lock level of the dispatcher needs to be updated/checked # against that of the method. - if disp.ast.sonsLen > resultPos and meth.ast.sonsLen > resultPos and - disp.ast.sons[resultPos].kind == nkEmpty: - disp.ast.sons[resultPos] = copyTree(meth.ast.sons[resultPos]) + if disp.ast.len > resultPos and meth.ast.len > resultPos and + 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 = 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") -proc methodDef*(g: ModuleGraph; s: PSym, fromCache: bool) = - let L = len(g.methods) - var witness: PSym - for i in countup(0, L - 1): + for i in 0..<g.methods.len: let disp = g.methods[i].dispatcher - case sameMethodBucket(disp, s) + case sameMethodBucket(disp, s, multimethods = optMultiMethods in g.config.globalOptions) of Yes: - add(g.methods[i].methods, s) - attachDispatcher(s, lastSon(disp.ast)) + g.methods[i].methods.add(s) + attachDispatcher(s, disp.ast[dispatcherPos]) fixupDispatcher(s, disp, g.config) #echo "fixup ", disp.name.s, " ", disp.id when useEffectSystem: checkMethodEffects(g, disp, s) @@ -178,44 +185,49 @@ proc methodDef*(g: ModuleGraph; s: PSym, fromCache: bool) = of Invalid: if witness.isNil: witness = g.methods[i].methods[0] # create a new dispatcher: - add(g.methods, (methods: @[s], dispatcher: createDispatcher(s))) + # 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 fromCache: - # internalError(s.info, "no method dispatcher found") if witness != nil: localError(g.config, s.info, "invalid declaration order; cannot attach '" & s.name.s & "' to method defined here: " & g.config$witness.info) elif sfBase notin s.flags: message(g.config, s.info, warnUseBase) -proc relevantCol(methods: TSymSeq, col: int): bool = +proc relevantCol*(methods: seq[PSym], col: int): bool = # returns true iff the position is relevant - var t = methods[0].typ.sons[col].skipTypes(skipPtrs) + result = false + var t = methods[0].typ[col].skipTypes(skipPtrs) if t.kind == tyObject: - for i in countup(1, high(methods)): - let t2 = skipTypes(methods[i].typ.sons[col], skipPtrs) + for i in 1..high(methods): + let t2 = skipTypes(methods[i].typ[col], skipPtrs) if not sameType(t2, t): return true proc cmpSignatures(a, b: PSym, relevantCols: IntSet): int = - for col in countup(1, sonsLen(a.typ) - 1): + result = 0 + for col in FirstParamAt..<a.typ.signatureLen: if contains(relevantCols, col): - var aa = skipTypes(a.typ.sons[col], skipPtrs) - var bb = skipTypes(b.typ.sons[col], skipPtrs) + var aa = skipTypes(a.typ[col], skipPtrs) + var bb = skipTypes(b.typ[col], skipPtrs) var d = inheritanceDiff(aa, bb) if (d != high(int)) and d != 0: return d -proc sortBucket(a: var TSymSeq, relevantCols: IntSet) = +proc sortBucket*(a: var seq[PSym], relevantCols: IntSet) = # we use shellsort here; fast and simple - var n = len(a) + var n = a.len var h = 1 while true: h = 3 * h + 1 if h > n: break while true: h = h div 3 - for i in countup(h, n - 1): + for i in h..<n: var v = a[i] var j = i while cmpSignatures(a[j - h], v, relevantCols) >= 0: @@ -225,70 +237,72 @@ proc sortBucket(a: var TSymSeq, relevantCols: IntSet) = a[j] = v if h == 1: break -proc genDispatcher(g: ModuleGraph; methods: TSymSeq, relevantCols: IntSet): PSym = - var base = lastSon(methods[0].ast).sym +proc genIfDispatcher*(g: ModuleGraph; methods: seq[PSym], relevantCols: IntSet; idgen: IdGenerator): PSym = + var base = methods[0].ast[dispatcherPos].sym result = base - var paramLen = sonsLen(base.typ) + var paramLen = base.typ.signatureLen var nilchecks = newNodeI(nkStmtList, base.info) var disp = newNodeI(nkIfStmt, base.info) - var ands = getSysSym(g, unknownLineInfo(), "and") - var iss = getSysSym(g, unknownLineInfo(), "of") - let boolType = getSysType(g, unknownLineInfo(), tyBool) - for col in countup(1, paramLen - 1): + var ands = getSysMagic(g, unknownLineInfo, "and", mAnd) + var iss = getSysMagic(g, unknownLineInfo, "of", mOf) + let boolType = getSysType(g, unknownLineInfo, tyBool) + for col in FirstParamAt..<paramLen: if contains(relevantCols, col): - let param = base.typ.n.sons[col].sym + let param = base.typ.n[col].sym if param.typ.skipTypes(abstractInst).kind in {tyRef, tyPtr}: - addSon(nilchecks, newTree(nkCall, - newSymNode(getCompilerProc(g, "chckNilDisp")), newSymNode(param))) - for meth in countup(0, high(methods)): + nilchecks.add newTree(nkCall, + newSymNode(getCompilerProc(g, "chckNilDisp")), newSymNode(param)) + for meth in 0..high(methods): var curr = methods[meth] # generate condition: var cond: PNode = nil - for col in countup(1, paramLen - 1): + for col in FirstParamAt..<paramLen: if contains(relevantCols, col): var isn = newNodeIT(nkCall, base.info, boolType) - addSon(isn, newSymNode(iss)) - let param = base.typ.n.sons[col].sym - addSon(isn, newSymNode(param)) - addSon(isn, newNodeIT(nkType, base.info, curr.typ.sons[col])) + isn.add newSymNode(iss) + let param = base.typ.n[col].sym + isn.add newSymNode(param) + isn.add newNodeIT(nkType, base.info, curr.typ[col]) if cond != nil: var a = newNodeIT(nkCall, base.info, boolType) - addSon(a, newSymNode(ands)) - addSon(a, cond) - addSon(a, isn) + a.add newSymNode(ands) + a.add cond + a.add isn cond = a else: cond = isn - let retTyp = base.typ.sons[0] + let retTyp = base.typ.returnType let call = newNodeIT(nkCall, base.info, retTyp) - addSon(call, newSymNode(curr)) - for col in countup(1, paramLen - 1): - addSon(call, genConv(newSymNode(base.typ.n.sons[col].sym), - curr.typ.sons[col], false, g.config)) + call.add newSymNode(curr) + for col in 1..<paramLen: + call.add genConv(newSymNode(base.typ.n[col].sym), + curr.typ[col], false, g.config) var ret: PNode if retTyp != nil: var a = newNodeI(nkFastAsgn, base.info) - addSon(a, newSymNode(base.ast.sons[resultPos].sym)) - addSon(a, call) + a.add newSymNode(base.ast[resultPos].sym) + a.add call ret = newNodeI(nkReturnStmt, base.info) - addSon(ret, a) + ret.add a else: ret = call if cond != nil: var a = newNodeI(nkElifBranch, base.info) - addSon(a, cond) - addSon(a, ret) - addSon(disp, a) + a.add cond + a.add ret + disp.add a else: disp = ret nilchecks.add disp - result.ast.sons[bodyPos] = nilchecks + nilchecks.flags.incl nfTransf # should not be further transformed + result.ast[bodyPos] = nilchecks -proc generateMethodDispatchers*(g: ModuleGraph): PNode = - result = newNode(nkStmtList) - for bucket in countup(0, len(g.methods) - 1): +proc generateIfMethodDispatchers*(g: ModuleGraph, idgen: IdGenerator) = + for bucket in 0..<g.methods.len: var relevantCols = initIntSet() - for col in countup(1, sonsLen(g.methods[bucket].methods[0].typ) - 1): + 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) - addSon(result, - 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 6fa856b2f..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. @@ -90,9 +86,6 @@ # :unrollFinally = true # goto nearestFinally (or -1 if not exists) # -# Every finally block calls closureIterEndFinally() upon its successful -# completion. -# # Example: # # try: @@ -107,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 @@ -120,30 +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 - intsets, strutils, options, ast, astalgo, trees, treetab, msgs, idents, - renderer, types, magicsys, lowerings, lambdalifting, modulegraphs, lineinfos + ast, msgs, idents, + renderer, magicsys, lowerings, lambdalifting, modulegraphs, lineinfos, + 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 +159,24 @@ type curExcHandlingState: int # Negative for except, positive for finally 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 } + procDefs + 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) @@ -174,12 +188,13 @@ proc newStateAssgn(ctx: var Ctx, toValue: PNode): PNode = proc newStateAssgn(ctx: var Ctx, stateNo: int = -2): PNode = # Creates state assignment: # :state = stateNo - ctx.newStateAssgn(newIntTypeNode(nkIntLit, stateNo, ctx.g.getSysType(TLineInfo(), tyInt))) + 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), 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) + 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 = @@ -210,7 +228,7 @@ proc newUnrollFinallyAccess(ctx: var Ctx, info: TLineInfo): PNode = proc newCurExcAccess(ctx: var Ctx): PNode = if ctx.curExcSym.isNil: - ctx.curExcSym = ctx.newEnvVar(":curExc", ctx.g.callCodegenProc("getCurrentException", ctx.g.emptyNode).typ) + ctx.curExcSym = ctx.newEnvVar(":curExc", ctx.g.callCodegenProc("getCurrentException").typ) ctx.newEnvVarAccess(ctx.curExcSym) proc newState(ctx: var Ctx, n, gotoOut: PNode): int = @@ -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: @@ -239,12 +254,29 @@ proc toStmtList(n: PNode): PNode = proc addGotoOut(n: PNode, gotoOut: PNode): PNode = # Make sure `n` is a stmtlist, and ends with `gotoOut` result = toStmtList(n) - if result.len != 0 and result.sons[^1].kind != nkGotoState: + 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 @@ -275,7 +308,7 @@ proc transformBreaksAndContinuesInWhile(ctx: var Ctx, n: PNode, before, after: P if ctx.blockLevel == 0: result = after else: - for i in 0 ..< n.len: + for i in 0..<n.len: n[i] = ctx.transformBreaksAndContinuesInWhile(n[i], before, after) proc transformBreaksInBlock(ctx: var Ctx, n: PNode, label, after: PNode): PNode = @@ -295,7 +328,7 @@ proc transformBreaksInBlock(ctx: var Ctx, n: PNode, label, after: PNode): PNode if label.kind == nkSym and n[0].sym == label.sym: result = after else: - for i in 0 ..< n.len: + for i in 0..<n.len: n[i] = ctx.transformBreaksInBlock(n[i], label, after) proc newNullifyCurExc(ctx: var Ctx, info: TLineInfo): PNode = @@ -319,12 +352,12 @@ proc collectExceptState(ctx: var Ctx, n: PNode): PNode {.inline.} = var ifBranch: PNode if c.len > 1: - var cond: PNode - for i in 0 .. c.len - 2: + var cond: PNode = nil + for i in 0..<c.len - 1: assert(c[i].kind == nkType) let nextCond = newTree(nkCall, newSymNode(g.getSysMagic(c.info, "of", mOf)), - g.callCodegenProc("getCurrentException", ctx.g.emptyNode), + g.callCodegenProc("getCurrentException"), c[i]) nextCond.typ = ctx.g.getSysType(c.info, tyBool) nextCond.info = c.info @@ -359,12 +392,12 @@ proc addElseToExcept(ctx: var Ctx, n: PNode) = block: # :unrollFinally = true branchBody.add(newTree(nkAsgn, ctx.newUnrollFinallyAccess(n.info), - newIntTypeNode(nkIntLit, 1, ctx.g.getSysType(n.info, tyBool)))) + newIntTypeNode(1, ctx.g.getSysType(n.info, tyBool)))) block: # :curExc = getCurrentException() branchBody.add(newTree(nkAsgn, ctx.newCurExcAccess(), - ctx.g.callCodegenProc("getCurrentException", ctx.g.emptyNode))) + ctx.g.callCodegenProc("getCurrentException"))) block: # goto nearestFinally branchBody.add(newTree(nkGotoState, ctx.g.newIntLit(n.info, ctx.nearestFinally))) @@ -382,42 +415,62 @@ 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 while n.kind == nkStmtListExpr: result.s.sons.add(n.sons) - result.s.sons.setLen(result.s.sons.len - 1) # delete last son + result.s.sons.setLen(result.s.len - 1) # delete last son n = n[^1] 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)) @@ -429,6 +482,16 @@ proc newNotCall(g: ModuleGraph; e: PNode): PNode = result = newTree(nkCall, newSymNode(g.getSysMagic(e.info, "not", mNot), e.info), e) result.typ = g.getSysType(e.info, tyBool) +proc boolLit(g: ModuleGraph; info: TLineInfo; value: bool): PNode = + result = newIntLit(g, info, ord value) + result.typ = getSysType(g, info, tyBool) + +proc captureVar(c: var Ctx, s: PSym) = + if c.varStates.getOrDefault(s.itemId) != localRequiresLifting: + c.varStates[s.itemId] = localRequiresLifting # Mark this variable for lifting + let e = getEnvParam(c.fn) + discard addField(e.typ.elementType, s, c.g.cache, c.idgen) + proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = result = n case n.kind @@ -437,7 +500,7 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = of nkYieldStmt: var ns = false - for i in 0 ..< n.len: + for i in 0..<n.len: n[i] = ctx.lowerStmtListExprs(n[i], ns) if ns: @@ -451,7 +514,7 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = of nkPar, nkObjConstr, nkTupleConstr, nkBracket: var ns = false - for i in 0 ..< n.len: + for i in 0..<n.len: n[i] = ctx.lowerStmtListExprs(n[i], ns) if ns: @@ -461,27 +524,33 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = if n.typ.isNil: internalError(ctx.g.config, "lowerStmtListExprs: constr typ.isNil") result.typ = n.typ - for i in 0 ..< n.len: - if n[i].kind == nkStmtListExpr: + for i in 0..<n.len: + case n[i].kind + of nkExprColonExpr: + if n[i][1].kind == nkStmtListExpr: + let (st, ex) = exprToStmtList(n[i][1]) + result.add(st) + n[i][1] = ex + of nkStmtListExpr: let (st, ex) = exprToStmtList(n[i]) result.add(st) n[i] = ex + else: discard result.add(n) of nkIfStmt, nkIfExpr: var ns = false - for i in 0 ..< n.len: + for i in 0..<n.len: n[i] = ctx.lowerStmtListExprs(n[i], ns) if ns: needsSplit = true - var tmp: PSym - var s: PNode + var tmp: PSym = nil let isExpr = not isEmptyType(n.typ) if isExpr: - tmp = ctx.newTempVar(n.typ) result = newNodeI(nkStmtListExpr, n.info) result.typ = n.typ + tmp = ctx.newTempVar(n.typ, result) else: result = newNodeI(nkStmtList, n.info) @@ -532,11 +601,15 @@ 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: + of nkTryStmt, nkHiddenTryStmt: var ns = false - for i in 0 ..< n.len: + for i in 0..<n.len: n[i] = ctx.lowerStmtListExprs(n[i], ns) if ns: @@ -546,10 +619,10 @@ 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: + for i in 1..<n.len: let branch = n[i] case branch.kind of nkExceptBranch: @@ -562,11 +635,14 @@ 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 - for i in 0 ..< n.len: + for i in 0..<n.len: n[i] = ctx.lowerStmtListExprs(n[i], ns) if ns: @@ -575,30 +651,39 @@ 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]) result.add(st) n[0] = ex - for i in 1 ..< n.len: + for i in 1..<n.len: let branch = n[i] case branch.kind of nkOfBranch: - branch[1] = ctx.convertExprBodyToAsgn(branch[1], tmp) + branch[^1] = ctx.convertExprBodyToAsgn(branch[^1], tmp) of nkElse: branch[0] = ctx.convertExprBodyToAsgn(branch[0], tmp) 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: + of nkCallKinds, nkChckRange, nkChckRangeF, nkChckRange64: var ns = false - for i in 0 ..< n.len: + for i in 0..<n.len: n[i] = ctx.lowerStmtListExprs(n[i], ns) if ns: @@ -618,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) @@ -631,23 +720,32 @@ 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: + for i in 0..<n.len: if n[i].kind == nkStmtListExpr: let (st, ex) = exprToStmtList(n[i]) result.add(st) 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) @@ -663,11 +761,17 @@ 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: var ns = false - for i in 0 ..< n.len: + for i in 0..<n.len: n[i] = ctx.lowerStmtListExprs(n[i], ns) if ns: @@ -678,23 +782,24 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = n[0] = ex result.add(n) - of nkCast, nkHiddenStdConv, nkHiddenSubConv, nkConv: + of nkCast, nkHiddenStdConv, nkHiddenSubConv, nkConv, nkObjDownConv, + nkDerefExpr, nkHiddenDeref: var ns = false - for i in 0 ..< n.len: + for i in ord(n.kind == nkCast)..<n.len: n[i] = ctx.lowerStmtListExprs(n[i], ns) if ns: needsSplit = true result = newNodeI(nkStmtListExpr, n.info) result.typ = n.typ - let (st, ex) = exprToStmtList(n[1]) + let (st, ex) = exprToStmtList(n[^1]) result.add(st) - n[1] = ex + n[^1] = ex result.add(n) - of nkAsgn, nkFastAsgn: + of nkAsgn, nkFastAsgn, nkSinkAsgn: var ns = false - for i in 0 ..< n.len: + for i in 0..<n.len: n[i] = ctx.lowerStmtListExprs(n[i], ns) if ns: @@ -712,9 +817,26 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = result.add(n) - of nkWhileStmt: - var ns = false + of nkBracketExpr: + var lhsNeedsSplit = false + var rhsNeedsSplit = false + n[0] = ctx.lowerStmtListExprs(n[0], lhsNeedsSplit) + n[1] = ctx.lowerStmtListExprs(n[1], rhsNeedsSplit) + if lhsNeedsSplit or rhsNeedsSplit: + needsSplit = true + result = newNodeI(nkStmtListExpr, n.info) + if lhsNeedsSplit: + let (st, ex) = exprToStmtList(n[0]) + result.add(st) + n[0] = ex + if rhsNeedsSplit: + let (st, ex) = exprToStmtList(n[1]) + result.add(st) + n[1] = ex + result.add(n) + + of nkWhileStmt: var condNeedsSplit = false n[0] = ctx.lowerStmtListExprs(n[0], condNeedsSplit) var bodyNeedsSplit = false @@ -730,10 +852,10 @@ 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: + of nkDotExpr, nkCheckedFieldExpr: var ns = false n[0] = ctx.lowerStmtListExprs(n[0], ns) if ns: @@ -753,21 +875,24 @@ proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = result = newNodeI(nkStmtListExpr, n.info) result.typ = n.typ let (st, ex) = exprToStmtList(n[1]) - n.kind = nkBlockStmt + n.transitionSonsKind(nkBlockStmt) n.typ = nil n[1] = st result.add(n) result.add(ex) else: - for i in 0 ..< n.len: + for i in 0..<n.len: n[i] = ctx.lowerStmtListExprs(n[i], needsSplit) 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() @@ -776,17 +901,27 @@ 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), 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) - # The C++ backend requires `getCurrentException` here. - let raiseStmt = newTree(nkRaiseStmt, ctx.g.callCodegenProc("getCurrentException", ctx.g.emptyNode)) + let nullifyExc = newTree(nkCall, newSymNode(ctx.g.getCompilerProc("closureIterSetupExc")), nilnode) + nullifyExc.info = info + let raiseStmt = newTree(nkRaiseStmt, curExc) raiseStmt.info = info - let elseBranch = newTree(nkElse, raiseStmt) + let elseBranch = newTree(nkElse, newTree(nkStmtList, nullifyExc, raiseStmt)) let ifBody = newTree(nkIfStmt, branch, elseBranch) let elifBranch = newTree(nkElifBranch, ctx.newUnrollFinallyAccess(info), ifBody) @@ -799,20 +934,23 @@ 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) block: # :unrollFinally = true let asgn = newNodeI(nkAsgn, n.info) asgn.add(ctx.newUnrollFinallyAccess(n.info)) - asgn.add(newIntTypeNode(nkIntLit, 1, ctx.g.getSysType(n.info, tyBool))) + asgn.add(newIntTypeNode(1, ctx.g.getSysType(n.info, tyBool))) result.add(asgn) if n[0].kind != nkEmpty: let asgnTmpResult = newNodeI(nkAsgn, n.info) asgnTmpResult.add(ctx.newTmpResultAccess()) - asgnTmpResult.add(n[0]) + let x = if n[0].kind in {nkAsgn, nkFastAsgn, nkSinkAsgn}: n[0][1] else: n[0] + asgnTmpResult.add(x) result.add(asgnTmpResult) result.add(ctx.newNullifyCurExc(n.info)) @@ -822,175 +960,174 @@ 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: + for i in 0..<n.len: n[i] = ctx.transformReturnsInTry(n[i]) proc transformClosureIteratorBody(ctx: var Ctx, n: PNode, gotoOut: PNode): PNode = result = n - case n.kind: - of nkSkip: - discard + case n.kind + of nkSkip: discard - of nkStmtList, nkStmtListExpr: - assert(isEmptyType(n.typ), "nkStmtListExpr not lowered") + of nkStmtList, nkStmtListExpr: + result = addGotoOut(result, gotoOut) + for i in 0..<n.len: + if n[i].hasYields: + # Create a new split + let go = newNodeI(nkGotoState, n[i].info) + n[i] = ctx.transformClosureIteratorBody(n[i], go) + + let s = newNodeI(nkStmtList, n[i + 1].info) + for j in i + 1..<n.len: + s.add(n[j]) + + n.sons.setLen(i + 1) + discard ctx.newState(s, go) + if ctx.transformClosureIteratorBody(s, gotoOut) != s: + internalError(ctx.g.config, "transformClosureIteratorBody != s") + break - result = addGotoOut(result, gotoOut) - for i in 0 ..< n.len: - if n[i].hasYieldsInExpressions: - # Lower nkStmtListExpr nodes inside `n[i]` first - var ns = false - n[i] = ctx.lowerStmtListExprs(n[i], ns) + of nkYieldStmt: + result = newNodeI(nkStmtList, n.info) + result.add(n) + result.add(gotoOut) - if n[i].hasYields: - # Create a new split - let go = newNodeI(nkGotoState, n[i].info) - n[i] = ctx.transformClosureIteratorBody(n[i], go) + of nkElse, nkElseExpr: + result[0] = addGotoOut(result[0], gotoOut) + result[0] = ctx.transformClosureIteratorBody(result[0], gotoOut) - let s = newNodeI(nkStmtList, n[i + 1].info) - for j in i + 1 ..< n.len: - s.add(n[j]) + of nkElifBranch, nkElifExpr, nkOfBranch: + result[^1] = addGotoOut(result[^1], gotoOut) + result[^1] = ctx.transformClosureIteratorBody(result[^1], gotoOut) - n.sons.setLen(i + 1) - discard ctx.newState(s, go) - if ctx.transformClosureIteratorBody(s, gotoOut) != s: - internalError(ctx.g.config, "transformClosureIteratorBody != s") - break + of nkIfStmt, nkCaseStmt: + for i in 0..<n.len: + n[i] = ctx.transformClosureIteratorBody(n[i], gotoOut) + if n[^1].kind != nkElse: + # We don't have an else branch, but every possible branch has to end with + # gotoOut, so add else here. + let elseBranch = newTree(nkElse, gotoOut) + n.add(elseBranch) - of nkYieldStmt: - result = newNodeI(nkStmtList, n.info) - result.add(n) - result.add(gotoOut) - - of nkElse, nkElseExpr: - result[0] = addGotoOut(result[0], gotoOut) - result[0] = ctx.transformClosureIteratorBody(result[0], gotoOut) - - of nkElifBranch, nkElifExpr, nkOfBranch: - result[^1] = addGotoOut(result[^1], gotoOut) - result[^1] = ctx.transformClosureIteratorBody(result[^1], gotoOut) - - of nkIfStmt, nkCaseStmt: - for i in 0 ..< n.len: - n[i] = ctx.transformClosureIteratorBody(n[i], gotoOut) - if n[^1].kind != nkElse: - # We don't have an else branch, but every possible branch has to end with - # gotoOut, so add else here. - let elseBranch = newTree(nkElse, gotoOut) - n.add(elseBranch) - - of nkWhileStmt: - # while e: - # s - # -> - # BEGIN_STATE: - # if e: - # s - # goto BEGIN_STATE - # else: - # goto OUT - - result = newNodeI(nkGotoState, n.info) - - let s = newNodeI(nkStmtList, n.info) - discard ctx.newState(s, result) - let ifNode = newNodeI(nkIfStmt, n.info) - let elifBranch = newNodeI(nkElifBranch, n.info) - elifBranch.add(n[0]) - - var body = addGotoOut(n[1], result) - - body = ctx.transformBreaksAndContinuesInWhile(body, result, gotoOut) - body = ctx.transformClosureIteratorBody(body, result) - - elifBranch.add(body) - ifNode.add(elifBranch) + of nkWhileStmt: + # while e: + # s + # -> + # BEGIN_STATE: + # if e: + # s + # goto BEGIN_STATE + # else: + # goto OUT - let elseBranch = newTree(nkElse, gotoOut) - ifNode.add(elseBranch) - s.add(ifNode) - - of nkBlockStmt: - result[1] = addGotoOut(result[1], gotoOut) - result[1] = ctx.transformBreaksInBlock(result[1], result[0], gotoOut) - result[1] = ctx.transformClosureIteratorBody(result[1], gotoOut) - - of nkTryStmt: - # See explanation above about how this works - ctx.hasExceptions = true - - result = newNodeI(nkGotoState, n.info) - var tryBody = toStmtList(n[0]) - var exceptBody = ctx.collectExceptState(n) - var finallyBody = newTree(nkStmtList, getFinallyNode(ctx, n)) - finallyBody = ctx.transformReturnsInTry(finallyBody) - finallyBody.add(ctx.newEndFinallyNode(finallyBody.info)) - - # The following index calculation is based on the knowledge how state - # indexes are assigned - let tryIdx = ctx.states.len - var exceptIdx, finallyIdx: int - if exceptBody.kind != nkEmpty: - exceptIdx = -(tryIdx + 1) - finallyIdx = tryIdx + 2 - else: - exceptIdx = tryIdx + 1 - finallyIdx = tryIdx + 1 + result = newNodeI(nkGotoState, n.info) - let outToFinally = newNodeI(nkGotoState, finallyBody.info) + let s = newNodeI(nkStmtList, n.info) + discard ctx.newState(s, result) + let ifNode = newNodeI(nkIfStmt, n.info) + let elifBranch = newNodeI(nkElifBranch, n.info) + elifBranch.add(n[0]) - block: # Create initial states. - let oldExcHandlingState = ctx.curExcHandlingState - ctx.curExcHandlingState = exceptIdx - let realTryIdx = ctx.newState(tryBody, result) - assert(realTryIdx == tryIdx) + var body = addGotoOut(n[1], result) - if exceptBody.kind != nkEmpty: - ctx.curExcHandlingState = finallyIdx - let realExceptIdx = ctx.newState(exceptBody, nil) - assert(realExceptIdx == -exceptIdx) + body = ctx.transformBreaksAndContinuesInWhile(body, result, gotoOut) + body = ctx.transformClosureIteratorBody(body, result) - ctx.curExcHandlingState = oldExcHandlingState - let realFinallyIdx = ctx.newState(finallyBody, outToFinally) - assert(realFinallyIdx == finallyIdx) + elifBranch.add(body) + ifNode.add(elifBranch) - block: # Subdivide the states - let oldNearestFinally = ctx.nearestFinally - ctx.nearestFinally = finallyIdx + let elseBranch = newTree(nkElse, gotoOut) + ifNode.add(elseBranch) + s.add(ifNode) - let oldExcHandlingState = ctx.curExcHandlingState + of nkBlockStmt: + result[1] = addGotoOut(result[1], gotoOut) + result[1] = ctx.transformBreaksInBlock(result[1], result[0], gotoOut) + result[1] = ctx.transformClosureIteratorBody(result[1], gotoOut) + + of nkTryStmt, nkHiddenTryStmt: + # See explanation above about how this works + ctx.hasExceptions = true + + result = newNodeI(nkGotoState, n.info) + var tryBody = toStmtList(n[0]) + var exceptBody = ctx.collectExceptState(n) + var finallyBody = newTree(nkStmtList, getFinallyNode(ctx, n)) + finallyBody = ctx.transformReturnsInTry(finallyBody) + finallyBody.add(ctx.newEndFinallyNode(finallyBody.info)) + + # The following index calculation is based on the knowledge how state + # indexes are assigned + let tryIdx = ctx.states.len + var exceptIdx, finallyIdx: int + if exceptBody.kind != nkEmpty: + exceptIdx = -(tryIdx + 1) + finallyIdx = tryIdx + 2 + else: + exceptIdx = tryIdx + 1 + finallyIdx = tryIdx + 1 - ctx.curExcHandlingState = exceptIdx + let outToFinally = newNodeI(nkGotoState, finallyBody.info) - if ctx.transformReturnsInTry(tryBody) != tryBody: - internalError(ctx.g.config, "transformReturnsInTry != tryBody") - if ctx.transformClosureIteratorBody(tryBody, outToFinally) != tryBody: - internalError(ctx.g.config, "transformClosureIteratorBody != tryBody") + block: # Create initial states. + let oldExcHandlingState = ctx.curExcHandlingState + ctx.curExcHandlingState = exceptIdx + let realTryIdx = ctx.newState(tryBody, result) + assert(realTryIdx == tryIdx) + if exceptBody.kind != nkEmpty: ctx.curExcHandlingState = finallyIdx - ctx.addElseToExcept(exceptBody) - if ctx.transformReturnsInTry(exceptBody) != exceptBody: - internalError(ctx.g.config, "transformReturnsInTry != exceptBody") - if ctx.transformClosureIteratorBody(exceptBody, outToFinally) != exceptBody: - internalError(ctx.g.config, "transformClosureIteratorBody != exceptBody") + let realExceptIdx = ctx.newState(exceptBody, nil) + assert(realExceptIdx == -exceptIdx) - ctx.curExcHandlingState = oldExcHandlingState - ctx.nearestFinally = oldNearestFinally - if ctx.transformClosureIteratorBody(finallyBody, gotoOut) != finallyBody: - internalError(ctx.g.config, "transformClosureIteratorBody != finallyBody") + ctx.curExcHandlingState = oldExcHandlingState + let realFinallyIdx = ctx.newState(finallyBody, outToFinally) + assert(realFinallyIdx == finallyIdx) - of nkGotoState, nkForStmt: - internalError(ctx.g.config, "closure iter " & $n.kind) + block: # Subdivide the states + let oldNearestFinally = ctx.nearestFinally + ctx.nearestFinally = finallyIdx - else: - for i in 0 ..< n.len: - n[i] = ctx.transformClosureIteratorBody(n[i], gotoOut) + let oldExcHandlingState = ctx.curExcHandlingState + + ctx.curExcHandlingState = exceptIdx + + if ctx.transformReturnsInTry(tryBody) != tryBody: + internalError(ctx.g.config, "transformReturnsInTry != tryBody") + if ctx.transformClosureIteratorBody(tryBody, outToFinally) != tryBody: + internalError(ctx.g.config, "transformClosureIteratorBody != tryBody") + + ctx.curExcHandlingState = finallyIdx + ctx.addElseToExcept(exceptBody) + if ctx.transformReturnsInTry(exceptBody) != exceptBody: + internalError(ctx.g.config, "transformReturnsInTry != exceptBody") + if ctx.transformClosureIteratorBody(exceptBody, outToFinally) != exceptBody: + internalError(ctx.g.config, "transformClosureIteratorBody != exceptBody") + + ctx.curExcHandlingState = oldExcHandlingState + ctx.nearestFinally = oldNearestFinally + if ctx.transformClosureIteratorBody(finallyBody, gotoOut) != finallyBody: + internalError(ctx.g.config, "transformClosureIteratorBody != finallyBody") + + of nkGotoState, nkForStmt: + internalError(ctx.g.config, "closure iter " & $n.kind) + + else: + for i in 0..<n.len: + n[i] = ctx.transformClosureIteratorBody(n[i], gotoOut) proc stateFromGotoState(n: PNode): int = assert(n.kind == nkGotoState) result = n[0].intVal.int -proc tranformStateAssignments(ctx: var Ctx, n: PNode): PNode = +proc transformStateAssignments(ctx: var Ctx, n: PNode): PNode = # This transforms 3 patterns: ########################## 1 # yield e @@ -1020,19 +1157,19 @@ proc tranformStateAssignments(ctx: var Ctx, n: PNode): PNode = result.add(ctx.newStateAssgn(stateFromGotoState(n[1]))) var retStmt = newNodeI(nkReturnStmt, n.info) - if n[0].sons[0].kind != nkEmpty: - var a = newNodeI(nkAsgn, n[0].sons[0].info) - var retVal = n[0].sons[0] #liftCapturedVars(n.sons[0], owner, d, c) - addSon(a, newSymNode(getClosureIterResult(ctx.g, ctx.fn))) - addSon(a, retVal) + if n[0][0].kind != nkEmpty: + var a = newNodeI(nkAsgn, n[0][0].info) + var retVal = n[0][0] #liftCapturedVars(n[0], owner, d, c) + a.add newSymNode(getClosureIterResult(ctx.g, ctx.fn, ctx.idgen)) + a.add retVal retStmt.add(a) else: retStmt.add(ctx.g.emptyNode) result.add(retStmt) else: - for i in 0 ..< n.len: - n[i] = ctx.tranformStateAssignments(n[i]) + for i in 0..<n.len: + n[i] = ctx.transformStateAssignments(n[i]) of nkSkip: discard @@ -1051,8 +1188,8 @@ proc tranformStateAssignments(ctx: var Ctx, n: PNode): PNode = result.add(breakState) else: - for i in 0 ..< n.len: - n[i] = ctx.tranformStateAssignments(n[i]) + for i in 0..<n.len: + n[i] = ctx.transformStateAssignments(n[i]) proc skipStmtList(ctx: Ctx; n: PNode): PNode = result = n @@ -1069,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 @@ -1081,9 +1218,9 @@ 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 = +proc skipThroughEmptyStates(ctx: var Ctx, n: PNode): PNode= result = n case n.kind of nkSkip: @@ -1092,14 +1229,14 @@ proc skipThroughEmptyStates(ctx: var Ctx, n: PNode): PNode = result = copyTree(n) result[0].intVal = ctx.skipEmptyStates(result[0].intVal.int) else: - for i in 0 ..< n.len: + for i in 0..<n.len: n[i] = ctx.skipThroughEmptyStates(n[i]) -proc newArrayType(g: ModuleGraph; n: int, t: PType, owner: PSym): PType = - result = newType(tyArray, owner) +proc newArrayType(g: ModuleGraph; n: int, t: PType; idgen: IdGenerator; owner: PSym): PType = + result = newType(tyArray, idgen, owner) - let rng = newType(tyRange, 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) @@ -1107,7 +1244,7 @@ proc newArrayType(g: ModuleGraph; n: int, t: PType, owner: PSym): PType = proc createExceptionTable(ctx: var Ctx): PNode {.inline.} = result = newNodeI(nkBracket, ctx.fn.info) - result.typ = ctx.g.newArrayType(ctx.exceptionTable.len, ctx.g.getSysType(ctx.fn.info, tyInt16), ctx.fn) + result.typ = ctx.g.newArrayType(ctx.exceptionTable.len, ctx.g.getSysType(ctx.fn.info, tyInt16), ctx.idgen, ctx.fn) for i in ctx.exceptionTable: let elem = newIntNode(nkIntLit, i) @@ -1130,7 +1267,6 @@ proc newCatchBody(ctx: var Ctx, info: TLineInfo): PNode {.inline.} = # :state = exceptionTable[:state] block: - # exceptionTable[:state] let getNextState = newTree(nkBracketExpr, ctx.createExceptionTable(), @@ -1145,7 +1281,7 @@ proc newCatchBody(ctx: var Ctx, info: TLineInfo): PNode {.inline.} = let cond = newTree(nkCall, ctx.g.getSysMagic(info, "==", mEqI).newSymNode(), ctx.newStateAccess(), - newIntTypeNode(nkIntLit, 0, intTyp)) + newIntTypeNode(0, intTyp)) cond.typ = boolTyp let raiseStmt = newTree(nkRaiseStmt, ctx.g.emptyNode) @@ -1157,7 +1293,7 @@ proc newCatchBody(ctx: var Ctx, info: TLineInfo): PNode {.inline.} = block: let cond = newTree(nkCall, ctx.g.getSysMagic(info, "<", mLtI).newSymNode, - newIntTypeNode(nkIntLit, 0, intTyp), + newIntTypeNode(0, intTyp), ctx.newStateAccess()) cond.typ = boolTyp @@ -1169,7 +1305,7 @@ proc newCatchBody(ctx: var Ctx, info: TLineInfo): PNode {.inline.} = let cond = newTree(nkCall, ctx.g.getSysMagic(info, "<", mLtI).newSymNode, ctx.newStateAccess(), - newIntTypeNode(nkIntLit, 0, intTyp)) + newIntTypeNode(0, intTyp)) cond.typ = boolTyp let negateState = newTree(nkCall, @@ -1185,7 +1321,7 @@ proc newCatchBody(ctx: var Ctx, info: TLineInfo): PNode {.inline.} = block: result.add(newTree(nkAsgn, ctx.newCurExcAccess(), - ctx.g.callCodegenProc("getCurrentException", ctx.g.emptyNode))) + ctx.g.callCodegenProc("getCurrentException"))) proc wrapIntoTryExcept(ctx: var Ctx, n: PNode): PNode {.inline.} = let setupExc = newTree(nkCall, @@ -1200,28 +1336,25 @@ 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) if not ctx.stateVarSym.isNil: let varSect = newNodeI(nkVarSection, n.info) addVar(varSect, newSymNode(ctx.stateVarSym)) - loopBody.add(varSect) + localVars.add(varSect) if not ctx.tempVars.isNil: - loopBody.add(ctx.tempVars) + localVars.add(ctx.tempVars) 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, n) + var blockBody = newTree(nkStmtList, localVars, n) if ctx.hasExceptions: blockBody = ctx.wrapIntoTryExcept(blockBody) @@ -1234,73 +1367,252 @@ 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: inc i -proc transformClosureIterator*(g: ModuleGraph; fn: PSym, n: PNode): PNode = - var ctx: Ctx - ctx.g = g - ctx.fn = fn +type + PreprocessContext = object + finallys: seq[PNode] + config: ConfigRef + blocks: seq[(PNode, int)] + idgen: IdGenerator + FreshVarsContext = object + tab: Table[int, PSym] + config: ConfigRef + info: TLineInfo + idgen: IdGenerator + +proc freshVars(n: PNode; c: var FreshVarsContext): PNode = + case n.kind + of nkSym: + let x = c.tab.getOrDefault(n.sym.id) + if x == nil: + result = n + else: + result = newSymNode(x, n.info) + of nkSkip - {nkSym}: + result = n + of nkLetSection, nkVarSection: + result = copyNode(n) + for it in n: + if it.kind in {nkIdentDefs, nkVarTuple}: + let idefs = copyNode(it) + for v in 0..it.len-3: + if it[v].kind == nkSym: + let x = copySym(it[v].sym, c.idgen) + c.tab[it[v].sym.id] = x + idefs.add newSymNode(x) + else: + idefs.add it[v] - if getEnvParam(fn).isNil: - # Lambda lifting was not done yet. Use temporary :state sym, which - # be handled specially by lambda lifting. Local temp vars (if needed) - # should folllow the same logic. - ctx.stateVarSym = newSym(skVar, getIdent(ctx.g.cache, ":state"), fn, fn.info) - ctx.stateVarSym.typ = g.createClosureIterStateType(fn) + for rest in it.len-2 ..< it.len: idefs.add it[rest] + result.add idefs + 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 + for i in 0..<n.safeLen: + result[i] = freshVars(n[i], c) + +proc preprocess(c: var PreprocessContext; n: PNode): PNode = + # in order to fix bug #15243 without risking regressions, we preprocess + # the AST so that 'break' statements inside a 'try finally' also have the + # finally section. We need to duplicate local variables here and also + # 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. - ctx.stateLoopLabel = newSym(skLabel, getIdent(ctx.g.cache, ":stateLoop"), fn, fn.info) - let n = n.toStmtList + 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 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]) + discard c.blocks.pop() + + of nkBreakStmt: + if c.blocks.len == 0: + discard + else: + var fin = -1 + if n[0].kind == nkEmpty: + fin = c.blocks[^1][1] + elif n[0].kind == nkSym: + for i in countdown(c.blocks.high, 0): + if c.blocks[i][0].kind == nkBlockStmt and c.blocks[i][0][0].kind == nkSym and + c.blocks[i][0][0].sym == n[0].sym: + fin = c.blocks[i][1] + break + + if fin >= 0: + 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(copyTree(c.finallys[i]), vars) + c.idgen = vars.idgen + result.add n + of nkSkip: discard + else: + 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(g: g, fn: fn, idgen: idgen, + # should be default when issues are fixed, see #24094: + nimOptItersEnabled: isDefined(g.config, "nimOptIters")) + + if getEnvParam(fn).isNil: + 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 + #var n = n.toStmtList discard ctx.newState(n, nil) let gotoOut = newTree(nkGotoState, g.newIntLit(n.info, -1)) + var ns = false + n = ctx.lowerStmtListExprs(n, ns) + + if n.hasYieldsInExpressions(): + internalError(ctx.g.config, "yield in expr not lowered") + # Splitting transformation discard ctx.transformClosureIteratorBody(n, gotoOut) # Optimize empty states away ctx.deleteEmptyStates() - # Make new body by concating 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.tranformStateAssignments(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 new file mode 100644 index 000000000..e51248639 --- /dev/null +++ b/compiler/cmdlinehelper.nim @@ -0,0 +1,85 @@ +# +# +# The Nim Compiler +# (c) Copyright 2018 Nim contributors +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Helpers for binaries that use compiler passes, e.g.: nim, nimsuggest + +import + options, idents, nimconf, extccomp, commands, msgs, + lineinfos, modulegraphs, condsyms, pathutils + +import std/[os, parseopt] + +proc prependCurDir*(f: AbsoluteFile): AbsoluteFile = + when defined(unix): + if os.isAbsolute(f.string): result = f + else: result = AbsoluteFile("./" & f.string) + else: + result = f + +proc addCmdPrefix*(result: var string, kind: CmdLineKind) = + # consider moving this to std/parseopt + case kind + of cmdLongOption: result.add "--" + of cmdShortOption: result.add "-" + of cmdArgument, cmdEnd: discard + +type + NimProg* = ref object + suggestMode*: bool + supportsStdinFile*: bool + processCmdLine*: proc(pass: TCmdLinePass, cmd: string; config: ConfigRef) + +proc initDefinesProg*(self: NimProg, conf: ConfigRef, name: string) = + condsyms.initDefines(conf.symbols) + defineSymbol conf.symbols, name + +proc processCmdLineAndProjectPath*(self: NimProg, conf: ConfigRef) = + self.processCmdLine(passCmd1, "", conf) + if conf.projectIsCmd and conf.projectName in ["-", ""]: + handleCmdInput(conf) + elif self.supportsStdinFile and conf.projectName == "-": + handleStdinInput(conf) + elif conf.projectName != "": + setFromProjectName(conf, conf.projectName) + else: + conf.projectPath = AbsoluteDir canonicalizePath(conf, AbsoluteFile getCurrentDir()) + +proc loadConfigsAndProcessCmdLine*(self: NimProg, cache: IdentCache; conf: ConfigRef; + graph: ModuleGraph): bool = + if self.suggestMode: + conf.setCmd cmdIdeTools + 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") + # 'nim foo.nims' means to just run the NimScript file and do nothing more: + if fileExists(scriptFile) and scriptFile == conf.projectFull: + if conf.cmd == cmdNone: conf.setCmd cmdNimscript + 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 + if conf.backend != backendJs: # bug #19059 + extccomp.initVars(conf) + self.processCmdLine(passCmd2, "", conf) + if conf.cmd == cmdNone: + rawMessage(conf, errGenerated, "command missing") + + graph.suggestMode = self.suggestMode + return true + +proc loadConfigsAndRunMainCommand*(self: NimProg, cache: IdentCache; conf: ConfigRef; graph: ModuleGraph): bool = + ## Alias for loadConfigsAndProcessCmdLine, here for backwards compatibility + loadConfigsAndProcessCmdLine(self, cache, conf, graph) diff --git a/compiler/commands.nim b/compiler/commands.nim index 330504a76..cbf915ca6 100644 --- a/compiler/commands.nim +++ b/compiler/commands.nim @@ -9,31 +9,36 @@ # 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.gcGenerational' etc. +# confused with 'TGCMode.gcMarkAndSweep' etc. template bootSwitch(name, expr, userString) = # Helper to build boot constants, for debugging you can 'echo' the else part. const name = if expr: " " & userString else: "" bootSwitch(usedRelease, defined(release), "-d:release") -bootSwitch(usedGnuReadline, defined(useLinenoise), "-d:useLinenoise") +bootSwitch(usedDanger, defined(danger), "-d:danger") +# `useLinenoise` deprecated in favor of `nimUseLinenoise`, kept for backward compatibility +bootSwitch(useLinenoise, defined(nimUseLinenoise) or defined(useLinenoise), "-d:nimUseLinenoise") bootSwitch(usedBoehm, defined(boehmgc), "--gc:boehm") bootSwitch(usedMarkAndSweep, defined(gcmarkandsweep), "--gc:markAndSweep") -bootSwitch(usedGenerational, defined(gcgenerational), "--gc:generational") 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, idents, parseopt, sequtils, lineinfos + msgs, options, nversion, condsyms, extccomp, platform, + wordrecg, nimblecmd, lineinfos, pathutils + +import std/pathnorm + +from ast import setUseIc, 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:useFFI") +bootSwitch(usedFFI, hasFFI, "-d:nimHasLibFFI") type TCmdLinePass* = enum @@ -46,15 +51,15 @@ const "Compiled at $4\n" & "Copyright (c) 2006-" & copyrightYear & " by Andreas Rumpf\n" +proc genFeatureDesc[T: enum](t: typedesc[T]): string {.compileTime.} = + result = "" + for f in T: + if result.len > 0: result.add "|" + result.add $f + const - Usage = slurp"../doc/basicopt.txt".replace("//", "") - FeatureDesc = block: - var x = "" - for f in low(Feature)..high(Feature): - if x.len > 0: x.add "|" - x.add $f - x - AdvancedUsage = slurp"../doc/advopt.txt".replace("//", "") % FeatureDesc + Usage = slurp"../doc/basicopt.txt".replace(" //", " ") + AdvancedUsage = slurp"../doc/advopt.txt".replace(" //", " ") % [genFeatureDesc(Feature), genFeatureDesc(LegacyFeature)] proc getCommandLineDesc(conf: ConfigRef): string = result = (HelpMessage % [VersionAsString, platform.OS[conf.target.hostOS].name, @@ -91,29 +96,29 @@ proc writeVersionInfo(conf: ConfigRef; pass: TCmdLinePass) = CPU[conf.target.hostCPU].name, CompileDate]), {msgStdout}) - const gitHash = gorge("git log -n 1 --format=%H").strip + const gitHash {.strdefine.} = gorge("git log -n 1 --format=%H").strip + # xxx move this logic to std/private/gitutils when gitHash.len == 40: msgWriteln(conf, "git hash: " & gitHash, {msgStdout}) - msgWriteln(conf, "active boot switches:" & usedRelease & - usedTinyC & usedGnuReadline & usedNativeStacktrace & - usedFFI & usedBoehm & usedMarkAndSweep & usedGenerational & usedGoGC & usedNoGC, + msgWriteln(conf, "active boot switches:" & usedRelease & usedDanger & + usedTinyC & useLinenoise & + usedFFI & usedBoehm & usedMarkAndSweep & usedGoGC & usedNoGC, {msgStdout}) msgQuit(0) -proc writeCommandLineUsage*(conf: ConfigRef; helpWritten: var bool) = - if not helpWritten: - msgWriteln(conf, getCommandLineDesc(conf), {msgStdout}) - helpWritten = true +proc writeCommandLineUsage*(conf: ConfigRef) = + msgWriteln(conf, getCommandLineDesc(conf), {msgStdout}) proc addPrefix(switch: string): string = - if len(switch) == 1: result = "-" & switch + if switch.len <= 1: result = "-" & switch else: result = "--" & switch 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', 'error' or 'usages' expected, but '$1' found" proc invalidCmdLineOption(conf: ConfigRef; pass: TCmdLinePass, switch: string, info: TLineInfo) = if switch == " ": localError(conf, info, errInvalidCmdLineOption % "-") @@ -123,38 +128,50 @@ proc splitSwitch(conf: ConfigRef; switch: string, cmd, arg: var string, pass: TC info: TLineInfo) = cmd = "" var i = 0 - if i < len(switch) and switch[i] == '-': inc(i) - if i < len(switch) and switch[i] == '-': inc(i) - while i < len(switch): + if i < switch.len and switch[i] == '-': inc(i) + if i < switch.len and switch[i] == '-': inc(i) + while i < switch.len: case switch[i] - of 'a'..'z', 'A'..'Z', '0'..'9', '_', '.': add(cmd, switch[i]) + of 'a'..'z', 'A'..'Z', '0'..'9', '_', '.': cmd.add(switch[i]) else: break inc(i) - if i >= len(switch): arg = "" - elif switch[i] in {':', '=', '['}: arg = substr(switch, i + 1) + if i >= switch.len: arg = "" + # cmd:arg => (cmd,arg) + elif switch[i] in {':', '='}: arg = substr(switch, i + 1) + # cmd[sub]:rest => (cmd,[sub]:rest) + 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 = conf.options + op - of "off": conf.options = conf.options - op + of "", "on": conf.options.incl op + of "off": conf.options.excl op else: localError(conf, info, errOnOrOffExpectedButXFound % arg) proc processOnOffSwitchOrList(conf: ConfigRef; op: TOptions, arg: string, pass: TCmdLinePass, info: TLineInfo): bool = result = false case arg.normalize - of "on": conf.options = conf.options + op - of "off": conf.options = conf.options - op + of "on": conf.options.incl op + of "off": conf.options.excl op of "list": result = true else: localError(conf, info, errOnOffOrListExpectedButXFound % arg) proc processOnOffSwitchG(conf: ConfigRef; op: TGlobalOptions, arg: string, pass: TCmdLinePass, info: TLineInfo) = case arg.normalize - of "on": conf.globalOptions = conf.globalOptions + op - of "off": conf.globalOptions = conf.globalOptions - op + of "", "on": conf.globalOptions.incl op + of "off": conf.globalOptions.excl op else: localError(conf, info, errOnOrOffExpectedButXFound % arg) proc expectArg(conf: ConfigRef; switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = @@ -167,78 +184,135 @@ proc expectNoArg(conf: ConfigRef; switch, arg: string, pass: TCmdLinePass, info: proc processSpecificNote*(arg: string, state: TSpecialWord, pass: TCmdLinePass, info: TLineInfo; orig: string; conf: ConfigRef) = - var id = "" # arg = "X]:on|off" + var id = "" # arg = key or [key] or key:val or [key]:val; with val=on|off var i = 0 - var n = hintMin - while i < len(arg) and (arg[i] != ']'): - add(id, arg[i]) + var notes: set[TMsgKind] = {} + var isBracket = false + if i < arg.len and arg[i] == '[': + isBracket = true inc(i) - if i < len(arg) and (arg[i] == ']'): inc(i) - else: invalidCmdLineOption(conf, pass, orig, info) - if i < len(arg) and (arg[i] in {':', '='}): inc(i) + while i < arg.len and (arg[i] notin {':', '=', ']'}): + id.add(arg[i]) + inc(i) + if isBracket: + if i < arg.len and arg[i] == ']': inc(i) + else: invalidCmdLineOption(conf, pass, orig, info) + + if i == arg.len: discard + elif i < arg.len and (arg[i] in {':', '='}): inc(i) else: invalidCmdLineOption(conf, pass, orig, info) - if state == wHint: - let x = findStr(lineinfos.HintsToStr, id) - if x >= 0: n = TNoteKind(x + ord(hintMin)) - else: localError(conf, info, "unknown hint: " & 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) else: - let x = findStr(lineinfos.WarningsToStr, id) - if x >= 0: n = TNoteKind(x + ord(warnMin)) - else: localError(conf, info, "unknown warning: " & id) - case substr(arg, i).normalize - of "on": - incl(conf.notes, n) - incl(conf.mainPackageNotes, n) - incl(conf.enableNotes, n) - of "off": - excl(conf.notes, n) - excl(conf.mainPackageNotes, n) - incl(conf.disableNotes, n) - excl(conf.foreignPackageNotes, n) - else: localError(conf, info, errOnOrOffExpectedButXFound % arg) + 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) - if found == "": found = filename + if found.isEmpty: found = AbsoluteFile filename extccomp.addExternalFileToCompile(conf, found) const - errNoneBoehmRefcExpectedButXFound = "'none', 'boehm' 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" + 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) + +template deprecatedAlias(oldName, newName: string) = + warningDeprecated(conf, info, "'$#' is a deprecated alias for '$#'" % [oldName, newName]) 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 - of "v2": result = conf.selectedGC == gcV2 + of "boehm": result = conf.selectedGC == gcBoehm + of "refc": result = conf.selectedGC == gcRefc of "markandsweep": result = conf.selectedGC == gcMarkAndSweep - of "generational": result = conf.selectedGC == gcGenerational - of "go": result = conf.selectedGC == gcGo - of "none": result = conf.selectedGC == gcNone + of "destructors", "arc": result = conf.selectedGC == gcArc + of "orc": result = conf.selectedGC == gcOrc + of "hooks": result = conf.selectedGC == gcHooks + of "go": result = conf.selectedGC == gcGo + of "none": result = conf.selectedGC == gcNone of "stack", "regions": result = conf.selectedGC == gcRegions - 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 - of "gui": result = contains(conf.globalOptions, optGenGuiApp) - of "console": result = not contains(conf.globalOptions, optGenGuiApp) - of "lib": result = contains(conf.globalOptions, optGenDynLib) and + of "gui": result = contains(conf.globalOptions, optGenGuiApp) + of "console": result = not contains(conf.globalOptions, optGenGuiApp) + of "lib": result = contains(conf.globalOptions, optGenDynLib) and 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) - else: invalidCmdLineOption(conf, passCmd1, switch, info) + of "exceptions": + case arg.normalize + of "cpp": result = conf.exc == excCpp + of "setjmp": result = conf.exc == excSetjmp + of "quirky": result = conf.exc == excQuirky + of "goto": result = conf.exc == excGoto + 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 @@ -251,8 +325,9 @@ proc testCompileOption*(conf: ConfigRef; switch: string, info: TLineInfo): bool of "hints": result = contains(conf.options, optHints) of "threadanalysis": result = contains(conf.globalOptions, optThreadAnalysis) of "stacktrace": result = contains(conf.options, optStackTrace) + of "stacktracemsgs": result = contains(conf.options, optStackTraceMsgs) of "linetrace": result = contains(conf.options, optLineTrace) - of "debugger": result = contains(conf.options, optEndb) + of "debugger": result = contains(conf.globalOptions, optCDebug) of "profiler": result = contains(conf.options, optProfiler) of "memtracker": result = contains(conf.options, optMemTracker) of "checks", "x": result = conf.options * ChecksOptions == ChecksOptions @@ -260,219 +335,434 @@ proc testCompileOption*(conf: ConfigRef; switch: string, info: TLineInfo): bool result = conf.options * {optNaNCheck, optInfCheck} == {optNaNCheck, optInfCheck} of "infchecks": result = contains(conf.options, optInfCheck) of "nanchecks": result = contains(conf.options, optNaNCheck) - of "nilchecks": result = contains(conf.options, optNilCheck) of "objchecks": result = contains(conf.options, optObjCheck) of "fieldchecks": result = contains(conf.options, optFieldCheck) of "rangechecks": result = contains(conf.options, optRangeCheck) of "boundchecks": result = contains(conf.options, optBoundsCheck) + of "refchecks": + warningDeprecated(conf, info, "refchecks is deprecated!") + result = contains(conf.options, optRefCheck) of "overflowchecks": result = contains(conf.options, optOverflowCheck) - of "movechecks": result = contains(conf.options, optMoveCheck) + of "staticboundchecks": result = contains(conf.options, optStaticBoundsCheck) + of "stylechecks": result = contains(conf.options, optStyleCheck) of "linedir": result = contains(conf.options, optLineDir) of "assertions", "a": result = contains(conf.options, optAssert) 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 "taintmode": result = contains(conf.globalOptions, optTaintMode) of "tlsemulation": result = contains(conf.globalOptions, optTlsEmulation) of "implicitstatic": result = contains(conf.options, optImplicitStatic) - of "patterns": result = contains(conf.options, optPatterns) + of "patterns", "trmacros": + if switch.normalize == "patterns": deprecatedAlias(switch, "trmacros") + result = contains(conf.options, optTrMacros) of "excessivestacktrace": result = contains(conf.globalOptions, optExcessiveStackTrace) - 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): string = + notRelativeToProj = false): AbsoluteDir = let p = if os.isAbsolute(path) or '$' in path: path elif notRelativeToProj: getCurrentDir() / path else: - conf.projectPath / path + conf.projectPath.string / path try: - result = pathSubs(conf, p, toFullPath(conf, info).splitFile().dir) + result = AbsoluteDir pathSubs(conf, p, toFullPath(conf, info).splitFile().dir) except ValueError: localError(conf, info, "invalid path: " & p) - result = p + result = AbsoluteDir p -proc processCfgPath(conf: ConfigRef; path: string, info: TLineInfo): string = - let path = if path[0] == '"': strutils.unescape(path) else: path +proc processCfgPath(conf: ConfigRef; path: string, info: TLineInfo): AbsoluteDir = + let path = if path.len > 0 and path[0] == '"': strutils.unescape(path) + else: path let basedir = toFullPath(conf, info).splitFile().dir let p = if os.isAbsolute(path) or '$' in path: path else: basedir / path try: - result = pathSubs(conf, p, basedir) + result = AbsoluteDir pathSubs(conf, p, basedir) except ValueError: localError(conf, info, "invalid path: " & p) - result = p + result = AbsoluteDir p 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, a[1]) - if dirtyOriginalIdx.int32 >= 0: - msgs.setDirtyFile(conf, dirtyOriginalIdx, 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, 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}: expectArg(conf, switch, arg, pass, info) options.inclDynlibOverride(conf, arg) +template handleStdinOrCmdInput = + conf.projectFull = conf.projectName.AbsoluteFile + conf.projectPath = AbsoluteDir getCurrentDir() + if conf.outDir.isEmpty: + conf.outDir = getNimcacheDir(conf) + +proc handleStdinInput*(conf: ConfigRef) = + conf.projectName = "stdinfile" + conf.projectIsStdin = true + handleStdinOrCmdInput() + +proc handleCmdInput*(conf: ConfigRef) = + conf.projectName = "cmdfile" + handleStdinOrCmdInput() + +proc parseCommand*(command: string): Command = + case command.normalize + of "c", "cc", "compile", "compiletoc": cmdCompileToC + of "cpp", "compiletocpp": cmdCompileToCpp + 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": cmdDoc + of "doc2tex": cmdDoc2tex + of "rst2html": cmdRst2html + of "md2tex": cmdMd2tex + of "md2html": cmdMd2html + of "rst2tex": cmdRst2tex + of "jsondoc0": cmdJsondoc0 + of "jsondoc2", "jsondoc": cmdJsondoc + of "ctags": cmdCtags + of "buildindex": cmdBuildindex + of "gendepend": cmdGendepend + of "dump": cmdDump + of "parse": cmdParse + of "rod": cmdRod + of "secret": cmdInteractive + of "nop", "help": cmdNop + of "jsonscript": cmdJsonscript + else: cmdUnknown + +proc setCmd*(conf: ConfigRef, cmd: Command) = + ## sets cmd, backend so subsequent flags can query it (e.g. so --gc:arc can be ignored for backendJs) + # Note that `--backend` can override the backend, so the logic here must remain reversible. + conf.cmd = cmd + case cmd + of cmdCompileToC, cmdCrun, cmdTcc: conf.backend = backendC + of cmdCompileToCpp: conf.backend = backendCpp + of cmdCompileToOC: conf.backend = backendObjc + of cmdCompileToJS: conf.backend = backendJs + else: discard + +proc setCommandEarly*(conf: ConfigRef, command: string) = + conf.command = command + setCmd(conf, command.parseCommand) + # command early customizations + # must be handled here to honor subsequent `--hint:x:on|off` + case conf.cmd + 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) + conf.projectIsCmd = true + conf.cmdInput = arg # can be empty (a nim file with empty content is valid too) + if conf.cmd == cmdNone: + conf.command = "e" + conf.setCmd cmdNimscript # better than `cmdCrun` as a default + conf.implicitCmd = true of "path", "p": expectArg(conf, switch, arg, pass, info) - addPath(conf, if pass == passPP: processCfgPath(conf, arg, info) else: processPath(conf, arg, info), info) - of "nimblepath", "babelpath": - # keep the old name for compat + for path in nimbleSubs(conf, arg): + addPath(conf, if pass == passPP: processCfgPath(conf, path, info) + else: processPath(conf, path, info), info) + 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 = getEnv("NIMBLE_DIR") - if nimbleDir.len > 0 and pass == passPP: path = nimbleDir / "pkgs" + 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": + of "nonimblepath": expectNoArg(conf, switch, arg, pass, info) disableNimblePath(conf) + of "clearnimblepath": + expectNoArg(conf, switch, arg, pass, info) + clearNimblePath(conf) of "excludepath": expectArg(conf, switch, arg, pass, info) let path = processPath(conf, arg, info) - - conf.searchPaths.keepItIf(cmpPaths(it, path) != 0) - conf.lazyPaths.keepItIf(cmpPaths(it, path) != 0) - - if (len(path) > 0) and (path[len(path) - 1] == DirSep): - let strippedPath = path[0 .. (len(path) - 2)] - conf.searchPaths.keepItIf(cmpPaths(it, strippedPath) != 0) - conf.lazyPaths.keepItIf(cmpPaths(it, strippedPath) != 0) + conf.searchPaths.keepItIf(it != path) + conf.lazyPaths.keepItIf(it != path) of "nimcache": expectArg(conf, switch, arg, pass, info) - conf.nimcacheDir = processPath(conf, arg, info, 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) - conf.outFile = arg + let f = splitFile(processPath(conf, arg, info, notRelativeToProj=true).string) + conf.outFile = RelativeFile f.name & f.ext + conf.outDir = toAbsoluteDir f.dir + of "outdir": + expectArg(conf, switch, arg, pass, info) + conf.outDir = processPath(conf, arg, info, notRelativeToProj=true) + of "usenimcache": + processOnOffSwitchG(conf, {optUseNimcache}, arg, pass, info) of "docseesrcurl": expectArg(conf, switch, arg, pass, info) conf.docSeeSrcUrl = arg - of "mainmodule", "m": - discard "allow for backwards compatibility, but don't do anything" + of "docroot": + conf.docRoot = if arg.len == 0: docRootDefault else: arg + of "backend", "b": + let backend = parseEnum(arg.normalize, TBackend.default) + if backend == TBackend.default: localError(conf, info, "invalid backend: '$1'" % arg) + if backend == 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) + specialDefine(conf, key, pass) defineSymbol(conf.symbols, key, val) else: + specialDefine(conf, arg, pass) defineSymbol(conf.symbols, arg) of "undef", "u": expectArg(conf, switch, arg, pass, info) undefSymbol(conf.symbols, arg) - of "symbol": - expectArg(conf, switch, arg, pass, info) - # deprecated, do nothing of "compile": expectArg(conf, switch, arg, pass, info) if pass in {passCmd2, passPP}: processCompile(conf, arg) of "link": expectArg(conf, switch, arg, pass, info) - if pass in {passCmd2, passPP}: addExternalFileToLink(conf, arg) + if pass in {passCmd2, passPP}: + addExternalFileToLink(conf, AbsoluteFile arg) of "debuginfo": - expectNoArg(conf, switch, arg, pass, info) - incl(conf.globalOptions, optCDebug) + processOnOffSwitchG(conf, {optCDebug}, arg, pass, info) of "embedsrc": - expectNoArg(conf, switch, arg, pass, info) - incl(conf.globalOptions, optEmbedOrigSrc) + processOnOffSwitchG(conf, {optEmbedOrigSrc}, arg, pass, info) of "compileonly", "c": - expectNoArg(conf, switch, arg, pass, info) - incl(conf.globalOptions, optCompileOnly) + processOnOffSwitchG(conf, {optCompileOnly}, arg, pass, info) of "nolinking": - expectNoArg(conf, switch, arg, pass, info) - incl(conf.globalOptions, optNoLinking) + processOnOffSwitchG(conf, {optNoLinking}, arg, pass, info) of "nomain": - expectNoArg(conf, switch, arg, pass, info) - incl(conf.globalOptions, optNoMain) + processOnOffSwitchG(conf, {optNoMain}, arg, pass, info) of "forcebuild", "f": - expectNoArg(conf, switch, arg, pass, info) - incl(conf.globalOptions, optForceFullMake) + processOnOffSwitchG(conf, {optForceFullMake}, arg, pass, info) of "project": - expectNoArg(conf, switch, arg, pass, info) - incl conf.globalOptions, optWholeProject + processOnOffSwitchG(conf, {optWholeProject, optGenIndex}, arg, pass, info) of "gc": - expectArg(conf, switch, arg, pass, info) - case arg.normalize - of "boehm": - conf.selectedGC = gcBoehm - defineSymbol(conf.symbols, "boehmgc") - of "refc": - conf.selectedGC = gcRefc - of "v2": - conf.selectedGC = gcV2 - of "markandsweep": - conf.selectedGC = gcMarkAndSweep - defineSymbol(conf.symbols, "gcmarkandsweep") - of "generational": - conf.selectedGC = gcGenerational - defineSymbol(conf.symbols, "gcgenerational") - 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") - 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) of "hint": processSpecificNote(arg, wHint, pass, info, switch, conf) + of "warningaserror": processSpecificNote(arg, wWarningAsError, pass, info, switch, conf) + of "hintaserror": processSpecificNote(arg, wHintAsError, pass, info, switch, conf) of "hints": if processOnOffSwitchOrList(conf, {optHints}, arg, pass, info): listHints(conf) - of "threadanalysis": processOnOffSwitchG(conf, {optThreadAnalysis}, arg, pass, info) + of "threadanalysis": + if conf.backend == backendJs: discard + else: processOnOffSwitchG(conf, {optThreadAnalysis}, arg, pass, info) of "stacktrace": processOnOffSwitch(conf, {optStackTrace}, arg, pass, info) + of "stacktracemsgs": processOnOffSwitch(conf, {optStackTraceMsgs}, arg, pass, info) of "excessivestacktrace": processOnOffSwitchG(conf, {optExcessiveStackTrace}, arg, pass, info) of "linetrace": processOnOffSwitch(conf, {optLineTrace}, arg, pass, info) of "debugger": case arg.normalize - of "on", "endb": - conf.options.incl optEndb - defineSymbol(conf.symbols, "endb") + of "on", "native", "gdb": + conf.globalOptions.incl optCDebug + conf.options.incl optLineDir + #defineSymbol(conf.symbols, "nimTypeNames") # type names are used in gdb pretty printing of "off": - conf.options.excl optEndb - undefSymbol(conf.symbols, "endb") - of "native", "gdb": - incl(conf.globalOptions, optCDebug) - conf.options = conf.options + {optLineDir} - {optEndb} - defineSymbol(conf.symbols, "nimTypeNames") # type names are used in gdb pretty printing - undefSymbol(conf.symbols, "endb") + conf.globalOptions.excl optCDebug else: - localError(conf, info, "expected endb|gdb but found " & arg) + localError(conf, info, "expected native|gdb|on|off but found " & arg) + of "g": # alias for --debugger:native + conf.globalOptions.incl optCDebug + conf.options.incl optLineDir + #defineSymbol(conf.symbols, "nimTypeNames") # type names are used in gdb pretty printing of "profiler": processOnOffSwitch(conf, {optProfiler}, arg, pass, info) if optProfiler in conf.options: defineSymbol(conf.symbols, "profiler") @@ -482,44 +772,47 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; if optMemTracker in conf.options: defineSymbol(conf.symbols, "memtracker") else: undefSymbol(conf.symbols, "memtracker") of "hotcodereloading": - processOnOffSwitch(conf, {optHotCodeReloading}, arg, pass, info) - if optHotCodeReloading in conf.options: defineSymbol(conf.symbols, "hotcodereloading") - else: undefSymbol(conf.symbols, "hotcodereloading") - of "oldnewlines": - case arg.normalize - of "on": - conf.oldNewlines = true - defineSymbol(conf.symbols, "nimOldNewlines") - of "off": - conf.oldNewlines = false - undefSymbol(conf.symbols, "nimOldNewlines") + processOnOffSwitchG(conf, {optHotCodeReloading}, arg, pass, info) + if conf.hcrOn: + defineSymbol(conf.symbols, "hotcodereloading") + defineSymbol(conf.symbols, "useNimRtl") + # hardcoded linking with dynamic runtime for MSVC for smaller binaries + # should do the same for all compilers (wherever applicable) + if isVSCompatible(conf): + extccomp.addCompileOptionCmd(conf, "/MD") else: - localError(conf, info, errOnOrOffExpectedButXFound % arg) - of "laxstrings": processOnOffSwitch(conf, {optLaxStrings}, arg, pass, info) + undefSymbol(conf.symbols, "hotcodereloading") + undefSymbol(conf.symbols, "useNimRtl") of "checks", "x": processOnOffSwitch(conf, ChecksOptions, arg, pass, info) of "floatchecks": processOnOffSwitch(conf, {optNaNCheck, optInfCheck}, arg, pass, info) of "infchecks": processOnOffSwitch(conf, {optInfCheck}, arg, pass, info) of "nanchecks": processOnOffSwitch(conf, {optNaNCheck}, arg, pass, info) - of "nilchecks": processOnOffSwitch(conf, {optNilCheck}, arg, pass, info) of "objchecks": processOnOffSwitch(conf, {optObjCheck}, arg, pass, info) of "fieldchecks": processOnOffSwitch(conf, {optFieldCheck}, arg, pass, info) of "rangechecks": processOnOffSwitch(conf, {optRangeCheck}, arg, pass, info) of "boundchecks": processOnOffSwitch(conf, {optBoundsCheck}, arg, pass, info) + of "refchecks": + warningDeprecated(conf, info, "refchecks is deprecated!") + processOnOffSwitch(conf, {optRefCheck}, arg, pass, info) of "overflowchecks": processOnOffSwitch(conf, {optOverflowCheck}, arg, pass, info) - of "movechecks": processOnOffSwitch(conf, {optMoveCheck}, arg, pass, info) + of "staticboundchecks": processOnOffSwitch(conf, {optStaticBoundsCheck}, arg, pass, info) + of "stylechecks": processOnOffSwitch(conf, {optStyleCheck}, arg, pass, info) of "linedir": processOnOffSwitch(conf, {optLineDir}, arg, pass, info) of "assertions", "a": processOnOffSwitch(conf, {optAssert}, arg, pass, info) - of "deadcodeelim": discard # deprecated, dead code elim always on of "threads": - processOnOffSwitchG(conf, {optThreads}, arg, pass, info) - #if optThreads in conf.globalOptions: incl(conf.notes, warnGcUnsafe) - of "tlsemulation": processOnOffSwitchG(conf, {optTlsEmulation}, arg, pass, info) - of "taintmode": processOnOffSwitchG(conf, {optTaintMode}, arg, pass, info) + 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) + if optTlsEmulation in conf.globalOptions: + conf.legacyFeatures.incl emitGenerics of "implicitstatic": processOnOffSwitch(conf, {optImplicitStatic}, arg, pass, info) - of "patterns": - processOnOffSwitch(conf, {optPatterns}, arg, pass, info) + of "patterns", "trmacros": + if switch.normalize == "patterns": deprecatedAlias(switch, "trmacros") + processOnOffSwitch(conf, {optTrMacros}, arg, pass, info) of "opt": expectArg(conf, switch, arg, pass, info) case arg.normalize @@ -551,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") @@ -569,51 +863,87 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; if pass in {passCmd2, passPP}: conf.cLibs.add processPath(conf, arg, info) of "clib": expectArg(conf, switch, arg, pass, info) - if pass in {passCmd2, passPP}: conf.cLinkedLibs.add processPath(conf, arg, info) + if pass in {passCmd2, passPP}: + 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}: conf.implicitImports.add arg + if pass in {passCmd2, passPP}: + conf.implicitImports.add findModule(conf, arg, toFullPath(conf, info)).string of "include": expectArg(conf, switch, arg, pass, info) - if pass in {passCmd2, passPP}: conf.implicitIncludes.add arg + if pass in {passCmd2, passPP}: + conf.implicitIncludes.add findModule(conf, arg, toFullPath(conf, info)).string of "listcmd": - expectNoArg(conf, switch, arg, pass, info) - incl(conf.globalOptions, optListCmd) + processOnOffSwitchG(conf, {optListCmd}, arg, pass, info) + of "asm": + processOnOffSwitchG(conf, {optProduceAsm}, arg, pass, info) of "genmapping": - expectNoArg(conf, switch, arg, pass, info) - incl(conf.globalOptions, optGenMapping) + processOnOffSwitchG(conf, {optGenMapping}, arg, pass, info) of "os": expectArg(conf, switch, arg, pass, info) - if pass in {passCmd1, passPP}: - let theOS = platform.nameToOS(arg) - if theOS == osNone: localError(conf, info, "unknown OS: '$1'" % arg) - elif theOS != conf.target.hostOS: - setTarget(conf.target, theOS, conf.target.targetCPU) + let theOS = platform.nameToOS(arg) + if theOS == osNone: + let osList = platform.listOSnames().join(", ") + localError(conf, info, "unknown OS: '$1'. Available options are: $2" % [arg, $osList]) + else: + setTarget(conf.target, theOS, conf.target.targetCPU) of "cpu": expectArg(conf, switch, arg, pass, info) - if pass in {passCmd1, passPP}: - let cpu = platform.nameToCPU(arg) - if cpu == cpuNone: localError(conf, info, "unknown CPU: '$1'" % arg) - elif cpu != conf.target.hostCPU: - setTarget(conf.target, conf.target.targetOS, cpu) + let cpu = platform.nameToCPU(arg) + if cpu == cpuNone: + let cpuList = platform.listCPUnames().join(", ") + localError(conf, info, "unknown CPU: '$1'. Available options are: $2" % [ arg, cpuList]) + else: + setTarget(conf.target, conf.target.targetOS, cpu) of "run", "r": - expectNoArg(conf, switch, arg, pass, info) - incl(conf.globalOptions, optRun) + 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) + 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 + 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) - conf.verbosity = parseInt(arg) - conf.notes = NotesVerbosity[conf.verbosity] - incl(conf.notes, conf.enableNotes) - excl(conf.notes, conf.disableNotes) + let verbosity = parseInt(arg) + if verbosity notin 0..3: + localError(conf, info, "invalid verbosity level: '$1'" % arg) + conf.verbosity = verbosity + var verb = NotesVerbosity[conf.verbosity] + ## We override the default `verb` by explicitly modified (set/unset) notes. + conf.notes = (conf.modifiedyNotes * conf.notes + verb) - + (conf.modifiedyNotes * verb - conf.notes) 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) @@ -626,30 +956,33 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; of "help", "h": expectNoArg(conf, switch, arg, pass, info) helpOnError(conf, pass) - of "symbolfiles", "incremental": - case arg.normalize - of "on": conf.symbolFiles = v2Sf - of "off": conf.symbolFiles = disabledSf - of "writeonly": conf.symbolFiles = writeOnlySf - of "readonly": conf.symbolFiles = readOnlySf - of "v2": conf.symbolFiles = v2Sf - else: localError(conf, info, "invalid option for --symbolFiles: " & arg) + of "symbolfiles", "incremental", "ic": + if switch.normalize == "symbolfiles": deprecatedAlias(switch, "incremental") + # xxx maybe also ic, since not in help? + if pass in {passCmd2, passPP}: + case arg.normalize + of "on": conf.symbolFiles = v2Sf + of "off": conf.symbolFiles = disabledSf + of "writeonly": conf.symbolFiles = writeOnlySf + of "readonly": conf.symbolFiles = readOnlySf + 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": - expectNoArg(conf, switch, arg, pass, info) - incl(conf.globalOptions, optSkipConfigFile) + processOnOffSwitchG(conf, {optSkipSystemConfigFile}, arg, pass, info) of "skipprojcfg": - expectNoArg(conf, switch, arg, pass, info) - incl(conf.globalOptions, optSkipProjConfigFile) + processOnOffSwitchG(conf, {optSkipProjConfigFile}, arg, pass, info) of "skipusercfg": - expectNoArg(conf, switch, arg, pass, info) - incl(conf.globalOptions, optSkipUserConfigFile) + processOnOffSwitchG(conf, {optSkipUserConfigFile}, arg, pass, info) of "skipparentcfg": - expectNoArg(conf, switch, arg, pass, info) - incl(conf.globalOptions, optSkipParentConfigFiles) + processOnOffSwitchG(conf, {optSkipParentConfigFiles}, arg, pass, info) of "genscript", "gendeps": - expectNoArg(conf, switch, arg, pass, info) - incl(conf.globalOptions, optGenScript) - incl(conf.globalOptions, optCompileOnly) + 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) @@ -659,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) @@ -671,31 +1005,50 @@ 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 - of "eval": expectArg(conf, switch, arg, pass, info) - conf.evalExpr = arg + 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": - expectNoArg(conf, switch, arg, pass, info) - incl(conf.globalOptions, optStdout) + 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": - expectNoArg(conf, switch, arg, pass, info) - incl conf.globalOptions, optListFullPaths + # 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 + else: conf.spellSuggestMax = parseInt(arg) + of "declaredlocs": + processOnOffSwitchG(conf, {optDeclaredLocs}, arg, pass, info) of "dynliboverride": dynlibOverride(conf, switch, arg, pass, info) of "dynliboverrideall": - expectNoArg(conf, switch, arg, pass, info) - incl conf.globalOptions, optDynlibOverrideAll - of "cs": - # only supported for compatibility. Does nothing. - expectArg(conf, switch, arg, pass, info) + processOnOffSwitchG(conf, {optDynlibOverrideAll}, arg, pass, info) of "experimental": if arg.len == 0: conf.features.incl oldExperimentalFeatures @@ -704,64 +1057,143 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo; conf.features.incl parseEnum[Feature](arg) except ValueError: localError(conf, info, "unknown experimental feature") + of "legacy": + try: + conf.legacyFeatures.incl parseEnum[LegacyFeature](arg) + except ValueError: + localError(conf, info, "unknown obsolete feature") of "nocppexceptions": expectNoArg(conf, switch, arg, pass, info) - incl(conf.globalOptions, optNoCppExceptions) + 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 + of "setjmp": conf.exc = excSetjmp + of "quirky": conf.exc = excQuirky + of "goto": conf.exc = excGoto + else: localError(conf, info, errInvalidExceptionSystem % arg) of "cppdefine": expectArg(conf, switch, arg, pass, info) if conf != nil: conf.cppDefine(arg) of "newruntime": + warningDeprecated(conf, info, "newruntime is deprecated, use arc/orc instead!") expectNoArg(conf, switch, arg, pass, info) - doAssert(conf != nil) - incl(conf.features, destructor) - defineSymbol(conf.symbols, "nimNewRuntime") - of "nep1": - processOnOffSwitchG(conf, {optCheckNep1}, arg, pass, info) + if pass in {passCmd2, passPP}: + doAssert(conf != nil) + incl(conf.features, destructor) + incl(conf.globalOptions, optTinyRtti) + incl(conf.globalOptions, optOwnedRefs) + incl(conf.globalOptions, optSeqDestructors) + defineSymbol(conf.symbols, "nimV2") + conf.selectedGC = gcHooks + defineSymbol(conf.symbols, "gchooks") + defineSymbol(conf.symbols, "nimSeqsV2") + defineSymbol(conf.symbols, "nimOwnedEnabled") + of "seqsv2": + processOnOffSwitchG(conf, {optSeqDestructors}, arg, pass, info) + if pass in {passCmd2, passPP}: + defineSymbol(conf.symbols, "nimSeqsV2") + of "stylecheck": + case arg.normalize + 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) of "cppcompiletonamespace": - expectNoArg(conf, switch, arg, pass, info) - incl conf.globalOptions, optUseNimNamespace - defineSymbol(conf.symbols, "cppCompileToNamespace") + if arg.len > 0: + conf.cppCustomNamespace = arg + else: + conf.cppCustomNamespace = "Nim" + defineSymbol(conf.symbols, "cppCompileToNamespace", conf.cppCustomNamespace) + of "docinternal": + processOnOffSwitchG(conf, {optDocInternal}, arg, pass, info) + of "multimethods": + processOnOffSwitchG(conf, {optMultiMethods}, arg, pass, info) + of "expandmacro": + expectArg(conf, switch, arg, pass, info) + conf.macrosToExpand[arg] = "T" + of "expandarc": + expectArg(conf, switch, arg, pass, info) + conf.arcToExpand[arg] = "T" + of "benchmarkvm": + processOnOffSwitchG(conf, {optBenchmarkVM}, arg, pass, info) + of "profilevm": + processOnOffSwitchG(conf, {optProfileVM}, arg, pass, info) + of "sinkinference": + processOnOffSwitch(conf, {optSinkInference}, arg, pass, info) + of "cursorinference": + # undocumented, for debugging purposes only: + processOnOffSwitch(conf, {optCursorInference}, arg, pass, info) + of "panics": + 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 + of "deepcopy": + processOnOffSwitchG(conf, {optEnableDeepCopy}, arg, pass, info) + of "": # comes from "-" in for example: `nim c -r -` (gets stripped from -) + handleStdinInput(conf) + 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) -template gCmdLineInfo*(): untyped = newLineInfo(config, "command line", 1, 1) - 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) - proc processSwitch*(pass: TCmdLinePass; p: OptParser; config: ConfigRef) = # hint[X]:off is parsed as (p.key = "hint[X]", p.val = "off") - # we fix this here + # we transform it to (key = hint, val = [X]:off) var bracketLe = strutils.find(p.key, '[') if bracketLe >= 0: var key = substr(p.key, 0, bracketLe - 1) - var val = substr(p.key, bracketLe + 1) & ':' & p.val + var val = substr(p.key, bracketLe) & ':' & p.val processSwitch(key, val, pass, gCmdLineInfo, config) else: processSwitch(p.key, p.val, pass, gCmdLineInfo, config) proc processArgument*(pass: TCmdLinePass; p: OptParser; argsCount: var int; config: ConfigRef): bool = + if argsCount == 0 and config.implicitCmd: + argsCount.inc if argsCount == 0: # nim filename.nims is the same as "nim e filename.nims": - if p.key.endswith(".nims"): - config.command = "e" + if p.key.endsWith(".nims"): + config.setCmd cmdNimscript + incl(config.globalOptions, optWasNimscript) config.projectName = unixToNativePath(p.key) config.arguments = cmdLineRest(p) result = true elif pass != passCmd2: - config.command = p.key + 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: - config.projectName = unixToNativePath(p.key) + 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 new file mode 100644 index 000000000..d48bacdc5 --- /dev/null +++ b/compiler/concepts.nim @@ -0,0 +1,343 @@ +# +# +# The Nim Compiler +# (c) Copyright 2020 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## New styled concepts for Nim. See https://github.com/nim-lang/RFCs/issues/168 +## 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 + +import std/intsets + +when defined(nimPreviewSlimSystem): + import std/assertions + +const + logBindings = false + +## Code dealing with Concept declarations +## -------------------------------------- + +proc declareSelf(c: PContext; info: TLineInfo) = + ## Adds the magical 'Self' symbols to the current scope. + let ow = getCurrOwner(c) + let s = newSym(skType, getIdent(c.cache, "Self"), c.idgen, ow, info) + s.typ = newType(tyTypeDesc, c.idgen, ow) + s.typ.flags.incl {tfUnresolved, tfPacked} + s.typ.add newType(tyEmpty, c.idgen, ow) + addDecl(c, s, info) + +proc semConceptDecl(c: PContext; n: PNode): PNode = + ## Recursive helper for semantic checking for the concept declaration. + ## Currently we only support (possibly empty) lists of statements + ## containing 'proc' declarations and the like. + case n.kind + of nkStmtList, nkStmtListExpr: + result = shallowCopy(n) + for i in 0..<n.len: + result[i] = semConceptDecl(c, n[i]) + of nkProcDef..nkIteratorDef, nkFuncDef: + result = c.semExpr(c, n, {efWantStmt}) + of nkTypeClassTy: + result = shallowCopy(n) + 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)) + result = n + +proc semConceptDeclaration*(c: PContext; n: PNode): PNode = + ## Semantic checking for the concept declaration. Runs + ## when we process the concept itself, not its matching process. + assert n.kind == nkTypeClassTy + inc c.inConceptDecl + openScope(c) + declareSelf(c, n.info) + result = semConceptDecl(c, n) + rawCloseScope(c) + dec c.inConceptDecl + +## Concept matching +## ---------------- + +type + MatchCon = object ## Context we pass around during concept matching. + inferred: seq[(PType, PType)] ## we need a seq here so that we can easily undo inferences \ + ## that turned out to be wrong. + marker: IntSet ## Some protection against wild runaway recursions. + potentialImplementation: PType ## the concrete type that might match the concept we try to match. + magic: TMagic ## mArrGet and mArrPut is wrong in system.nim and + ## cannot be fixed that easily. + ## Thus we special case it here. + +proc existingBinding(m: MatchCon; key: PType): PType = + ## checks if we bound the type variable 'key' already to some + ## concrete type. + for i in 0..<m.inferred.len: + if m.inferred[i][0] == key: return m.inferred[i][1] + return nil + +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 + ## 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.skipModifier, a, m) + of tyTypeDesc: + if isSelf(f): + #let oldLen = m.inferred.len + result = matchType(c, a, m.potentialImplementation, m) + #echo "self is? ", result, " ", a.kind, " ", a, " ", m.potentialImplementation, " ", m.potentialImplementation.kind + #m.inferred.setLen oldLen + #echo "A for ", result, " to ", typeToString(a), " to ", typeToString(m.potentialImplementation) + else: + if a.kind == tyTypeDesc and f.hasElementType == a.hasElementType: + if f.hasElementType: + result = matchType(c, f.elementType, a.elementType, m) + else: + result = true # both lack it + else: + result = false + + of tyGenericInvocation: + result = false + if a.kind == tyGenericInst and a.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: + let ak = a.skipTypes({tyVar, tySink, tyLent, tyOwned}) + if ak.kind in {tyTypeDesc, tyStatic} and not isSelf(ak): + result = false + else: + let old = existingBinding(m, f) + if old == nil: + if f.hasElementType and f.elementType.kind != tyNone: + # also check the generic's constraints: + let oldLen = m.inferred.len + result = matchType(c, f.elementType, a, m) + m.inferred.setLen oldLen + if result: + when logBindings: echo "A adding ", f, " ", ak + m.inferred.add((f, ak)) + elif m.magic == mArrGet and ak.kind in {tyArray, tyOpenArray, tySequence, tyVarargs, tyCstring, tyString}: + when logBindings: echo "B adding ", f, " ", lastSon ak + m.inferred.add((f, last ak)) + result = true + else: + when logBindings: echo "C adding ", f, " ", ak + m.inferred.add((f, ak)) + #echo "binding ", typeToString(ak), " to ", typeToString(f) + result = true + elif not m.marker.containsOrIncl(old.id): + 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.elementType, a.elementType, m) + elif m.magic == mArrPut: + 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: + 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.hasElementType and ak.elementType.kind == tyOrdinal) + of tyConcept: + let oldLen = m.inferred.len + let oldPotentialImplementation = m.potentialImplementation + m.potentialImplementation = a + result = conceptMatchNode(c, f.n.lastSon, m) + m.potentialImplementation = oldPotentialImplementation + if not result: + 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.kidsLen == ak.kidsLen: + for i in 0..<ak.kidsLen: + if not matchType(c, f[i], ak[i], m): return false + return true + of tyOr: + let oldLen = m.inferred.len + if a.kind == tyOr: + # say the concept requires 'int|float|string' if the potentialImplementation + # says 'int|string' that is good enough. + var covered = 0 + for ff in f.kids: + for aa in a.kids: + let oldLenB = m.inferred.len + let r = matchType(c, ff, aa, m) + if r: + inc covered + break + m.inferred.setLen oldLenB + + result = covered >= a.kidsLen + if not result: + m.inferred.setLen oldLen + else: + 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.elementType, a.elementType, m) + else: + let oldLen = m.inferred.len + result = not matchType(c, f.elementType, a, m) + m.inferred.setLen oldLen + of tyAnything: + result = true + of tyOrdinal: + result = isOrdinalType(a, allowEnumWithHoles = false) or a.kind == tyGenericParam + else: + result = false + +proc matchReturnType(c: PContext; f, a: PType; m: var MatchCon): bool = + ## Like 'matchType' but with extra logic dealing with proc return types + ## which can be nil or the 'void' type. + if f.isEmptyType: + result = a.isEmptyType + elif a == nil: + result = false + else: + result = matchType(c, f, a, m) + +proc matchSym(c: PContext; candidate: PSym, n: PNode; m: var MatchCon): bool = + ## Checks if 'candidate' matches 'n' from the concept body. 'n' is a nkProcDef + ## or similar. + + # watch out: only add bindings after a completely successful match. + let oldLen = m.inferred.len + + let can = candidate.typ.n + let con = n[0].sym.typ.n + + if can.len < con.len: + # too few arguments, cannot be a match: + return false + + let common = min(can.len, con.len) + for i in 1 ..< common: + if not matchType(c, con[i].typ, can[i].typ, m): + m.inferred.setLen oldLen + return false + + if not matchReturnType(c, n[0].sym.typ.returnType, candidate.typ.returnType, m): + m.inferred.setLen oldLen + return false + + # all other parameters have to be optional parameters: + for i in common ..< can.len: + assert can[i].kind == nkSym + if can[i].sym.ast == nil: + # has too many arguments one of which is not optional: + m.inferred.setLen oldLen + return false + + return true + +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 = searchInScopesAllCandidatesFilterBy(c, n[namePos].sym.name, kinds) + for candidate in candidates: + #echo "considering ", typeToString(candidate.typ), " ", candidate.magic + m.magic = candidate.magic + if matchSym(c, candidate, n, m): return true + result = false + +proc conceptMatchNode(c: PContext; n: PNode; m: var MatchCon): bool = + ## Traverse the concept's AST ('n') and see if every declaration inside 'n' + ## can be matched with the current scope. + case n.kind + of nkStmtList, nkStmtListExpr: + for i in 0..<n.len: + if not conceptMatchNode(c, n[i], m): + return false + return true + of nkProcDef, nkFuncDef: + # procs match any of: proc, template, macro, func, method, converter. + # The others are more specific. + # XXX: Enforce .noSideEffect for 'nkFuncDef'? But then what are the use cases... + const filter = {skProc, skTemplate, skMacro, skFunc, skMethod, skConverter} + result = matchSyms(c, n, filter, m) + of nkTemplateDef: + result = matchSyms(c, n, {skTemplate}, m) + of nkMacroDef: + result = matchSyms(c, n, {skMacro}, m) + of nkConverterDef: + result = matchSyms(c, n, {skConverter}, m) + of nkMethodDef: + 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 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 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 + ## 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) + result = conceptMatchNode(c, concpt.n.lastSon, m) + if result: + for (a, b) in m.inferred: + if b.kind == tyGenericParam: + var dest = b + while true: + dest = existingBinding(m, dest) + if dest == nil or dest.kind != tyGenericParam: break + if dest != nil: + bindings.idTablePut(a, dest) + when logBindings: echo "A bind ", a, " ", dest + else: + bindings.idTablePut(a, b) + when logBindings: echo "B bind ", a, " ", b + # 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.kidsLen == arg.kidsLen-1: + # bind even more generic parameters + assert invocation.kind == tyGenericInvocation + for i in FirstGenericParamAt ..< invocation.kidsLen: + bindings.idTablePut(invocation[i], arg[i]) diff --git a/compiler/condsyms.nim b/compiler/condsyms.nim index 56587a4fa..5043fc5d4 100644 --- a/compiler/condsyms.nim +++ b/compiler/condsyms.nim @@ -10,64 +10,162 @@ # This module handles the conditional symbols. import - strtabs, platform, strutils, idents + std/strtabs -const - catNone = "false" +from options import Feature +from lineinfos import hintMin, hintMax, warnMin, warnMax proc defineSymbol*(symbols: StringTableRef; symbol: string, value: string = "true") = symbols[symbol] = value proc undefSymbol*(symbols: StringTableRef; symbol: string) = - symbols[symbol] = catNone + symbols.del(symbol) #proc lookupSymbol*(symbols: StringTableRef; symbol: string): string = # result = if isDefined(symbol): gSymbols[symbol] else: nil iterator definedSymbolNames*(symbols: StringTableRef): string = - for key, val in pairs(symbols): - if val != catNone: yield key + for key in keys(symbols): + yield key proc countDefinedSymbols*(symbols: StringTableRef): int = - result = 0 - for key, val in pairs(symbols): - if val != catNone: inc(result) + symbols.len proc initDefines*(symbols: StringTableRef) = # for bootstrapping purposes and old code: template defineSymbol(s) = symbols.defineSymbol(s) - defineSymbol("nimhygiene") - defineSymbol("niminheritable") - defineSymbol("nimmixin") - defineSymbol("nimeffects") - defineSymbol("nimbabel") - defineSymbol("nimcomputedgoto") - defineSymbol("nimunion") - defineSymbol("nimnewshared") - defineSymbol("nimrequiresnimframe") - defineSymbol("nimparsebiggestfloatmagic") - defineSymbol("nimalias") - defineSymbol("nimlocks") - defineSymbol("nimnode") - defineSymbol("nimnomagic64") - defineSymbol("nimvarargstyped") - defineSymbol("nimtypedescfixed") - defineSymbol("nimKnowsNimvm") - defineSymbol("nimArrIdx") - defineSymbol("nimImmediateDeprecated") - defineSymbol("nimNewShiftOps") - defineSymbol("nimDistros") - defineSymbol("nimHasCppDefine") - defineSymbol("nimGenericInOutFlags") - when false: defineSymbol("nimHasOpt") - defineSymbol("nimNoArrayToCstringConversion") - defineSymbol("nimNewRoof") - defineSymbol("nimHasRunnableExamples") - defineSymbol("nimNewDot") - defineSymbol("nimHasNilChecks") - defineSymbol("nimSymKind") - defineSymbol("nimVmEqIdent") - defineSymbol("nimNoNil") - defineSymbol("nimNoZeroTerminator") - defineSymbol("nimNotNil") - defineSymbol("nimVmExportFixed") + defineSymbol("nimhygiene") # deadcode + defineSymbol("niminheritable") # deadcode + defineSymbol("nimmixin") # deadcode + defineSymbol("nimeffects") # deadcode + defineSymbol("nimbabel") # deadcode + defineSymbol("nimcomputedgoto") # deadcode + defineSymbol("nimunion") # deadcode + defineSymbol("nimnewshared") # deadcode + defineSymbol("nimNewTypedesc") # deadcode + defineSymbol("nimrequiresnimframe") # deadcode + defineSymbol("nimparsebiggestfloatmagic") # deadcode + defineSymbol("nimlocks") # deadcode + defineSymbol("nimnode") # deadcode + defineSymbol("nimvarargstyped") # deadcode + defineSymbol("nimtypedescfixed") # deadcode + defineSymbol("nimKnowsNimvm") # deadcode + defineSymbol("nimArrIdx") # deadcode + defineSymbol("nimHasalignOf") # deadcode + defineSymbol("nimDistros") # deadcode + defineSymbol("nimHasCppDefine") # deadcode + defineSymbol("nimGenericInOutFlags") # deadcode + when false: defineSymbol("nimHasOpt") # deadcode + defineSymbol("nimNoArrayToCstringConversion") # deadcode + defineSymbol("nimHasRunnableExamples") # deadcode + defineSymbol("nimNewDot") # deadcode + defineSymbol("nimHasNilChecks") # deadcode + defineSymbol("nimSymKind") # deadcode + defineSymbol("nimVmEqIdent") # deadcode + defineSymbol("nimNoNil") # deadcode + defineSymbol("nimNoZeroTerminator") # deadcode + defineSymbol("nimNotNil") # deadcode + defineSymbol("nimVmExportFixed") # deadcode + defineSymbol("nimHasSymOwnerInMacro") # deadcode + defineSymbol("nimNewRuntime") # deadcode + defineSymbol("nimIncrSeqV3") # deadcode + defineSymbol("nimAshr") # deadcode + defineSymbol("nimNoNilSeqs") # deadcode + defineSymbol("nimNoNilSeqs2") # deadcode + defineSymbol("nimHasUserErrors") # deadcode + defineSymbol("nimUncheckedArrayTyp") # deadcode + defineSymbol("nimHasTypeof") # deadcode + defineSymbol("nimErrorProcCanHaveBody") # deadcode + defineSymbol("nimHasInstantiationOfInMacro") # deadcode + defineSymbol("nimHasHotCodeReloading") # deadcode + defineSymbol("nimHasNilSeqs") # deadcode + 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 + + + + for f in Feature: + defineSymbol("nimHas" & $f) + + for s in warnMin..warnMax: + defineSymbol("nimHasWarning" & $s) + for s in hintMin..hintMax: + defineSymbol("nimHasHint" & $s) + + defineSymbol("nimFixedOwned") + defineSymbol("nimHasStyleChecks") + + 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") # deadcode + + defineSymbol("nimHasStacktraceMsgs") # deadcode + defineSymbol("nimDoesntTrackDefects") + defineSymbol("nimHasLentIterators") # deadcode + defineSymbol("nimHasDeclaredMagic") # deadcode + defineSymbol("nimHasStacktracesModule") # deadcode + defineSymbol("nimHasEffectTraitsModule") + defineSymbol("nimHasCastPragmaBlocks") + defineSymbol("nimHasDeclaredLocs") + defineSymbol("nimHasJsBigIntBackend") + 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/configuration.nim b/compiler/configuration.nim deleted file mode 100644 index 22e0b834e..000000000 --- a/compiler/configuration.nim +++ /dev/null @@ -1,6 +0,0 @@ -## Use the module 'lineinfos' instead! - -{.deprecated.} - -import lineinfos -export lineinfos 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 d0a1139ef..638f1eb51 100644 --- a/compiler/depends.nim +++ b/compiler/depends.nim @@ -9,13 +9,20 @@ # This module implements a dependency file generator. -import - os, options, ast, astalgo, msgs, ropes, idents, passes, modulepaths +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 type - TGen = object of TPassContext + TGen = object of PPassContext module: PSym config: ConfigRef graph: ModuleGraph @@ -25,41 +32,79 @@ type dotGraph: Rope proc addDependencyAux(b: Backend; importing, imported: string) = - addf(b.dotGraph, "$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 countup(0, sonsLen(n) - 1): - var imported = getModuleName(g.config, n.sons[i]) - addDependencyAux(b, g.module.name.s, imported) + for i in 0..<n.len: + addDependency(c, g, b, n[i]) of nkFromStmt, nkImportExceptStmt: - var imported = getModuleName(g.config, n.sons[0]) - addDependencyAux(b, g.module.name.s, imported) + addDependency(c, g, b, n[0]) of nkStmtList, nkBlockStmt, nkStmtListExpr, nkBlockExpr: - for i in countup(0, sonsLen(n) - 1): discard addDotDependency(c, n.sons[i]) + for i in 0..<n.len: discard addDotDependency(c, n[i]) else: discard -proc generateDot*(graph: ModuleGraph; project: string) = +proc generateDot*(graph: ModuleGraph; project: AbsoluteFile) = let b = Backend(graph.backend) discard writeRope("digraph $1 {$n$2}$n" % [ - rope(changeFileExt(extractFilename(project), "")), b.dotGraph], + rope(project.splitFile.name), b.dotGraph], changeFileExt(project, "dot")) -proc myOpen(graph: ModuleGraph; module: PSym): PPassContext = - 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/destroyer.nim b/compiler/destroyer.nim deleted file mode 100644 index 0395728c2..000000000 --- a/compiler/destroyer.nim +++ /dev/null @@ -1,465 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2017 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Injects destructor calls into Nim code as well as -## an optimizer that optimizes copies to moves. This is implemented as an -## AST to AST transformation so that every backend benefits from it. - -## Rules for destructor injections: -## -## foo(bar(X(), Y())) -## X and Y get destroyed after bar completes: -## -## foo( (tmpX = X(); tmpY = Y(); tmpBar = bar(tmpX, tmpY); -## destroy(tmpX); destroy(tmpY); -## tmpBar)) -## destroy(tmpBar) -## -## var x = f() -## body -## -## is the same as: -## -## var x; -## try: -## move(x, f()) -## finally: -## destroy(x) -## -## But this really just an optimization that tries to avoid to -## introduce too many temporaries, the 'destroy' is caused by -## the 'f()' call. No! That is not true for 'result = f()'! -## -## x = y where y is read only once -## is the same as: move(x, y) -## -## Actually the more general rule is: The *last* read of ``y`` -## can become a move if ``y`` is the result of a construction. -## -## We also need to keep in mind here that the number of reads is -## control flow dependent: -## let x = foo() -## while true: -## y = x # only one read, but the 2nd iteration will fail! -## This also affects recursions! Only usages that do not cross -## a loop boundary (scope) and are not used in function calls -## are safe. -## -## -## x = f() is the same as: move(x, f()) -## -## x = y -## is the same as: copy(x, y) -## -## Reassignment works under this scheme: -## var x = f() -## x = y -## -## is the same as: -## -## var x; -## try: -## move(x, f()) -## copy(x, y) -## finally: -## destroy(x) -## -## result = f() must not destroy 'result'! -## -## The produced temporaries clutter up the code and might lead to -## inefficiencies. A better strategy is to collect all the temporaries -## in a single object that we put into a single try-finally that -## surrounds the proc body. This means the code stays quite efficient -## when compiled to C. In fact, we do the same for variables, so -## destructors are called when the proc returns, not at scope exit! -## This makes certains idioms easier to support. (Taking the slice -## of a temporary object.) -## -## foo(bar(X(), Y())) -## X and Y get destroyed after bar completes: -## -## var tmp: object -## foo( (move tmp.x, X(); move tmp.y, Y(); tmp.bar = bar(tmpX, tmpY); -## tmp.bar)) -## destroy(tmp.bar) -## destroy(tmp.x); destroy(tmp.y) -## - -##[ -From https://github.com/nim-lang/Nim/wiki/Destructors - -Rule Pattern Transformed into ----- ------- ---------------- -1.1 var x: T; stmts var x: T; try stmts - finally: `=destroy`(x) -1.2 var x: sink T; stmts var x: sink T; stmts; ensureEmpty(x) -2 x = f() `=sink`(x, f()) -3 x = lastReadOf z `=sink`(x, z) -4.1 y = sinkParam `=sink`(y, sinkParam) -4.2 x = y `=`(x, y) # a copy -5.1 f_sink(g()) f_sink(g()) -5.2 f_sink(y) f_sink(copy y); # copy unless we can see it's the last read -5.3 f_sink(move y) f_sink(y); reset(y) # explicit moves empties 'y' -5.4 f_noSink(g()) var tmp = bitwiseCopy(g()); f(tmp); `=destroy`(tmp) - -Remarks: Rule 1.2 is not yet implemented because ``sink`` is currently - not allowed as a local variable. - -``move`` builtin needs to be implemented. -]## - -import - intsets, ast, astalgo, msgs, renderer, magicsys, types, idents, trees, - strutils, options, dfa, lowerings, tables, modulegraphs, - lineinfos - -const - InterestingSyms = {skVar, skResult, skLet} - -type - Con = object - owner: PSym - g: ControlFlowGraph - jumpTargets: IntSet - tmpObj: PType - tmp: PSym - destroys, topLevelVars: PNode - toDropBit: Table[int, PSym] - graph: ModuleGraph - emptyNode: PNode - -proc getTemp(c: var Con; typ: PType; info: TLineInfo): PNode = - # XXX why are temps fields in an object here? - let f = newSym(skField, getIdent(c.graph.cache, ":d" & $c.tmpObj.n.len), c.owner, info) - f.typ = typ - rawAddField c.tmpObj, f - result = rawDirectAccess(c.tmp, f) - -proc isHarmlessVar*(s: PSym; c: Con): bool = - # 's' is harmless if it used only once and its - # definition/usage are not split by any labels: - # - # let s = foo() - # while true: - # a[i] = s - # - # produces: - # - # def s - # L1: - # use s - # goto L1 - # - # let s = foo() - # if cond: - # a[i] = s - # else: - # a[j] = s - # - # produces: - # - # def s - # fork L2 - # use s - # goto L3 - # L2: - # use s - # L3 - # - # So this analysis is for now overly conservative, but correct. - var defsite = -1 - var usages = 0 - for i in 0..<c.g.len: - case c.g[i].kind - of def: - if c.g[i].sym == s: - if defsite < 0: defsite = i - else: return false - of use: - if c.g[i].sym == s: - if defsite < 0: return false - for j in defsite .. i: - # not within the same basic block? - if j in c.jumpTargets: return false - # if we want to die after the first 'use': - if usages > 1: return false - inc usages - of useWithinCall: - if c.g[i].sym == s: return false - of goto, fork: - discard "we do not perform an abstract interpretation yet" - -template interestingSym(s: PSym): bool = - s.owner == c.owner and s.kind in InterestingSyms and hasDestructor(s.typ) - -proc patchHead(n: PNode) = - if n.kind in nkCallKinds and n[0].kind == nkSym and n.len > 1: - let s = n[0].sym - if s.name.s[0] == '=' and s.name.s in ["=sink", "=", "=destroy"]: - if sfFromGeneric in s.flags: - excl(s.flags, sfFromGeneric) - patchHead(s.getBody) - if n[1].typ.isNil: - # XXX toptree crashes without this workaround. Figure out why. - return - let t = n[1].typ.skipTypes({tyVar, tyLent, tyGenericInst, tyAlias, tySink, tyInferred}) - template patch(op, field) = - if s.name.s == op and field != nil and field != s: - n.sons[0].sym = field - patch "=sink", t.sink - patch "=", t.assignment - patch "=destroy", t.destructor - for x in n: - patchHead(x) - -proc patchHead(s: PSym) = - if sfFromGeneric in s.flags: - patchHead(s.ast[bodyPos]) - -template genOp(opr, opname) = - let op = opr - if op == nil: - globalError(c.graph.config, dest.info, "internal error: '" & opname & "' operator not found for type " & typeToString(t)) - elif op.ast[genericParamsPos].kind != nkEmpty: - globalError(c.graph.config, dest.info, "internal error: '" & opname & "' operator is generic") - patchHead op - result = newTree(nkCall, newSymNode(op), newTree(nkHiddenAddr, dest)) - -proc genSink(c: Con; t: PType; dest: PNode): PNode = - let t = t.skipTypes({tyGenericInst, tyAlias, tySink}) - genOp(if t.sink != nil: t.sink else: t.assignment, "=sink") - -proc genCopy(c: Con; t: PType; dest: PNode): PNode = - let t = t.skipTypes({tyGenericInst, tyAlias, tySink}) - genOp(t.assignment, "=") - -proc genDestroy(c: Con; t: PType; dest: PNode): PNode = - let t = t.skipTypes({tyGenericInst, tyAlias, tySink}) - genOp(t.destructor, "=destroy") - -proc addTopVar(c: var Con; v: PNode) = - c.topLevelVars.add newTree(nkIdentDefs, v, c.emptyNode, c.emptyNode) - -proc dropBit(c: var Con; s: PSym): PSym = - result = c.toDropBit.getOrDefault(s.id) - assert result != nil - -proc registerDropBit(c: var Con; s: PSym) = - let result = newSym(skTemp, getIdent(c.graph.cache, s.name.s & "_AliveBit"), c.owner, s.info) - result.typ = getSysType(c.graph, s.info, tyBool) - let trueVal = newIntTypeNode(nkIntLit, 1, result.typ) - c.topLevelVars.add newTree(nkIdentDefs, newSymNode result, c.emptyNode, trueVal) - c.toDropBit[s.id] = result - # generate: - # if not sinkParam_AliveBit: `=destroy`(sinkParam) - c.destroys.add newTree(nkIfStmt, - newTree(nkElifBranch, newSymNode result, genDestroy(c, s.typ, newSymNode s))) - -proc p(n: PNode; c: var Con): PNode - -template recurse(n, dest) = - for i in 0..<n.len: - dest.add p(n[i], c) - -proc isSinkParam(s: PSym): bool {.inline.} = - result = s.kind == skParam and s.typ.kind == tySink - -const constrExprs = nkCallKinds+{nkObjConstr} - -proc destructiveMoveSink(n: PNode; c: var Con): PNode = - # generate: (chckMove(sinkParam_AliveBit); sinkParam_AliveBit = false; sinkParam) - result = newNodeIT(nkStmtListExpr, n.info, n.typ) - let bit = newSymNode dropBit(c, n.sym) - if optMoveCheck in c.owner.options: - result.add callCodegenProc(c.graph, "chckMove", bit) - result.add newTree(nkAsgn, bit, - newIntTypeNode(nkIntLit, 0, getSysType(c.graph, n.info, tyBool))) - result.add n - -proc moveOrCopy(dest, ri: PNode; c: var Con): PNode = - if ri.kind in constrExprs: - result = genSink(c, ri.typ, dest) - # watch out and no not transform 'ri' twice if it's a call: - let ri2 = copyNode(ri) - recurse(ri, ri2) - result.add ri2 - elif ri.kind == nkSym and isHarmlessVar(ri.sym, c): - result = genSink(c, ri.typ, dest) - result.add p(ri, c) - elif ri.kind == nkSym and isSinkParam(ri.sym): - result = genSink(c, ri.typ, dest) - result.add destructiveMoveSink(ri, c) - else: - result = genCopy(c, ri.typ, dest) - result.add p(ri, c) - -proc passCopyToSink(n: PNode; c: var Con): PNode = - result = newNodeIT(nkStmtListExpr, n.info, n.typ) - let tmp = getTemp(c, n.typ, n.info) - if hasDestructor(n.typ): - var m = genCopy(c, n.typ, tmp) - m.add p(n, c) - result.add m - message(c.graph.config, n.info, hintPerformance, - "passing '$1' to a sink parameter introduces an implicit copy; " & - "use 'move($1)' to prevent it" % $n) - else: - result.add newTree(nkAsgn, tmp, p(n, c)) - result.add tmp - -proc genReset(n: PNode; c: var Con): PNode = - result = newNodeI(nkCall, n.info) - result.add(newSymNode(createMagic(c.graph, "reset", mReset))) - # The mReset builtin does not take the address: - result.add n - -proc destructiveMoveVar(n: PNode; c: var Con): PNode = - # generate: (let tmp = v; reset(v); tmp) - result = newNodeIT(nkStmtListExpr, n.info, n.typ) - - var temp = newSym(skLet, getIdent(c.graph.cache, "blitTmp"), c.owner, n.info) - var v = newNodeI(nkLetSection, n.info) - let tempAsNode = newSymNode(temp) - - var vpart = newNodeI(nkIdentDefs, tempAsNode.info, 3) - vpart.sons[0] = tempAsNode - vpart.sons[1] = c.emptyNode - vpart.sons[2] = n - add(v, vpart) - - result.add v - result.add genReset(n, c) - result.add tempAsNode - -proc p(n: PNode; c: var Con): PNode = - case n.kind - of nkVarSection, nkLetSection: - discard "transform; var x = y to var x; x op y where op is a move or copy" - result = newNodeI(nkStmtList, n.info) - - for i in 0..<n.len: - let it = n[i] - let L = it.len-1 - let ri = it[L] - if it.kind == nkVarTuple and hasDestructor(ri.typ): - let x = lowerTupleUnpacking(c.graph, it, c.owner) - result.add p(x, c) - elif it.kind == nkIdentDefs and hasDestructor(it[0].typ): - for j in 0..L-2: - let v = it[j] - doAssert v.kind == nkSym - # move the variable declaration to the top of the frame: - c.addTopVar v - # make sure it's destroyed at the end of the proc: - c.destroys.add genDestroy(c, v.typ, v) - if ri.kind != nkEmpty: - let r = moveOrCopy(v, ri, c) - result.add r - else: - # keep it, but transform 'ri': - var varSection = copyNode(n) - var itCopy = copyNode(it) - for j in 0..L-1: - itCopy.add it[j] - itCopy.add p(ri, c) - varSection.add itCopy - result.add varSection - of nkCallKinds: - let parameters = n[0].typ - let L = if parameters != nil: parameters.len else: 0 - for i in 1 ..< n.len: - let arg = n[i] - if i < L and parameters[i].kind == tySink: - if arg.kind in nkCallKinds: - # recurse but skip the call expression in order to prevent - # destructor injections: Rule 5.1 is different from rule 5.4! - let a = copyNode(arg) - recurse(arg, a) - n.sons[i] = a - elif arg.kind in {nkObjConstr, nkCharLit..nkFloat128Lit}: - discard "object construction to sink parameter: nothing to do" - elif arg.kind == nkSym and isHarmlessVar(arg.sym, c): - # if x is a variable and it its last read we eliminate its - # destructor invokation, but don't. We need to reset its memory - # to disable its destructor which we have not elided: - n.sons[i] = destructiveMoveVar(arg, c) - elif arg.kind == nkSym and isSinkParam(arg.sym): - # mark the sink parameter as used: - n.sons[i] = destructiveMoveSink(arg, c) - else: - # an object that is not temporary but passed to a 'sink' parameter - # results in a copy. - n.sons[i] = passCopyToSink(arg, c) - else: - n.sons[i] = p(arg, c) - - if n.typ != nil and hasDestructor(n.typ): - discard "produce temp creation" - result = newNodeIT(nkStmtListExpr, n.info, n.typ) - let tmp = getTemp(c, n.typ, n.info) - var sinkExpr = genSink(c, n.typ, tmp) - sinkExpr.add n - result.add sinkExpr - result.add tmp - c.destroys.add genDestroy(c, n.typ, tmp) - else: - result = n - of nkAsgn, nkFastAsgn: - if hasDestructor(n[0].typ): - result = moveOrCopy(n[0], n[1], c) - else: - result = copyNode(n) - recurse(n, result) - of nkNone..nkNilLit, nkTypeSection, nkProcDef, nkConverterDef, nkMethodDef, - nkIteratorDef, nkMacroDef, nkTemplateDef, nkLambda, nkDo, nkFuncDef: - result = n - else: - result = copyNode(n) - recurse(n, result) - -proc injectDestructorCalls*(g: ModuleGraph; owner: PSym; n: PNode): PNode = - when defined(nimDebugDestroys): - echo "injecting into ", n - var c: Con - c.owner = owner - c.tmp = newSym(skTemp, getIdent(g.cache, ":d"), owner, n.info) - c.tmpObj = createObj(g, owner, n.info) - c.tmp.typ = c.tmpObj - c.destroys = newNodeI(nkStmtList, n.info) - c.topLevelVars = newNodeI(nkVarSection, n.info) - c.toDropBit = initTable[int, PSym]() - c.graph = g - c.emptyNode = newNodeI(nkEmpty, n.info) - let cfg = constructCfg(owner, n) - shallowCopy(c.g, cfg) - c.jumpTargets = initIntSet() - for i in 0..<c.g.len: - if c.g[i].kind in {goto, fork}: - c.jumpTargets.incl(i+c.g[i].dest) - if owner.kind in {skProc, skFunc, skMethod, skIterator, skConverter}: - let params = owner.typ.n - for i in 1 ..< params.len: - let param = params[i].sym - if param.typ.kind == tySink: registerDropBit(c, param) - let body = p(n, c) - if c.tmp.typ.n.len > 0: - c.addTopVar(newSymNode c.tmp) - result = newNodeI(nkStmtList, n.info) - if c.topLevelVars.len > 0: - result.add c.topLevelVars - if c.destroys.len > 0: - result.add newTryFinally(body, c.destroys) - else: - result.add body - - when defined(nimDebugDestroys): - if owner.name.s == "main" or true: - echo "------------------------------------" - echo owner.name.s, " transformed to: " - echo result diff --git a/compiler/dfa.nim b/compiler/dfa.nim index 013242f62..5534d07e7 100644 --- a/compiler/dfa.nim +++ b/compiler/dfa.nim @@ -7,268 +7,385 @@ # distribution, for details about the copyright. # -## Data flow analysis for Nim. For now the task is to prove that every -## usage of a local variable 'v' is covered by an initialization to 'v' -## first. +## 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'. -## The case to detect is ``use v`` that is not dominated by -## a ``def v``. +## ## 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, astalgo, types, intsets, tables, msgs, options, lineinfos +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, - useWithinCall # this strange special case is used to get more - # move optimizations out of regular code - # XXX This is still overly pessimistic in - # call(let x = foo; bar(x)) + goto, loop, fork, def, use Instr* = object - n*: PNode case kind*: InstrKind - of def, use, useWithinCall: sym*: PSym - of goto, fork: dest*: int + of goto, fork, loop: dest*: int + of def, use: + n*: PNode # contains the def/use location. ControlFlowGraph* = seq[Instr] TPosition = distinct int - TBlock = object - label: PSym - fixups: seq[TPosition] - ValueKind = enum - undef, value, valueOrUndef + TBlock = object + case isTryBlock: bool + of false: + label: PSym + 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 Con = object code: ControlFlowGraph - inCall: int + inTryStmt, interestingInstructions: int blocks: seq[TBlock] + owner: PSym + root: PSym -proc debugInfo(info: TLineInfo): string = - result = $info.line #info.toFilename & ":" & $info.line - -proc codeListing(c: ControlFlowGraph, result: var string, start=0; last = -1) = +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: if i in jumpTargets: result.add("L" & $i & ":\n") result.add "\t" - result.add $c[i].kind + result.add ($i & " " & $c[i].kind) result.add "\t" case c[i].kind - of def, use, useWithinCall: - result.add c[i].sym.name.s - of goto, fork: + of def, use: + result.add renderTree(c[i].n) + result.add("\t#") + result.add($c[i].n.info.line) + result.add("\n") + of goto, fork, loop: result.add "L" - result.add c[i].dest+i - result.add("\t#") - result.add(debugInfo(c[i].n.info)) - result.add("\n") + result.addInt c[i].dest+i inc i if i in jumpTargets: result.add("L" & $i & ": End\n") - -proc echoCfg*(c: ControlFlowGraph; start=0; last = -1) {.deprecated.} = +proc echoCfg*(c: ControlFlowGraph; start = 0; last = -1) {.deprecated.} = ## echos the ControlFlowGraph for debugging purposes. - var buf = "" - codeListing(c, buf, start, last) - when declared(echo): - echo buf + 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) + c.code.add Instr(kind: goto, dest: 0) -proc genLabel(c: Con): TPosition = - result = TPosition(c.code.len) +proc genLabel(c: Con): TPosition = TPosition(c.code.len) + +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)) = - let dist = p.int - c.code.len - doAssert(-0x7fff < dist and dist < 0x7fff) - c.code.add Instr(n: n, kind: goto, dest: dist) +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 - let p = p.int - let diff = c.code.len - p - doAssert(-0x7fff < diff and diff < 0x7fff) - c.code[p].dest = diff + c.code[p.int].dest = checkedDistance(c.code.len - p.int) + +proc gen(c: var Con; n: PNode) proc popBlock(c: var Con; oldLen: int) = - for f in c.blocks[oldLen].fixups: - c.patch(f) + 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() + for e in exits: + c.patch e c.blocks.setLen(oldLen) -template withBlock(labl: PSym; body: untyped) {.dirty.} = - var oldLen {.gensym.} = c.blocks.len - c.blocks.add TBlock(label: labl, fixups: @[]) +template withBlock(labl: PSym; body: untyped) = + let oldLen = c.blocks.len + c.blocks.add TBlock(isTryBlock: false, label: labl) 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 - -proc gen(c: var Con; n: PNode) # {.noSideEffect.} +template forkT(body) = + let lab1 = c.forkI() + body + c.patch(lab1) proc genWhile(c: var Con; n: PNode) = - # L1: + # lab1: # cond, tmp - # fork tmp, L2 + # fork tmp, lab2 # body - # jmp L1 - # L2: - let L1 = c.genLabel + # jmp lab1 + # lab2: + let lab1 = c.genLabel withBlock(nil): - if isTrue(n.sons[0]): - c.gen(n.sons[1]) - c.jmpBack(n, L1) + if isTrue(n[0]): + c.gen(n[1]) + c.jmpBack(lab1) else: - c.gen(n.sons[0]) - let L2 = c.forkI(n) - c.gen(n.sons[1]) - c.jmpBack(n, L1) - c.patch(L2) - -proc genBlock(c: var Con; n: PNode) = - withBlock(n.sons[0].sym): - c.gen(n.sons[1]) - -proc genBreak(c: var Con; n: PNode) = - let L1 = c.gotoI(n) - if n.sons[0].kind == nkSym: - #echo cast[int](n.sons[0].sym) - for i in countdown(c.blocks.len-1, 0): - if c.blocks[i].label == n.sons[0].sym: - c.blocks[i].fixups.add L1 - return - #globalError(n.info, "VM problem: cannot find 'break' target") - else: - c.blocks[c.blocks.high].fixups.add L1 + c.gen(n[0]) + forkT: + c.gen(n[1]) + c.jmpBack(lab1) proc genIf(c: var Con, n: PNode) = + #[ + + if cond: + A + elif condB: + B + elif condC: + C + else: + D + + cond + fork lab1 + A + goto Lend + lab1: + condB + fork lab2 + B + goto Lend2 + lab2: + condC + fork L3 + C + goto Lend3 + L3: + D + ]# var endings: seq[TPosition] = @[] - for i in countup(0, len(n) - 1): - var it = n.sons[i] - c.gen(it.sons[0]) + 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: - let elsePos = c.forkI(it.sons[1]) - c.gen(it.sons[1]) - if i < sonsLen(n)-1: - endings.add(c.gotoI(it.sons[1])) - c.patch(elsePos) - for endPos in endings: c.patch(endPos) + 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 L1 + # fork lab1 # asgn dest, b - # L1: - c.gen(n.sons[1]) - let L1 = c.forkI(n) - c.gen(n.sons[2]) - c.patch(L1) + # lab1: + c.gen(n[1]) + forkT: + c.gen(n[2]) proc genCase(c: var Con; n: PNode) = - # if (!expr1) goto L1; + # if (!expr1) goto lab1; # thenPart # goto LEnd - # L1: - # if (!expr2) goto L2; + # lab1: + # if (!expr2) goto lab2; # thenPart2 # goto LEnd - # L2: + # lab2: # elsePart # Lend: + let isExhaustive = skipTypes(n[0].typ, + abstractVarRange-{tyTypeDesc}).kind notin {tyFloat..tyFloat128, tyString, tyCstring} + var endings: seq[TPosition] = @[] - c.gen(n.sons[0]) - for i in 1 ..< n.len: - let it = n.sons[i] - if it.len == 1: - c.gen(it.sons[0]) - else: - let elsePos = c.forkI(it.lastSon) + 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 i < sonsLen(n)-1: - endings.add(c.gotoI(it.lastSon)) - c.patch(elsePos) - for endPos in endings: c.patch(endPos) + else: + 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 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() + 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: + for b in countdown(c.blocks.high, i): + if c.blocks[b].isTryBlock: + trailingFinales.add c.blocks[b].finale + + 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: + genBreakOrRaiseAux(c, i, n) + return + #globalError(n.info, "VM problem: cannot find 'break' target") + else: + for i in countdown(c.blocks.high, 0): + if not c.blocks[i].isTryBlock: + genBreakOrRaiseAux(c, i, n) + return proc genTry(c: var Con; n: PNode) = var endings: seq[TPosition] = @[] - let elsePos = c.forkI(n) - c.gen(n.sons[0]) - c.patch(elsePos) - for i in 1 ..< n.len: - let it = n.sons[i] + + let oldLen = c.blocks.len + c.blocks.add TBlock(isTryBlock: true, finale: if n[^1].kind == nkFinally: n[^1] else: newNode(nkEmpty)) + + inc c.inTryStmt + c.gen(n[0]) + dec c.inTryStmt + + for f in c.blocks[oldLen].raiseFixups: + c.patch(f) + + c.blocks.setLen oldLen + + for i in 1..<n.len: + let it = n[i] if it.kind != nkFinally: - var blen = len(it) - let endExcept = c.forkI(it) - c.gen(it.lastSon) - if i < sonsLen(n)-1: - endings.add(c.gotoI(it)) - c.patch(endExcept) - for endPos in endings: c.patch(endPos) + forkT: + c.gen(it.lastSon) + endings.add c.gotoI() + for i in countdown(endings.high, 0): + c.patch(endings[i]) + let fin = lastSon(n) if fin.kind == nkFinally: - c.gen(fin.sons[0]) + c.gen(fin[0]) + +template genNoReturn(c: var Con) = + # leave the graph + c.code.add Instr(kind: goto, dest: high(int) - c.code.len) proc genRaise(c: var Con; n: PNode) = - gen(c, n.sons[0]) - c.code.add Instr(n: n, kind: goto, dest: high(int) - c.code.len) + 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 + else: + 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) = - if n.sons[0].kind != nkEmpty: gen(c, n.sons[0]) - c.code.add Instr(n: n, kind: goto, dest: high(int) - c.code.len) + inc c.interestingInstructions + if n[0].kind != nkEmpty: + gen(c, n[0]) + else: + genImplicitReturn(c) + genBreakOrRaiseAux(c, 0, n) const - InterestingSyms = {skVar, skResult, skLet} - -proc genUse(c: var Con; n: PNode) = - var n = n - while n.kind in {nkDotExpr, nkCheckedFieldExpr, - nkBracketExpr, nkDerefExpr, nkHiddenDeref, - nkAddr, nkHiddenAddr}: - n = n[0] - if n.kind == nkSym and n.sym.kind in InterestingSyms: - if c.inCall > 0: - c.code.add Instr(n: n, kind: useWithinCall, sym: n.sym) - else: - c.code.add Instr(n: n, kind: use, sym: n.sym) + InterestingSyms = {skVar, skResult, skLet, skParam, skForVar, skTemp} + +proc skipTrivials(c: var Con, n: PNode): PNode = + result = n + while true: + case result.kind + of PathKinds0 - {nkBracketExpr}: + result = result[0] + of nkBracketExpr: + gen(c, result[1]) + result = result[0] + of PathKinds1: + result = result[1] + else: break + +proc genUse(c: var Con; orig: PNode) = + let n = c.skipTrivials(orig) + + 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) -proc genDef(c: var Con; n: PNode) = if n.kind == nkSym and n.sym.kind in InterestingSyms: - c.code.add Instr(n: n, kind: def, sym: n.sym) + 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]) var t = n[0].typ if t != nil: t = t.skipTypes(abstractInst) - inc c.inCall for i in 1..<n.len: gen(c, n[i]) - if t != nil and i < t.len and t.sons[i].kind == tyVar: + 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]) - dec c.inCall + # 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: + forkT: + for i in countdown(c.blocks.high, 0): + if c.blocks[i].isTryBlock: + genBreakOrRaiseAux(c, i, n) + break proc genMagic(c: var Con; n: PNode; m: TMagic) = case m @@ -276,170 +393,99 @@ proc genMagic(c: var Con; n: PNode; m: TMagic) = of mNew, mNewFinalize: genDef(c, n[1]) for i in 2..<n.len: gen(c, n[i]) - of mExit: - genCall(c, n) - c.code.add Instr(n: n, kind: goto, dest: high(int) - c.code.len) else: genCall(c, n) proc genVarSection(c: var Con; n: PNode) = for a in n: - if a.kind == nkCommentStmt: continue - if a.kind == nkVarTuple: + if a.kind == nkCommentStmt: + discard + elif a.kind == nkVarTuple: gen(c, a.lastSon) - for i in 0 .. a.len-3: genDef(c, a[i]) + for i in 0..<a.len-2: genDef(c, a[i]) else: gen(c, a.lastSon) if a.lastSon.kind != nkEmpty: - genDef(c, a.sons[0]) + genDef(c, a[0]) proc gen(c: var Con; n: PNode) = case n.kind of nkSym: genUse(c, n) of nkCallKinds: - if n.sons[0].kind == nkSym: - let s = n.sons[0].sym + if n[0].kind == nkSym: + let s = n[0].sym if s.magic != mNone: genMagic(c, n, s.magic) else: genCall(c, n) + if sfNoReturn in n[0].sym.flags: + 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'. genDef(c, n[0]) - of nkDotExpr, nkCheckedFieldExpr, nkBracketExpr, - nkDerefExpr, nkHiddenDeref, nkAddr, nkHiddenAddr: - gen(c, n[0]) + of PathKinds0 - {nkObjDownConv, nkObjUpConv}: + genUse(c, n) of nkIfStmt, nkIfExpr: genIf(c, n) of nkWhenStmt: # This is "when nimvm" node. Chose the first branch. - gen(c, n.sons[0].sons[1]) + gen(c, n[0][1]) of nkCaseStmt: genCase(c, n) of nkWhileStmt: genWhile(c, n) of nkBlockExpr, nkBlockStmt: genBlock(c, n) of nkReturnStmt: genReturn(c, n) of nkRaiseStmt: genRaise(c, n) of nkBreakStmt: genBreak(c, n) - of nkTryStmt: genTry(c, n) + of nkTryStmt, nkHiddenTryStmt: genTry(c, n) of nkStmtList, nkStmtListExpr, nkChckRangeF, nkChckRange64, nkChckRange, - nkBracket, nkCurly, nkPar, nkTupleConstr, nkClosure, nkObjConstr: + nkBracket, nkCurly, nkPar, nkTupleConstr, nkClosure, nkObjConstr, nkYieldStmt: for x in n: gen(c, x) of nkPragmaBlock: gen(c, n.lastSon) - of nkDiscardStmt: gen(c, n.sons[0]) - of nkHiddenStdConv, nkHiddenSubConv, nkConv, nkExprColonExpr, nkExprEqExpr, - nkCast: - gen(c, n.sons[1]) - of nkObjDownConv, nkStringToCString, nkCStringToString: gen(c, n.sons[0]) + of nkDiscardStmt, nkObjDownConv, nkObjUpConv, nkStringToCString, nkCStringToString: + gen(c, n[0]) + of nkConv, nkExprColonExpr, nkExprEqExpr, nkCast, PathKinds1: + gen(c, n[1]) of nkVarSection, nkLetSection: genVarSection(c, n) + of nkDefer: raiseAssert "dfa construction pass requires the elimination of 'defer'" else: discard -proc dfa(code: seq[Instr]; conf: ConfigRef) = - var u = newSeq[IntSet](code.len) # usages - var d = newSeq[IntSet](code.len) # defs - var c = newSeq[IntSet](code.len) # consumed - var backrefs = initTable[int, int]() - for i in 0..<code.len: - u[i] = initIntSet() - d[i] = initIntSet() - c[i] = initIntSet() - case code[i].kind - of use, useWithinCall: u[i].incl(code[i].sym.id) - of def: d[i].incl(code[i].sym.id) - of fork, goto: - let d = i+code[i].dest - backrefs.add(d, i) - - var w = @[0] - var maxIters = 50 - var someChange = true - var takenGotos = initIntSet() - var consuming = -1 - while w.len > 0 and maxIters > 0: # and someChange: - dec maxIters - var pc = w.pop() # w[^1] - var prevPc = -1 - # this simulates a single linear control flow execution: - while pc < code.len: - if prevPc >= 0: - someChange = false - # merge step and test for changes (we compute the fixpoints here): - # 'u' needs to be the union of prevPc, pc - # 'd' needs to be the intersection of 'pc' - for id in u[prevPc]: - if not u[pc].containsOrIncl(id): - someChange = true - # in (a; b) if ``a`` sets ``v`` so does ``b``. The intersection - # is only interesting on merge points: - for id in d[prevPc]: - if not d[pc].containsOrIncl(id): - someChange = true - # if this is a merge point, we take the intersection of the 'd' sets: - if backrefs.hasKey(pc): - var intersect = initIntSet() - assign(intersect, d[pc]) - var first = true - for prevPc in backrefs.allValues(pc): - for def in d[pc]: - if def notin d[prevPc]: - excl(intersect, def) - someChange = true - when defined(debugDfa): - echo "Excluding ", pc, " prev ", prevPc - assign d[pc], intersect - if consuming >= 0: - if not c[pc].containsOrIncl(consuming): - someChange = true - consuming = -1 - - # our interpretation ![I!]: - prevPc = pc - case code[pc].kind - of goto: - # we must leave endless loops eventually: - if not takenGotos.containsOrIncl(pc) or someChange: - pc = pc + code[pc].dest - else: - inc pc - of fork: - # we follow the next instruction but push the dest onto our "work" stack: - #if someChange: - w.add pc + code[pc].dest - inc pc - of use, useWithinCall: - #if not d[prevPc].missingOrExcl(): - # someChange = true - consuming = code[pc].sym.id - inc pc - of def: - if not d[pc].containsOrIncl(code[pc].sym.id): - someChange = true - inc pc - - when defined(useDfa) and defined(debugDfa): - for i in 0..<code.len: - echo "PC ", i, ": defs: ", d[i], "; uses ", u[i], "; consumes ", c[i] - - # now check the condition we're interested in: - for i in 0..<code.len: - case code[i].kind - of use, useWithinCall: - let s = code[i].sym - if s.id notin d[i]: - localError(conf, code[i].n.info, "usage of uninitialized variable: " & s.name.s) - if s.id in c[i]: - localError(conf, code[i].n.info, "usage of an already consumed variable: " & s.name.s) - - else: discard - -proc dataflowAnalysis*(s: PSym; body: PNode; conf: ConfigRef) = - var c = Con(code: @[], blocks: @[]) - gen(c, body) - when defined(useDfa) and defined(debugDfa): echoCfg(c.code) - dfa(c.code, conf) - -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: @[]) - shallowCopy(result, c.code) + var c = Con(code: @[], blocks: @[], owner: s, root: root) + withBlock(s): + gen(c, body) + 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 d463dc3c0..8e5f5e4e7 100644 --- a/compiler/docgen.nim +++ b/compiler/docgen.nim @@ -7,95 +7,350 @@ # distribution, for details about the copyright. # -# This is the documentation generator. It is currently pretty simple: No -# semantic checking is done for the code. 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, times, - packages/docutils/highlite, sempass2, json, xmltree, cgi, - typesrenderer, astalgo, modulepaths, lineinfos + 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 + +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 + exportSection = skField + docCmdSkip = "skip" + 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 - toc, section: TSections + modDescPre: ItemPre # module description, not finalized + modDescFinal: string # module description, after RST pass 2 and rendering + module: PSym + 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 + emitted: IntSet # we need to track which symbols have been emitted + # already. See bug #3655 + 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 presentationPath*(conf: ConfigRef, file: AbsoluteFile): RelativeFile = + ## returns a relative file that will be appended to outDir + let file2 = $file + template bail() = + result = relativeTo(file, conf.projectPath) + proc nimbleDir(): AbsoluteDir = + getNimbleFile(conf, file2).parentDir.AbsoluteDir + case conf.docRoot: + of docRootDefault: + result = getRelativePathFromConfigPath(conf, file) + let dir = nimbleDir() + if not dir.isEmpty: + let result2 = relativeTo(file, dir) + if not result2.isEmpty and (result.isEmpty or result2.string.len < result.string.len): + result = result2 + if result.isEmpty: bail() + of "@pkg": + let dir = nimbleDir() + if dir.isEmpty: bail() + else: result = relativeTo(file, dir) + of "@path": + result = getRelativePathFromConfigPath(conf, file) + 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 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` + result = file.relativeTo conf.docRoot.expandFilename.AbsoluteDir + else: + bail() + if isAbsolute(result.string): + result = file.string.splitPath()[1].RelativeFile + result = result.string.replace("..", dotdotMangle).RelativeFile + doAssert not result.isEmpty + doAssert not isAbsolute(result.string) + proc whichType(d: PDoc; n: PNode): PSym = if n.kind == nkSym: if d.types.strTableContains(n.sym): result = n.sym + else: + result = nil else: - for i in 0..<safeLen(n): + 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 = - let params = p.ast.sons[paramsPos] - # first check the first parameter, then the return type, - # then the other parameter: + result = nil + let params = p.ast[paramsPos] template check(i) = result = whichType(d, params[i]) if result != nil: return result + # first check the first parameter, then the return type, + # then the other parameter: if params.len > 1: check(1) 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) {.procvar.} = + msgKind: rst.MsgKind, arg: string) {.gcsafe.} = # translate msg kind: var k: TMsgKind case msgKind of meCannotOpenFile: k = errCannotOpenFile of meExpected: k = errXExpected - of meGridTableNotImplemented: k = errGridTableNotImplemented - of meNewSectionExpected: k = errNewSectionExpected - of meGeneralParseError: k = errGeneralParseError - of meInvalidDirective: k = errInvalidDirectiveX - of mwRedefinitionOfLabel: k = warnRedefinitionOfLabel - of mwUnknownSubstitution: k = warnUnknownSubstitutionX - of mwUnsupportedLanguage: k = warnLanguageXNotSupported - of mwUnsupportedField: k = warnFieldXNotSupported - globalError(conf, newLineInfo(conf, filename, line, col), k, arg) - - proc docgenFindFile(s: string): string {.procvar.} = - result = options.findFile(conf, s) + 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.}: + 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 if result.len == 0: result = getCurrentDir() / s - if not existsFile(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 newDocumentor*(filename: string; cache: IdentCache; conf: ConfigRef): PDoc = - declareClosures() + if not fileExists(result): result = "" + + 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 = + if optWholeProject in conf.globalOptions or guessTarget: + let d = conf.outDir + createDir(d) + result = d / changeFileExt(filename, ext) + elif not conf.outFile.isEmpty: + result = absOutFile(conf) + else: + result = getOutFile(conf, filename, ext) + +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 - initRstGenerator(result[], (if conf.cmd != cmdRst2tex: outHtml else: outLatex), - conf.configVars, filename, {roSupportRawDirective}, + result.outDir = conf.outDir.string + 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> @@ -109,103 +364,108 @@ proc newDocumentor*(filename: string; cache: IdentCache; conf: ConfigRef): PDoc </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.onTestSnippet = proc (d: var RstGenerator; filename, cmd: string; status: int; content: string) = - localError(conf, newLineInfo(conf, d.filename, -1, -1), warnUser, "only 'rst2html' supports the ':test:' attribute") - -proc dispA(conf: ConfigRef; dest: var Rope, xml, tex: string, args: openArray[Rope]) = - if conf.cmd != cmdRst2tex: addf(dest, xml, args) - else: addf(dest, tex, args) + result.jEntriesFinal = newJArray() + result.types = initStrTable() + result.onTestSnippet = + proc (gen: var RstGenerator; filename, cmd: string; status: int; content: string) {.gcsafe.} = + if conf.docCmd == docCmdSkip: return + inc(gen.id) + var d = (ptr TDocumentor)(addr gen) + var outp: AbsoluteFile + if filename.len == 0: + let nameOnly = splitFile(d.filename).name + # "snippets" needed, refs bug #17183 + outp = getNimcacheDir(conf) / "snippets".RelativeDir / RelativeDir(nameOnly) / + RelativeFile(nameOnly & "_snippet_" & $d.id & ".nim") + elif isAbsolute(filename): + outp = AbsoluteFile(filename) + else: + # Nim's convention: every path is relative to the file it was written in: + let nameOnly = splitFile(d.filename).name + outp = AbsoluteDir(nameOnly) / RelativeFile(filename) + # 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.standaloneDoc: "" else: "import \"$1\"\n" % [d.filename.replace("\\", "/")] + writeFile(outp, importStmt & content) + + proc interpSnippetCmd(cmd: string): string = + # backward compatibility hacks; interpolation commands should explicitly use `$` + if cmd.startsWith "nim ": result = "$nim " & cmd[4..^1] + else: result = cmd + # factor with D20210224T221756 + result = result.replace("$1", "$options") % [ + "nim", os.getAppFilename().quoteShell, + "libpath", quoteShell(d.conf.libpath), + "docCmd", d.conf.docCmd, + "backend", $d.conf.backend, + "options", outp.quoteShell, + # xxx `quoteShell` seems buggy if user passes options = "-d:foo somefile.nim" + ] + let cmd = cmd.interpSnippetCmd + rawMessage(conf, hintExecuting, cmd) + let (output, gotten) = execCmdEx(cmd) + 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 = destFile + result.thisDir = result.destFile.AbsoluteFile.splitFile.dir + +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 = - for i in countup(0, high(varnames)): + for i in 0..high(varnames): if cmpIgnoreStyle(varnames[i], id) == 0: return i result = -1 -proc ropeFormatNamedVars(conf: ConfigRef; frmt: FormatStr, - varnames: openArray[string], - varvalues: openArray[Rope]): Rope = - var i = 0 - var L = len(frmt) - result = nil - var num = 0 - while i < L: - if frmt[i] == '$': - inc(i) # skip '$' - case frmt[i] - of '#': - add(result, varvalues[num]) - inc(num) - inc(i) - of '$': - add(result, "$") - inc(i) - of '0'..'9': - var j = 0 - while true: - j = (j * 10) + ord(frmt[i]) - ord('0') - inc(i) - if (i > L + 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 - add(result, varvalues[j - 1]) - of 'A'..'Z', 'a'..'z', '\x80'..'\xFF': - var id = "" - while true: - add(id, frmt[i]) - inc(i) - if not (frmt[i] in {'A'..'Z', '_', 'a'..'z', '\x80'..'\xFF'}): break - var idx = getVarIdx(varnames, id) - if idx >= 0: add(result, varvalues[idx]) - else: rawMessage(conf, errGenerated, "unknown substition variable: " & id) - of '{': - var id = "" - inc(i) - while i < frmt.len and frmt[i] != '}': - add(id, 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: add(result, varvalues[idx]) - else: rawMessage(conf, errGenerated, "unknown substition variable: " & id) - else: - add(result, "$") - var start = i - while i < L: - if frmt[i] != '$': inc(i) - else: break - if i - 1 >= start: add(result, substr(frmt, start, i - 1)) - -proc genComment(d: PDoc, n: PNode): string = - result = "" - var dummyHasToc: bool - if n.comment != nil: - renderRstToOut(d[], parseRst(n.comment, toFilename(d.conf, n.info), - toLinenumber(n.info), toColumn(n.info), - dummyHasToc, d.options, d.conf), result) +proc genComment(d: PDoc, n: PNode): PRstNode = + if n.comment.len > 0: + 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 genRecComment(d: PDoc, n: PNode): Rope = +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 notin {nkEmpty..nkNilLit, nkEnumTy, nkTupleTy}: - for i in countup(0, len(n)-1): - result = genRecComment(d, n.sons[i]) + 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]) if result != nil: return else: - n.comment = nil + n.comment = "" + +proc genRecComment(d: PDoc, n: PNode): PRstNode = + if n == nil: return nil + result = genComment(d, n) + if result == nil: + if n.kind in {nkProcDef, nkFuncDef, nkMethodDef, nkIteratorDef, + nkMacroDef, nkTemplateDef, nkConverterDef}: + result = genRecCommentAux(d, n[bodyPos]) + else: + result = genRecCommentAux(d, n) proc getPlainDocstring(n: PNode): string = ## Gets the plain text docstring of a node non destructively. @@ -213,59 +473,95 @@ proc getPlainDocstring(n: PNode): string = ## You need to call this before genRecComment, whose side effects are removal ## of comments from the tree. The proc will recursively scan and return all ## the concatenated ``##`` comments of the node. - result = "" - if n == nil: return - if n.comment != nil and startsWith(n.comment, "##"): + if n == nil: result = "" + elif startsWith(n.comment, "##"): result = n.comment - if result.len < 1: - for i in countup(0, safeLen(n)-1): - result = getPlainDocstring(n.sons[i]) + else: + result = "" + for i in 0..<n.safeLen: + result = getPlainDocstring(n[i]) if result.len > 0: return -proc nodeToHighlightedHtml(d: PDoc; n: PNode; result: var Rope; renderFlags: TRenderFlags = {}) = - var r: TSrcGen +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) + let tmp = getOutFile2(d.conf, presentationPath(d.conf, full), HtmlExt, sfMainModule notin module.flags) + result = relativeTo(tmp, d.thisDir, '/').string + else: + result = extractFilename toFullPath(d.conf, FileIndex module.position) + +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 = esc(d.target, literal) while true: getNextTok(r, kind, literal) + inc tokenPos case kind of tkEof: break of tkComment: dispA(d.conf, result, "<span class=\"Comment\">$1</span>", "\\spanComment{$1}", - [rope(esc(d.target, literal))]) + [escLit]) of tokKeywordLow..tokKeywordHigh: + 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}", - [rope(esc(d.target, literal))]) - of tkStrLit..tkTripleStrLit: + [escLit]) + of tkStrLit..tkTripleStrLit, tkCustomLit: dispA(d.conf, result, "<span class=\"StringLit\">$1</span>", - "\\spanStringLit{$1}", [rope(esc(d.target, literal))]) + "\\spanStringLit{$1}", [escLit]) of tkCharLit: dispA(d.conf, result, "<span class=\"CharLit\">$1</span>", "\\spanCharLit{$1}", - [rope(esc(d.target, literal))]) + [escLit]) of tkIntLit..tkUInt64Lit: dispA(d.conf, result, "<span class=\"DecNumber\">$1</span>", - "\\spanDecNumber{$1}", [rope(esc(d.target, literal))]) + "\\spanDecNumber{$1}", [escLit]) of tkFloatLit..tkFloat128Lit: dispA(d.conf, result, "<span class=\"FloatNumber\">$1</span>", - "\\spanFloatNumber{$1}", [rope(esc(d.target, literal))]) + "\\spanFloatNumber{$1}", [escLit]) of tkSymbol: - dispA(d.conf, result, "<span class=\"Identifier\">$1</span>", - "\\spanIdentifier{$1}", [rope(esc(d.target, literal))]) + let s = getTokSym(r) + # -2 because of the whitespace in between: + 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 + 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>", + [changeFileExt(external, "html"), literal, + escLit] + else: + dispA(d.conf, result, "<span class=\"Identifier\">$1</span>", + "\\spanIdentifier{$1}", [escLit]) of tkSpaces, tkInvalid: - add(result, literal) - of tkCurlyDotLe: - dispA(d.conf, result, """<span class="Other pragmabegin">$1</span><div class="pragma">""", - "\\spanOther{$1}", - [rope(esc(d.target, literal))]) - of tkCurlyDotRi: - dispA(d.conf, result, "</div><span class=\"Other pragmaend\">$1</span>", - "\\spanOther{$1}", - [rope(esc(d.target, literal))]) + result.add(literal) + of tkHideableStart: + template fun(s) = dispA(d.conf, result, s, "\\spanOther{$1}", [escLit]) + if renderRunnableExamples in renderFlags: fun "$1" + else: + # 1st span is required for the JS to work properly + fun """ +<span> +<span class="Other pragmadots">...</span> +</span> +<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>" + 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, @@ -273,109 +569,301 @@ proc nodeToHighlightedHtml(d: PDoc; n: PNode; result: var Rope; renderFlags: TRe tkGStrLit, tkGTripleStrLit, tkInfixOpr, tkPrefixOpr, tkPostfixOpr, tkBracketLeColon: dispA(d.conf, result, "<span class=\"Other\">$1</span>", "\\spanOther{$1}", - [rope(esc(d.target, literal))]) + [escLit]) + +proc exampleOutputDir(d: PDoc): AbsoluteDir = d.conf.getNimcacheDir / RelativeDir"runnableExamples" + +proc runAllExamples(d: PDoc) = + # This used to be: `let backend = if isDefined(d.conf, "js"): "js"` (etc), however + # using `-d:js` (etc) cannot work properly, e.g. would fail with `importjs` + # since semantics are affected by `config.backend`, not by isDefined(d.conf, "js") + let outputDir = d.exampleOutputDir + for _, group in d.exampleGroups: + if group.docCmd == docCmdSkip: continue + let outp = outputDir / RelativeFile("$1_group$2_examples.nim" % [d.filename.splitFile.name, $group.index]) + group.code = "# autogenerated by docgen\n# source: $1\n# rdoccmd: $2\n$3" % [d.filename, group.rdoccmd, group.code] + writeFile(outp, group.code) + # most useful semantics is that `docCmd` comes after `rdoccmd`, so that we can (temporarily) override + # via command line + # D20210224T221756:here + 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, + "pathArgs", pathArgs, + "libpath", quoteShell(d.conf.libpath), + "nimcache", quoteShell(outputDir), + "file", quoteShell(outp), + "rdoccmd", group.rdoccmd, + "docCmd", group.docCmd, + ] + 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 = "" + result.addQuoted(a) + +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") + if n.len == 3: + let n1 = n[1] + # xxx this should be evaluated during sempass + if n1.kind notin nkStrKinds: globalError(d.conf, n1.info, "string litteral expected") + rdoccmd = n1.strVal + + let useRenderModule = false + let loc = d.conf.toFileLineCol(n.info) + let code = extractRunnableExamplesSource(d.conf, n) + + if d.conf.errorCounter > 0: + return (rdoccmd, code) + + let comment = "autogenerated by docgen\nloc: $1\nrdoccmd: $2" % [loc, rdoccmd] + let outputDir = d.exampleOutputDir + createDir(outputDir) + inc 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 + + # buggy, refs bug #17292 + # still worth fixing as it can affect other code relying on `renderModule`, + # so we keep this code path here for now, which could still be useful in some + # other situations. + renderModule(runnableExamples, outp.string, conf = d.conf) + + else: + 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 = """ +#[ +$# +]# +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 + + 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}: + result.add copyTree(n) + n.kind = nkEmpty + return + for i in 0..<n.safeLen: extractImports(n[i], result) + let imports = newTree(nkStmtList) + var savedLastSon = copyTree n.lastSon + extractImports(savedLastSon, imports) + for imp in imports: runnableExamples.add imp + runnableExamples.add newTree(nkBlockStmt, newNode(nkEmpty), copyTree savedLastSon) + +type RunnableState = enum + rsStart + rsComment + rsRunnable + rsDone + +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; + the logic is easy to change but currently a doc comment following another doc comment + will not render, to avoid rendering in following case: + + proc fn* = + runnableExamples: discard + ## d1 + runnableExamples: discard + ## d2 + + ## internal explanation # <- this one should be out; it's part of rest of function body and would likey not make sense in doc comment + discard # some code + ]## -proc getAllRunnableExamples(d: PDoc; n: PNode; dest: var Rope) = case n.kind + of nkCommentStmt: + if state in {rsStart, rsRunnable}: + dest.add genRecComment(d, n) + return rsComment of nkCallKinds: - if n[0].kind == nkSym and n[0].sym.magic == mRunnableExamples and + if isRunnableExamples(n[0]) and n.len >= 2 and n.lastSon.kind == nkStmtList: - dispA(d.conf, dest, "\n<strong class=\"examples_text\">$1</strong>\n", - "\n\\textbf{$1}\n", [rope"Examples:"]) - inc d.listingCounter - let id = $d.listingCounter - dest.add(d.config.getOrDefault"doc.listing_start" % [id, "langNim"]) - # this is a rather hacky way to get rid of the initial indentation - # that the renderer currently produces: - var i = 0 - var body = n.lastSon - if body.len == 1 and body.kind == nkStmtList and - body.lastSon.kind == nkStmtList: - body = body.lastSon - for b in body: - if i > 0: dest.add "\n" - inc i - nodeToHighlightedHtml(d, b, dest, {}) - dest.add(d.config.getOrDefault"doc.listing_end" % id) - else: discard - for i in 0 ..< n.safeLen: - getAllRunnableExamples(d, n[i], dest) - -when false: - proc findDocComment(n: PNode): PNode = - if n == nil: return nil - if not isNil(n.comment) and startsWith(n.comment, "##"): return n - for i in countup(0, safeLen(n)-1): - result = findDocComment(n.sons[i]) - if result != nil: return - - proc extractDocComment*(s: PSym, d: PDoc): string = - let n = findDocComment(s.ast) - result = "" - if not n.isNil: - if not d.isNil: - var dummyHasToc: bool - renderRstToOut(d[], parseRst(n.comment, toFilename(d.conf, n.info), - toLinenumber(n.info), toColumn(n.info), - dummyHasToc, d.options + {roSkipPounds}), - result) + 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: - result = n.comment.substr(2).replace("\n##", "\n").strip + 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 + # and runnableExamples that occur after some code in routine + +proc getRoutineBody(n: PNode): PNode = + ##[ + nim transforms these quite differently: + + proc someType*(): int = + ## foo + result = 3 +=> + result = + ## foo + 3; + + proc someType*(): int = + ## foo + 3 +=> + ## foo + result = 3; + + so we normalize the results to get to the statement list containing the + (0 or more) doc comments and runnableExamples. + ]## + result = n[bodyPos] + + # This won't be transformed: result.id = 10. Namely result[0].kind != nkSym. + if result.kind == nkAsgn and result[0].kind == nkSym and + n.len > bodyPos+1 and n[bodyPos+1].kind == nkSym: + doAssert result.len == 2 + result = result[1] + +proc getAllRunnableExamples(d: PDoc, n: PNode, dest: var ItemPre) = + var n = n + var state = rsStart + 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, topLevel = false) + else: + for i in 0..<n.safeLen: + fn(n[i], topLevel = false) + if state == rsDone: discard # check all sons + else: fn(n, topLevel = true) -proc isVisible(n: PNode): bool = +proc isVisible(d: PDoc; n: PNode): bool = result = false if n.kind == nkPostfix: - if n.len == 2 and n.sons[0].kind == nkIdent: - var v = n.sons[0].ident + if n.len == 2 and n[0].kind == nkIdent: + var v = n[0].ident result = v.id == ord(wStar) or v.id == ord(wMinus) elif n.kind == nkSym: # we cannot generate code for forwarded symbols here as we have no # exception tracking information here. Instead we copy over the comment # from the proc header. - result = {sfExported, sfFromGeneric, sfForward}*n.sym.flags == {sfExported} + if optDocInternal in d.conf.globalOptions: + result = {sfFromGeneric, sfForward}*n.sym.flags == {} + else: + result = {sfExported, sfFromGeneric, sfForward}*n.sym.flags == {sfExported} + if result and containsOrIncl(d.emitted, n.sym.id): + result = false elif n.kind == nkPragmaExpr: - result = isVisible(n.sons[0]) + 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.sons[1], splitAfter) - of nkPragmaExpr: result = getName(d, n.sons[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.sons[1]) - of nkPragmaExpr: result = getNameIdent(cache, n.sons[0]) + of nkPostfix: result = getNameIdent(cache, n[1]) + of nkPragmaExpr: result = getNameIdent(cache, n[0]) of nkSym: result = n.sym.name of nkIdent: result = n.ident of nkAccQuoted: 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 proc getRstName(n: PNode): PRstNode = case n.kind - of nkPostfix: result = getRstName(n.sons[1]) - of nkPragmaExpr: result = getRstName(n.sons[0]) - of nkSym: result = newRstNode(rnLeaf, n.sym.renderDefinitionName) - of nkIdent: result = newRstNode(rnLeaf, n.ident.s) + of nkPostfix: result = getRstName(n[1]) + of nkPragmaExpr: result = getRstName(n[0]) + of nkSym: result = newRstLeaf(n.sym.renderDefinitionName) + of nkIdent: result = newRstLeaf(n.ident.s) of nkAccQuoted: - result = getRstName(n.sons[0]) - for i in 1 ..< n.len: result.text.add(getRstName(n[i]).text) - of nkOpenSymChoice, nkClosedSymChoice: + result = getRstName(n[0]) + for i in 1..<n.len: result.text.add(getRstName(n[i]).text) + of nkOpenSymChoice, nkClosedSymChoice, nkOpenSym: result = getRstName(n[0]) else: result = nil @@ -389,10 +877,8 @@ proc newUniquePlainSymbol(d: PDoc, original: string): string = result = original d.seenSymbols[original] = "" return - # Iterate over possible numeric variants of the original name. var count = 2 - while true: result = original & "_" & $count if not d.seenSymbols.hasKey(result): @@ -400,7 +886,6 @@ proc newUniquePlainSymbol(d: PDoc, original: string): string = break count += 1 - proc complexName(k: TSymKind, n: PNode, baseName: string): string = ## Builds a complex unique href name for the node. ## @@ -412,36 +897,28 @@ 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: result.add(defaultParamSeparator) - of skMacro: result.add(".m" & defaultParamSeparator) - of skMethod: result.add(".e" & defaultParamSeparator) - of skIterator: result.add(".i" & defaultParamSeparator) - of skTemplate: result.add(".t" & defaultParamSeparator) - of skConverter: result.add(".c" & defaultParamSeparator) + case k + of skProc, skFunc: discard + of skMacro: result.add(".m") + of skMethod: result.add(".e") + of skIterator: result.add(".i") + of skTemplate: result.add(".t") + of skConverter: result.add(".c") else: discard - - if len(n) > paramsPos and n[paramsPos].kind == nkFormalParams: - result.add(renderParamTypes(n[paramsPos])) - - -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 - + if n.safeLen > paramsPos and n[paramsPos].kind == nkFormalParams: + let params = renderParamTypes(n[paramsPos]) + if params.len > 0: + result.add(defaultParamSeparator) + result.add(params) proc docstringSummary(rstText: string): string = ## Returns just the first line or a brief chunk of text from a rst string. ## ## Most docstrings will contain a one liner summary, so stripping at the ## first newline is usually fine. If after that the content is still too big, - ## it is stripped at the first comma, colon or dot, usual english sentence + ## it is stripped at the first comma, colon or dot, usual English sentence ## separators. ## ## No guarantees are made on the size of the output, but it should be small. @@ -452,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 @@ -460,114 +937,323 @@ 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): 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 = getConfigVar(d.conf, "doc.deprecationmsg") % [ + "label" , "Deprecated", "message", ""] + of 2: # Deprecated w/ a message + if n[1].kind in {nkStrLit..nkTripleStrLit}: + result = getConfigVar(d.conf, "doc.deprecationmsg") % [ + "label", "Deprecated:", "message", xmltree.escape(n[1].strVal)] + else: + result = "" + else: + raiseAssert "unreachable" + +type DocFlags = enum + kDefault + kForceExport + +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(), '/') + when false: + let cwd = canonicalizePath(d.conf, getCurrentDir()) + var path = path + if path.startsWith(cwd): + path = path[cwd.len+1..^1].replace('\\', '/') + let gitUrl = getConfigVar(d.conf, "git.url") + if gitUrl.len > 0: + let defaultBranch = + if NimPatch mod 2 == 1: "devel" + 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", "", [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) = - if not isVisible(nameNode): return + 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 = genRecComment(d, n) # call this here for the side-effect! - getAllRunnableExamples(d, n, comm) - var r: TSrcGen + var comm: ItemPre = default(ItemPre) + if n.kind in routineDefs: + getAllRunnableExamples(d, n, comm) + else: + comm.add genRecComment(d, n) + # 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) - # Render the HTML hyperlink. - nodeToHighlightedHtml(d, n, result, {renderNoBody, renderNoComments, renderDocComments}) + 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 - - var seeSrcRope: Rope = nil - let docItemSeeSrc = getConfigVar(d.conf, "doc.item.seesrc") - if docItemSeeSrc.len > 0: - let cwd = canonicalizePath(d.conf, getCurrentDir()) - var path = toFullPath(d.conf, n.info) - if path.startsWith(cwd): - path = path[cwd.len+1 .. ^1].replace('\\', '/') - let gitUrl = getConfigVar(d.conf, "git.url") - if gitUrl.len > 0: - var commit = getConfigVar(d.conf, "git.commit") - if commit.len == 0: commit = "master" - dispA(d.conf, seeSrcRope, "$1", "", [ropeFormatNamedVars(d.conf, docItemSeeSrc, - ["path", "line", "url", "commit"], [rope path, - rope($n.info.line), rope gitUrl, - rope commit])]) - - add(d.section[k], ropeFormatNamedVars(d.conf, getConfigVar(d.conf, "doc.item"), - ["name", "header", "desc", "itemID", "header_plain", "itemSym", - "itemSymOrID", "itemSymEnc", "itemSymOrIDEnc", "seeSrc"], - [nameRope, result, comm, itemIDRope, plainNameRope, plainSymbolRope, - symbolOrIdRope, plainSymbolEncRope, symbolOrIdEncRope, seeSrcRope])) - - var attype: Rope - if k in routineKinds and nameNode.kind == nkSym: + 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 = "" + 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) - add(d.toc[k], ropeFormatNamedVars(d.conf, getConfigVar(d.conf, "doc.item.toc"), - ["name", "header", "desc", "itemID", "header_plain", "itemSym", - "itemSymOrID", "itemSymEnc", "itemSymOrIDEnc", "attype"], - [rope(getName(d, nameNode, d.splitAfter)), result, comm, - itemIDRope, plainNameRope, plainSymbolRope, symbolOrIdRope, - plainSymbolEncRope, symbolOrIdEncRope, attype])) - - # 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[], 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 = - if not isVisible(nameNode): return + 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[], 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 + 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.json["code"] = %r.buf + if k in routineKinds: + result.json["signature"] = newJObject() + if n[paramsPos][0].kind != nkEmpty: + result.json["signature"]["return"] = %($n[paramsPos][0]) + if n[paramsPos].len > 1: + result.json["signature"]["arguments"] = newJArray() + for paramIdx in 1 ..< n[paramsPos].len: + for identIdx in 0 ..< n[paramsPos][paramIdx].len - 2: + let + paramName = $n[paramsPos][paramIdx][identIdx] + paramType = $n[paramsPos][paramIdx][^2] + if n[paramsPos][paramIdx][^1].kind != nkEmpty: + let paramDefault = $n[paramsPos][paramIdx][^1] + result.json["signature"]["arguments"].add %{"name": %paramName, "type": %paramType, "default": %paramDefault} + else: + result.json["signature"]["arguments"].add %{"name": %paramName, "type": %paramType} + if n[pragmasPos].kind != nkEmpty: + result.json["signature"]["pragmas"] = newJArray() + for pragma in n[pragmasPos]: + result.json["signature"]["pragmas"].add %($pragma) + if n[genericParamsPos].kind != nkEmpty: + result.json["signature"]["genericParams"] = newJArray() + for genericParam in n[genericParamsPos]: + var param = %{"name": %($genericParam)} + if genericParam.sym.typ.len > 0: + param["types"] = newJArray() + param["types"] = %($genericParam.sym.typ.elementType) + result.json["signature"]["genericParams"].add param + if optGenIndex in d.conf.globalOptions: + genItem(d, n, nameNode, k, kForceExport) - initTokRender(r, n, {renderNoBody, renderNoComments, renderDocComments}) - - result = %{ "name": %name, "type": %($k), "line": %n.info.line.int, - "col": %n.info.col} - if comm != nil and comm != "": - result["description"] = %comm - if r.buf != nil: - result["code"] = %r.buf +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 proc traceDeps(d: PDoc, it: PNode) = const k = skModule - if it.kind == nkInfix and it.len == 3 and it[2].kind == nkBracket: let sep = it[0] let dir = it[1] @@ -576,328 +1262,693 @@ proc traceDeps(d: PDoc, it: PNode) = a.add dir a.add sep # dummy entry, replaced in the loop for x in it[2]: - a.sons[2] = x + a[2] = x traceDeps(d, a) + elif it.kind == nkSym and belongsToProjectPackage(d.conf, it.sym): + let external = externalDep(d, it.sym) + 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", [esc(d.target, external.prettyLink), + changeFileExt(external, "html")]) + +proc exportSym(d: PDoc; s: PSym) = + const k = exportSection + if s.kind == skModule and belongsToProjectPackage(d.conf, s): + let external = externalDep(d, s) + 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", [esc(d.target, external.prettyLink), + changeFileExt(external, "html")]) + elif s.kind != skModule and s.owner != nil: + let module = originatingModule(s) + if belongsToProjectPackage(d.conf, module): + let + complexSymbol = complexName(s.kind, s.ast, s.name.s) + symbolOrId = d.newUniquePlainSymbol(complexSymbol) + external = externalDep(d, module) + if d.section[k].finalMarkup != "": d.section[k].finalMarkup.add(", ") + # XXX proper anchor generation here + dispA(d.conf, d.section[k].finalMarkup, + "<a href=\"$2#$3\"><span class=\"Identifier\">$1</span></a>", + "$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: - if d.section[k] != nil: add(d.section[k], ", ") - dispA(d.conf, d.section[k], - "<a class=\"reference external\" href=\"$1.html\">$1</a>", - "$1", [rope(getModuleName(d.conf, it))]) + result = nil -proc generateDoc*(d: PDoc, n: PNode) = +proc documentEffect(cache: IdentCache; n, x: PNode, effectType: TSpecialWord, idx: int): PNode = + let spec = effectSpec(x, effectType) + if isNil(spec): + let s = n[namePos].sym + + 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, 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) + # set the type so that the following analysis doesn't screw up: + effects[i].typ = real[i].typ + + 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 + let params = s.typ.n + + var effects = newNodeI(nkBracket, n.info) + for i in 1..<params.len: + if params[i].kind == nkSym and flag in params[i].sym.flags: + effects.add params[i] + + 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 + let pragmas = n[pragmasPos] + let p1 = documentEffect(cache, n, pragmas, wRaises, exceptionEffects) + let p2 = documentEffect(cache, n, pragmas, wTags, tagEffects) + 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 or p6 != nil: + if pragmas.kind == nkEmpty: + n[pragmasPos] = newNodeI(nkPragma, n.info) + if p1 != nil: n[pragmasPos].add p1 + if p2 != nil: n[pragmasPos].add p2 + 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, 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 nkCommentStmt: add(d.modDesc, genComment(d, n)) - of nkProcDef: - when useEffectSystem: documentRaises(d.cache, n) - genItem(d, n, n.sons[namePos], skProc) - of nkFuncDef: + of nkPragma: + let pragmaNode = findPragma(n, wDeprecated) + d.modDeprecationMsg.add(genDeprecationMsg(d, pragmaNode)) + 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) - genItem(d, n, n.sons[namePos], skFunc) + genItemAux(skProc) of nkMethodDef: when useEffectSystem: documentRaises(d.cache, n) - genItem(d, n, n.sons[namePos], skMethod) + genItemAux(skMethod) of nkIteratorDef: when useEffectSystem: documentRaises(d.cache, n) - genItem(d, n, n.sons[namePos], skIterator) - of nkMacroDef: genItem(d, n, n.sons[namePos], skMacro) - of nkTemplateDef: genItem(d, n, n.sons[namePos], skTemplate) + genItemAux(skIterator) + of nkMacroDef: genItemAux(skMacro) + of nkTemplateDef: genItemAux(skTemplate) of nkConverterDef: when useEffectSystem: documentRaises(d.cache, n) - genItem(d, n, n.sons[namePos], skConverter) + genItemAux(skConverter) of nkTypeSection, nkVarSection, nkLetSection, nkConstSection: - for i in countup(0, sonsLen(n) - 1): - if n.sons[i].kind != nkCommentStmt: + for i in 0..<n.len: + if n[i].kind != nkCommentStmt: # order is always 'type var let const': - genItem(d, n.sons[i], n.sons[i].sons[0], - succ(skType, ord(n.kind)-ord(nkTypeSection))) + genItem(d, n[i], n[i][0], + succ(skType, ord(n.kind)-ord(nkTypeSection)), docFlags, showNonExports) of nkStmtList: - for i in countup(0, sonsLen(n) - 1): generateDoc(d, n.sons[i]) + 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.sons[0].sons[0]): - generateDoc(d, lastSon(n.sons[0])) + if not checkForFalse(n[0][0]): + generateDoc(d, lastSon(n[0]), orig, config) of nkImportStmt: - for i in 0 .. sonsLen(n)-1: traceDeps(d, n.sons[i]) - of nkFromStmt, nkImportExceptStmt: traceDeps(d, n.sons[0]) + for it in n: traceDeps(d, it) + of nkExportStmt: + for it in n: + # bug #23051; don't generate documentation for exported symbols again + if it.kind == nkSym and sfExported notin it.sym.flags: + if d.module != nil and d.module == it.sym.owner: + generateDoc(d, it.sym.ast, orig, config, kForceExport) + elif it.sym.ast != nil: + exportSym(d, it.sym) + of nkExportExceptStmt: discard "transformed into nkExportStmt by semExportExcept" + of nkFromStmt, nkImportExceptStmt: traceDeps(d, n[0]) + of nkCallKinds: + var comm: ItemPre = default(ItemPre) + getAllRunnableExamples(d, n, 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 -proc generateJson*(d: PDoc, n: PNode) = + setIndexTitle(d, useMetaTitle = d.standaloneDoc) + completePass2(d.sharedState) + +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 n.comment != nil and startsWith(n.comment, "##"): - let stripped = n.comment.substr(2).strip - d.add %{ "comment": %stripped, "line": %n.info.line.int, - "col": %n.info.col } - of nkProcDef: - when useEffectSystem: documentRaises(d.cache, n) - d.add genJsonItem(d, n, n.sons[namePos], skProc) - of nkFuncDef: + if includeComments: + d.add JsonItem(rst: genComment(d, n), rstField: "comment", + json: %Table[string, string]()) + else: + d.modDescPre.add(genComment(d, n)) + of nkProcDef, nkFuncDef: when useEffectSystem: documentRaises(d.cache, n) - d.add genJsonItem(d, n, n.sons[namePos], skFunc) + d.add genJsonItem(d, n, n[namePos], skProc) of nkMethodDef: when useEffectSystem: documentRaises(d.cache, n) - d.add genJsonItem(d, n, n.sons[namePos], skMethod) + d.add genJsonItem(d, n, n[namePos], skMethod) of nkIteratorDef: when useEffectSystem: documentRaises(d.cache, n) - d.add genJsonItem(d, n, n.sons[namePos], skIterator) + d.add genJsonItem(d, n, n[namePos], skIterator) of nkMacroDef: - d.add genJsonItem(d, n, n.sons[namePos], skMacro) + d.add genJsonItem(d, n, n[namePos], skMacro) of nkTemplateDef: - d.add genJsonItem(d, n, n.sons[namePos], skTemplate) + d.add genJsonItem(d, n, n[namePos], skTemplate) of nkConverterDef: when useEffectSystem: documentRaises(d.cache, n) - d.add genJsonItem(d, n, n.sons[namePos], skConverter) + d.add genJsonItem(d, n, n[namePos], skConverter) of nkTypeSection, nkVarSection, nkLetSection, nkConstSection: - for i in countup(0, sonsLen(n) - 1): - if n.sons[i].kind != nkCommentStmt: + for i in 0..<n.len: + if n[i].kind != nkCommentStmt: # order is always 'type var let const': - d.add genJsonItem(d, n.sons[i], n.sons[i].sons[0], - succ(skType, ord(n.kind)-ord(nkTypeSection))) + d.add genJsonItem(d, n[i], n[i][0], + succ(skType, ord(n.kind)-ord(nkTypeSection)), optShowNonExportedFields in config.globalOptions) of nkStmtList: - for i in countup(0, sonsLen(n) - 1): - generateJson(d, n.sons[i]) + for i in 0..<n.len: + generateJson(d, n[i], config, includeComments) of nkWhenStmt: # generate documentation for the first branch only: - if not checkForFalse(n.sons[0].sons[0]): - generateJson(d, lastSon(n.sons[0])) + if not checkForFalse(n[0][0]): + 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 n.comment != nil and startsWith(n.comment, "##"): + if startsWith(n.comment, "##"): let stripped = n.comment.substr(2).strip r.add stripped of nkProcDef: when useEffectSystem: documentRaises(d.cache, n) - r.add genTagsItem(d, n, n.sons[namePos], skProc) + r.add genTagsItem(d, n, n[namePos], skProc) of nkFuncDef: when useEffectSystem: documentRaises(d.cache, n) - r.add genTagsItem(d, n, n.sons[namePos], skFunc) + r.add genTagsItem(d, n, n[namePos], skFunc) of nkMethodDef: when useEffectSystem: documentRaises(d.cache, n) - r.add genTagsItem(d, n, n.sons[namePos], skMethod) + r.add genTagsItem(d, n, n[namePos], skMethod) of nkIteratorDef: when useEffectSystem: documentRaises(d.cache, n) - r.add genTagsItem(d, n, n.sons[namePos], skIterator) + r.add genTagsItem(d, n, n[namePos], skIterator) of nkMacroDef: - r.add genTagsItem(d, n, n.sons[namePos], skMacro) + r.add genTagsItem(d, n, n[namePos], skMacro) of nkTemplateDef: - r.add genTagsItem(d, n, n.sons[namePos], skTemplate) + r.add genTagsItem(d, n, n[namePos], skTemplate) of nkConverterDef: when useEffectSystem: documentRaises(d.cache, n) - r.add genTagsItem(d, n, n.sons[namePos], skConverter) + r.add genTagsItem(d, n, n[namePos], skConverter) of nkTypeSection, nkVarSection, nkLetSection, nkConstSection: - for i in countup(0, sonsLen(n) - 1): - if n.sons[i].kind != nkCommentStmt: + for i in 0..<n.len: + if n[i].kind != nkCommentStmt: # order is always 'type var let const': - r.add genTagsItem(d, n.sons[i], n.sons[i].sons[0], + r.add genTagsItem(d, n[i], n[i][0], succ(skType, ord(n.kind)-ord(nkTypeSection))) of nkStmtList: - for i in countup(0, sonsLen(n) - 1): - generateTags(d, n.sons[i], r) + for i in 0..<n.len: + generateTags(d, n[i], r) of nkWhenStmt: # generate documentation for the first branch only: - if not checkForFalse(n.sons[0].sons[0]): - generateTags(d, lastSon(n.sons[0]), r) + if not checkForFalse(n[0][0]): + generateTags(d, lastSon(n[0]), r) else: discard -proc genSection(d: PDoc, kind: TSymKind) = - const sectionNames: array[skModule..skTemplate, string] = [ +proc genSection(d: PDoc, kind: TSymKind, groupedToc = false) = + const sectionNames: array[skModule..skField, string] = [ "Imports", "Types", "Vars", "Lets", "Consts", "Vars", "Procs", "Funcs", - "Methods", "Iterators", "Converters", "Macros", "Templates" + "Methods", "Iterators", "Converters", "Macros", "Templates", "Exports" + ] + 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] + + proc cmp(x, y: TocItem): int = cmpDecimalsIgnoreCase(x.sortName, y.sortName) + if groupedToc: + 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 + + let sectionValues = @[ + "sectionID", $ord(kind), "sectionTitleID", $(ord(kind) + 50), + "sectionTitle", title ] - 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]]) - d.toc[kind] = ropeFormatNamedVars(d.conf, getConfigVar(d.conf, "doc.section.toc"), [ - "sectionid", "sectionTitle", "sectionTitleID", "content"], [ - ord(kind).rope, title, rope(ord(kind) + 50), d.toc[kind]]) - -proc genOutFile(d: PDoc): Rope = + + # 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 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 - for i in countup(low(TSymKind), high(TSymKind)): - genSection(d, i) - add(toc, d.toc[i]) - if toc != nil: - toc = ropeFormatNamedVars(d.conf, getConfigVar(d.conf, "doc.toc"), ["content"], [toc]) - for i in countup(low(TSymKind), high(TSymKind)): add(code, d.section[i]) + 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 != "" 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] - setIndexTerm(d[], "", title) else: - # Modules get an automatic title for the HTML, but no entry in the index. - title = "Module " & extractFilename(changeFileExt(d.filename, "")) - - let bodyname = if d.hasToc and not d.isPureRst: "doc.body_toc_group" + title = canonicalImport(d.conf, AbsoluteFile d.filename) + 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", [esc(d.target, d.meta[metaSubtitle])]) + + var groupsection = getConfigVar(d.conf, "doc.body_toc_groupsection") + 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" - content = ropeFormatNamedVars(d.conf, getConfigVar(d.conf, bodyname), ["title", - "tableofcontents", "moduledesc", "date", "time", "content"], - [title.rope, toc, d.modDesc, rope(getDateStr()), - rope(getClockStr()), code]) + 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"), ["title", - "tableofcontents", "moduledesc", "date", "time", - "content", "author", "version", "analytics"], - [title.rope, toc, d.modDesc, rope(getDateStr()), - rope(getClockStr()), content, d.meta[metaAuthor].rope, - d.meta[metaVersion].rope, d.analytics.rope]) + 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: - writeIndexFile(d[], splitFile(d.conf.outFile).dir / - splitFile(d.filename).name & IndexExt) - -proc getOutFile2(conf: ConfigRef; filename, ext, dir: string): string = - if optWholeProject in conf.globalOptions: - let d = if conf.outFile != "": conf.outFile else: dir - createDir(d) - result = d / changeFileExt(filename, ext) - else: - result = getOutFile(conf, filename, ext) - -proc writeOutput*(d: PDoc, filename, outExt: string, useWarning = false) = - var content = genOutFile(d) - var success = true - var filename: string + let dest = indexFile(d) + writeIndexFile(d[], dest.string) + +proc updateOutfile(d: PDoc, outfile: AbsoluteFile) = + if d.module == nil or sfMainModule in d.module.flags: # nil for e.g. for commandRst2Html + if d.conf.outFile.isEmpty: + d.conf.outFile = outfile.relativeTo(d.conf.outDir) + if isAbsolute(d.conf.outFile.string): + 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) - filename = "<stdout>" + write(stdout, content) else: - filename = getOutFile2(d.conf, filename, outExt, "htmldocs") - success = writeRope(content, filename) - if not success: - rawMessage(d.conf, if useWarning: warnCannotOpenFile else: errCannotOpenFile, filename) - -proc writeOutputJson*(d: PDoc, filename, outExt: string, - useWarning = false) = + 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) + try: + writeFile(outfile, content) + except IOError: + rawMessage(d.conf, if useWarning: warnCannotOpenFile else: errCannotOpenFile, + outfile.string) + if not d.wroteSupportFiles: # nimdoc.css + dochack.js + let nimr = $d.conf.getPrefixDir() + 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) + d.wroteSupportFiles = true + +proc writeOutputJson*(d: PDoc, useWarning = false) = + runAllExamples(d) + var modDesc: string = "" + for desc in d.modDescFinal: + modDesc &= desc let content = %*{"orig": d.filename, "nimble": getPackageName(d.conf, d.filename), - "entries": d.jArray} + "moduleDescription": modDesc, + "entries": d.jEntriesFinal} if optStdout in d.conf.globalOptions: - write(stdout, $content) + writeLine(stdout, $content) else: - var f: File - if open(f, getOutFile2(d.conf, splitFile(filename).name, - outExt, "jsondocs"), fmWrite): + let dir = d.destFile.splitFile.dir + createDir(dir) + var f: File = default(File) + if open(f, d.destFile, fmWrite): write(f, $content) close(f) + updateOutfile(d, d.destFile.AbsoluteFile) else: - discard "fixme: error report" + localError(d.conf, newLineInfo(d.conf, AbsoluteFile d.filename, -1, -1), + warnUser, "unable to open file \"" & d.destFile & + "\" for writing") + +proc handleDocOutputOptions*(conf: ConfigRef) = + if optWholeProject in conf.globalOptions: + # Backward compatibility with previous versions + # xxx this is buggy when user provides `nim doc --project -o:sub/bar.html main`, + # it'd write to `sub/bar.html/main.html` + 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) - writeOutput(d, conf.projectFull, HtmlExt) + 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, outExt: string) = +proc commandRstAux(cache: IdentCache, conf: ConfigRef; + filename: AbsoluteFile, outExt: string, + preferMarkdown: bool) = var filen = addFileExt(filename, "txt") - var d = newDocumentor(filen, cache, conf) - d.onTestSnippet = proc (d: var RstGenerator; filename, cmd: string; - status: int; content: string) = - var outp: string - if filename.len == 0: - inc(d.id) - let nameOnly = splitFile(d.filename).name - let subdir = getNimcacheDir(conf) / nameOnly - createDir(subdir) - outp = subdir / (nameOnly & "_snippet_" & $d.id & ".nim") - elif isAbsolute(filename): - outp = filename - else: - # Nim's convention: every path is relative to the file it was written in: - outp = splitFile(d.filename).dir / filename - writeFile(outp, content) - let cmd = cmd % quoteShell(outp) - rawMessage(conf, hintExecuting, cmd) - if execShellCmd(cmd) != status: - rawMessage(conf, errGenerated, "executing of external program failed: " & cmd) - - d.isPureRst = true - var rst = parseRst(readFile(filen), filen, 0, 1, d.hasToc, - {roSupportRawDirective}, conf) - var modDesc = newStringOfCap(30_000) - #d.modDesc = newMutableRope(30_000) - renderRstToOut(d[], rst, modDesc) - #freezeMutableRope(d.modDesc) - d.modDesc = rope(modDesc) - writeOutput(d, filename, outExt) - 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) - d.hasToc = true - generateJson(d, ast) - let json = d.jArray - let content = rope(pretty(json)) + var d = newDocumentor(conf.projectFull, cache, conf, hasToc = true) + d.onTestSnippet = proc (d: var RstGenerator; filename, cmd: 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") + 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, conf.projectFull, JsonExt) - if not writeRope(content, filename): - rawMessage(conf, errCannotOpenFile, filename) + let filename = getOutFile(conf, RelativeFile conf.projectName, JsonExt) + 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) - d.hasToc = true + var d = newDocumentor(conf.projectFull, cache, conf, hasToc = true) + d.onTestSnippet = proc (d: var RstGenerator; filename, cmd: 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") 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, conf.projectFull, TagsExt) - if not writeRope(content, filename): - rawMessage(conf, errCannotOpenFile, filename) - -proc commandBuildIndex*(cache: IdentCache, conf: ConfigRef) = - var content = mergeIndexes(conf.projectFull).rope - - let code = ropeFormatNamedVars(conf, getConfigVar(conf, "doc.file"), ["title", - "tableofcontents", "moduledesc", "date", "time", - "content", "author", "version", "analytics"], - ["Index".rope, nil, nil, rope(getDateStr()), - rope(getClockStr()), content, nil, nil, nil]) + let filename = getOutFile(conf, RelativeFile conf.projectName, TagsExt) + try: + writeFile(filename, content) + except IOError: + rawMessage(conf, errCannotOpenFile, filename.string) + +proc commandBuildIndex*(conf: ConfigRef, dir: string, outFile = RelativeFile"") = + 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 = 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 - let filename = getOutFile(conf, "theindex", HtmlExt) - if not writeRope(code, filename): - rawMessage(conf, errCannotOpenFile, 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 068c47bb3..7fb11a3bd 100644 --- a/compiler/docgen2.nim +++ b/compiler/docgen2.nim @@ -11,58 +11,70 @@ # semantic checking. import - os, options, ast, astalgo, msgs, ropes, idents, passes, docgen, lineinfos + options, ast, msgs, docgen, lineinfos, pathutils, packages -from modulegraphs import ModuleGraph +from modulegraphs import ModuleGraph, PPassContext type - TGen = object of TPassContext + TGen = object of PPassContext doc: PDoc module: PSym + config: ConfigRef PGen = ref TGen +proc shouldProcess(g: PGen): bool = + (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.} = var g = PGen(p) let useWarning = sfMainModule notin g.module.flags - #echo g.module.name.s, " ", g.module.owner.id, " ", gMainPackageId - if (g.module.owner.id == g.doc.conf.mainPackageId and optWholeProject in g.doc.conf.globalOptions) or - sfMainModule in 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, toFilename(graph.config, FileIndex g.module.position), HtmlExt, useWarning) + 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, toFilename(graph.config, FileIndex g.module.position), ".json", useWarning) + writeOutputJson(g.doc, useWarning) -proc processNode(c: PPassContext, n: PNode): PNode = +proc processNode*(c: PPassContext, n: PNode): PNode = result = n var g = PGen(c) - generateDoc(g.doc, n) + if shouldProcess(g): + 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) - generateJson(g.doc, n) + if shouldProcess(g): + generateJson(g.doc, n, g.config, false) -proc myOpen(graph: ModuleGraph; module: PSym): PPassContext = +template myOpenImpl(ext: untyped) {.dirty.} = var g: PGen new(g) g.module = module - var d = newDocumentor(toFilename(graph.config, FileIndex module.position), graph.cache, graph.config) - d.hasToc = true + g.config = graph.config + var d = newDocumentor(AbsoluteFile toFullPath(graph.config, FileIndex module.position), + graph.cache, graph.config, ext, module, hasToc = true) g.doc = d result = g -const docgen2Pass* = makePass(open = myOpen, process = processNode, close = close) -const docgen2JsonPass* = makePass(open = myOpen, process = processNodeJson, - close = closeJson) +proc openHtml*(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext = + myOpenImpl(HtmlExt) + +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 new file mode 100644 index 000000000..dc516d2e5 --- /dev/null +++ b/compiler/enumtostr.nim @@ -0,0 +1,110 @@ + +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, "$"), idgen, t.owner, info) + + let dest = newSym(skParam, getIdent(g.cache, "e"), idgen, result, info) + dest.typ = t + + let res = newSym(skResult, getIdent(g.cache, "result"), idgen, result, info) + res.typ = getSysType(g, info, tyString) + + 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) + + result.typ.addParam dest + + var body = newNodeI(nkStmtList, info) + var caseStmt = newNodeI(nkCaseStmt, info) + caseStmt.add(newSymNode dest) + + # copy the branches over, but replace the fields with the for loop body: + for i in 0..<t.n.len: + 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, newIntTypeNode(field.position, t), + newTree(nkStmtList, newTree(nkFastAsgn, newSymNode(res), newStrNode(val, info)))) + #newIntTypeNode(nkIntLit, field.position, t) + + body.add(caseStmt) + + 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] = body + n[resultPos] = newSymNode(res) + result.ast = n + incl result.flags, sfFromGeneric + incl result.flags, sfNeverRaises + +proc searchObjCaseImpl(obj: PNode; field: PSym): PNode = + case obj.kind + of nkSym: + result = nil + of nkElse, nkOfBranch: + result = searchObjCaseImpl(obj.lastSon, field) + else: + 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.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"), idgen, t.owner, info) + + let dest = newSym(skParam, getIdent(g.cache, "e"), idgen, result, info) + dest.typ = field.typ + + let res = newSym(skResult, getIdent(g.cache, "result"), idgen, result, info) + res.typ = getSysType(g, info, tyUInt8) + + 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) + + result.typ.addParam dest + + var body = newNodeI(nkStmtList, info) + var caseStmt = newNodeI(nkCaseStmt, info) + caseStmt.add(newSymNode dest) + + let subObj = searchObjCase(t, field) + for i in 1..<subObj.len: + let ofBranch = subObj[i] + var newBranch = newNodeI(ofBranch.kind, ofBranch.info) + for j in 0..<ofBranch.len-1: + newBranch.add ofBranch[j] + + newBranch.add newTree(nkStmtList, newTree(nkFastAsgn, newSymNode(res), newIntNode(nkInt8Lit, i))) + caseStmt.add newBranch + + body.add(caseStmt) + + 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] = body + n[resultPos] = newSymNode(res) + result.ast = n + incl result.flags, sfFromGeneric + incl result.flags, sfNeverRaises 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 e863c8995..9871c81af 100644 --- a/compiler/evalffi.nim +++ b/compiler/evalffi.nim @@ -9,76 +9,85 @@ ## This file implements the FFI part of the evaluator for Nim code. -import ast, astalgo, ropes, types, options, tables, dynlib, libffi, msgs, os +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" -else: +elif defined(linux): const libcDll = "libc.so(.6|.5|)" +elif defined(openbsd): + const libcDll = "/usr/lib/libc.so(.95.1|)" +elif defined(bsd): + const libcDll = "/lib/libc.so.7" +elif defined(osx): + const libcDll = "/usr/lib/libSystem.dylib" +else: + {.error: "`libcDll` not implemented on this platform".} type - TDllCache = tables.TTable[string, TLibHandle] + TDllCache = tables.Table[string, LibHandle] var - gDllCache = initTable[string, TLibHandle]() + gDllCache = initTable[string, LibHandle]() when defined(windows): - var gExeHandle = loadLib(os.getAppFilename()) + var gExeHandle = loadLib(getAppFilename()) else: var gExeHandle = loadLib() -proc getDll(cache: var TDllCache; dll: string; info: TLineInfo): pointer = - result = cache[dll] +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] = @[] + libCandidates(dll, libs) + for c in libs: + result = loadLib(c) + if not result.isNil: break if result.isNil: - var libs: seq[string] = @[] - libCandidates(dll, libs) - for c in libs: - result = loadLib(c) - if not result.isNil: break - if result.isNil: - globalError(info, "cannot load: " & dll) - cache[dll] = result + globalError(conf, info, "cannot load: " & dll) + cache[dll] = result const nkPtrLit = nkIntLit # hopefully we can get rid of this hack soon -var myerrno {.importc: "errno", header: "<errno.h>".}: cint ## error variable - -proc importcSymbol*(sym: PSym): PNode = - let name = ropeToStr(sym.loc.r) - +proc importcSymbol*(conf: ConfigRef, sym: PSym): PNode = + let name = sym.cname # $sym.loc.r would point to internal name # the AST does not support untyped pointers directly, so we use an nkIntLit # that contains the address instead: result = newNodeIT(nkPtrLit, sym.info, sym.typ) - case name - of "stdin": result.intVal = cast[ByteAddress](system.stdin) - of "stdout": result.intVal = cast[ByteAddress](system.stdout) - of "stderr": result.intVal = cast[ByteAddress](system.stderr) - of "vmErrnoWrapper": result.intVal = cast[ByteAddress](myerrno) - else: + when true: + var libPathMsg = "" let lib = sym.annex if lib != nil and lib.path.kind notin {nkStrLit..nkTripleStrLit}: - globalError(sym.info, "dynlib needs to be a string lit for the REPL") - var theAddr: pointer - if lib.isNil and not gExehandle.isNil: + globalError(conf, sym.info, "dynlib needs to be a string lit") + 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 = gDllCache.getDll(libcDll, sym.info) - theAddr = dllhandle.symAddr(name) + let dllhandle = getDll(conf, gDllCache, libcDll, sym.info) + theAddr = dllhandle.symAddr(name.cstring) elif not lib.isNil: - let dllhandle = gDllCache.getDll(if lib.kind == libHeader: libcDll - else: lib.path.strVal, sym.info) - theAddr = dllhandle.symAddr(name) - if theAddr.isNil: globalError(sym.info, "cannot import: " & sym.name.s) - result.intVal = cast[ByteAddress](theAddr) - -proc mapType(t: ast.PType): ptr libffi.TType = + 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.cstring) + if theAddr.isNil: globalError(conf, sym.info, + "cannot import symbol: " & name & " from " & libPathMsg) + result.intVal = cast[int](theAddr) + +proc mapType(conf: ConfigRef, t: ast.PType): ptr libffi.Type = if t == nil: return addr libffi.type_void case t.kind of tyBool, tyEnum, tyChar, tyInt..tyInt64, tyUInt..tyUInt64, tySet: - case t.getSize + case getSize(conf, t) of 1: result = addr libffi.type_uint8 of 2: result = addr libffi.type_sint16 of 4: result = addr libffi.type_sint32 @@ -86,93 +95,98 @@ proc mapType(t: ast.PType): ptr libffi.TType = 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, tyExpr, - tyStmt, tyTypeDesc, tyProc, tyArray, tyStatic, tyNil: + 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(t.sons[0]) + result = mapType(conf, t.skipModifier) else: result = nil # too risky: #of tyFloat128: result = addr libffi.type_longdouble -proc mapCallConv(cc: TCallingConvention, info: TLineInfo): TABI = +proc mapCallConv(conf: ConfigRef, cc: TCallingConvention, info: TLineInfo): TABI = case cc - of ccDefault: result = DEFAULT_ABI - of ccStdCall: result = when defined(windows): STDCALL else: DEFAULT_ABI + of ccNimCall: result = DEFAULT_ABI + of ccStdCall: result = when defined(windows) and defined(x86): STDCALL else: DEFAULT_ABI of ccCDecl: result = DEFAULT_ABI else: - globalError(info, "cannot map calling convention to FFI") + 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(v: PNode, typ: PType): int = +proc packSize(conf: ConfigRef, v: PNode, typ: PType): int = ## computes the size of the blob case typ.kind of tyPtr, tyRef, tyVar, tyLent: if v.kind in {nkNilLit, nkPtrLit}: result = sizeof(pointer) else: - result = sizeof(pointer) + packSize(v.sons[0], typ.lastSon) + result = sizeof(pointer) + packSize(conf, v[0], typ.elementType) of tyDistinct, tyGenericInst, tyAlias, tySink: - result = packSize(v, typ.sons[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(v.sons[0], typ.sons[1]) + result = v.len * packSize(conf, v[0], typ.elementType) + else: + result = 0 else: - result = typ.getSize.int + result = getSize(conf, typ).int -proc pack(v: PNode, typ: PType, res: pointer) +proc pack(conf: ConfigRef, v: PNode, typ: PType, res: pointer) -proc getField(n: PNode; position: int): PSym = +proc getField(conf: ConfigRef, n: PNode; position: int): PSym = case n.kind of nkRecList: - for i in countup(0, sonsLen(n) - 1): - result = getField(n.sons[i], position) + result = nil + for i in 0..<n.len: + result = getField(conf, n[i], position) if result != nil: return of nkRecCase: - result = getField(n.sons[0], position) + result = getField(conf, n[0], position) if result != nil: return - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind + for i in 1..<n.len: + case n[i].kind of nkOfBranch, nkElse: - result = getField(lastSon(n.sons[i]), position) + result = getField(conf, lastSon(n[i]), position) if result != nil: return - else: internalError(n.info, "getField(record case branch)") + 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(x: PNode, typ: PType, res: pointer) = - internalAssert x.kind in {nkObjConstr, nkPar, nkTupleConstr} +proc packObject(conf: ConfigRef, x: PNode, typ: PType, res: pointer) = + internalAssert conf, x.kind in {nkObjConstr, nkPar, nkTupleConstr} # compute the field's offsets: - discard typ.getSize - for i in countup(ord(x.kind == nkObjConstr), sonsLen(x) - 1): - var it = x.sons[i] + discard getSize(conf, typ) + for i in ord(x.kind == nkObjConstr)..<x.len: + var it = x[i] if it.kind == nkExprColonExpr: - internalAssert it.sons[0].kind == nkSym - let field = it.sons[0].sym - pack(it.sons[1], field.typ, res +! field.offset) + internalAssert conf, it[0].kind == nkSym + let field = it[0].sym + pack(conf, it[1], field.typ, res +! field.offset) elif typ.n != nil: - let field = getField(typ.n, i) - pack(it, field.typ, res +! field.offset) + let field = getField(conf, typ.n, i) + pack(conf, it, field.typ, res +! field.offset) else: # XXX: todo - globalError(x.info, "cannot pack unnamed tuple") + globalError(conf, x.info, "cannot pack unnamed tuple") const maxPackDepth = 20 var packRecCheck = 0 -proc pack(v: PNode, typ: PType, res: pointer) = - template awr(T, v: untyped): untyped = - wr(T, res, v) +proc pack(conf: ConfigRef, v: PNode, typ: PType, res: pointer) = + template awr(typ, v: untyped): untyped = + wr(typ, res, v) case typ.kind of tyBool: awr(bool, v.intVal != 0) @@ -188,18 +202,18 @@ proc pack(v: PNode, typ: PType, res: pointer) = of tyUInt32: awr(uint32, v.intVal.uint32) of tyUInt64: awr(uint64, v.intVal.uint64) of tyEnum, tySet: - case v.typ.getSize + case getSize(conf, v.typ) of 1: awr(uint8, v.intVal.uint8) of 2: awr(uint16, v.intVal.uint16) of 4: awr(int32, v.intVal.int32) of 8: awr(int64, v.intVal.int64) else: - globalError(v.info, "cannot map value to FFI (tyEnum, tySet)") + globalError(conf, v.info, "cannot map value to FFI (tyEnum, tySet)") of tyFloat: awr(float, v.floatVal) 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 @@ -208,7 +222,7 @@ proc pack(v: PNode, typ: PType, res: pointer) = elif v.kind in {nkStrLit..nkTripleStrLit}: awr(cstring, cstring(v.strVal)) else: - globalError(v.info, "cannot map pointer/proc value to FFI") + globalError(conf, v.info, "cannot map pointer/proc value to FFI") of tyPtr, tyRef, tyVar, tyLent: if v.kind == nkNilLit: # nothing to do since the memory is 0 initialized anyway @@ -218,44 +232,44 @@ proc pack(v: PNode, typ: PType, res: pointer) = else: if packRecCheck > maxPackDepth: packRecCheck = 0 - globalError(v.info, "cannot map value to FFI " & typeToString(v.typ)) + globalError(conf, v.info, "cannot map value to FFI " & typeToString(v.typ)) inc packRecCheck - pack(v.sons[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 = typ.sons[1].getSize - for i in 0 ..< v.len: - pack(v.sons[i], typ.sons[1], res +! i * baseSize) + let baseSize = getSize(conf, typ.elementType) + for i in 0..<v.len: + pack(conf, v[i], typ.elementType, res +! i * baseSize) of tyObject, tyTuple: - packObject(v, typ, res) + packObject(conf, v, typ, res) of tyNil: discard of tyDistinct, tyGenericInst, tyAlias, tySink: - pack(v, typ.sons[0], res) + pack(conf, v, typ.skipModifier, res) else: - globalError(v.info, "cannot map value to FFI " & typeToString(v.typ)) + globalError(conf, v.info, "cannot map value to FFI " & typeToString(v.typ)) -proc unpack(x: pointer, typ: PType, n: PNode): PNode +proc unpack(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode -proc unpackObjectAdd(x: pointer, n, result: PNode) = +proc unpackObjectAdd(conf: ConfigRef, x: pointer, n, result: PNode) = case n.kind of nkRecList: - for i in countup(0, sonsLen(n) - 1): - unpackObjectAdd(x, n.sons[i], result) + for i in 0..<n.len: + unpackObjectAdd(conf, x, n[i], result) of nkRecCase: - globalError(result.info, "case objects cannot be unpacked") + globalError(conf, result.info, "case objects cannot be unpacked") of nkSym: var pair = newNodeI(nkExprColonExpr, result.info, 2) - pair.sons[0] = n - pair.sons[1] = unpack(x +! n.sym.offset, n.sym.typ, nil) + pair[0] = n + pair[1] = unpack(conf, x +! n.sym.offset, n.sym.typ, nil) #echo "offset: ", n.sym.name.s, " ", n.sym.offset result.add pair else: discard -proc unpackObject(x: pointer, typ: PType, n: PNode): PNode = +proc unpackObject(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode = # compute the field's offsets: - discard typ.getSize + discard getSize(conf, typ) # iterate over any actual field of 'n' ... if n is nil we need to create # the nkPar node: @@ -263,36 +277,36 @@ proc unpackObject(x: pointer, typ: PType, n: PNode): PNode = result = newNode(nkTupleConstr) result.typ = typ if typ.n.isNil: - internalError("cannot unpack unnamed tuple") - unpackObjectAdd(x, typ.n, result) + internalError(conf, "cannot unpack unnamed tuple") + unpackObjectAdd(conf, x, typ.n, result) else: result = n if result.kind notin {nkObjConstr, nkPar, nkTupleConstr}: - globalError(n.info, "cannot map value from FFI") + globalError(conf, n.info, "cannot map value from FFI") if typ.n.isNil: - globalError(n.info, "cannot unpack unnamed tuple") - for i in countup(ord(n.kind == nkObjConstr), sonsLen(n) - 1): - var it = n.sons[i] + globalError(conf, n.info, "cannot unpack unnamed tuple") + for i in ord(n.kind == nkObjConstr)..<n.len: + var it = n[i] if it.kind == nkExprColonExpr: - internalAssert it.sons[0].kind == nkSym - let field = it.sons[0].sym - it.sons[1] = unpack(x +! field.offset, field.typ, it.sons[1]) + internalAssert conf, it[0].kind == nkSym + let field = it[0].sym + it[1] = unpack(conf, x +! field.offset, field.typ, it[1]) else: - let field = getField(typ.n, i) - n.sons[i] = unpack(x +! field.offset, field.typ, it) + let field = getField(conf, typ.n, i) + n[i] = unpack(conf, x +! field.offset, field.typ, it) -proc unpackArray(x: pointer, typ: PType, n: PNode): PNode = +proc unpackArray(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode = if n.isNil: result = newNode(nkBracket) result.typ = typ - newSeq(result.sons, lengthOrd(typ).int) + newSeq(result.sons, lengthOrd(conf, typ).toInt) else: result = n if result.kind != nkBracket: - globalError(n.info, "cannot map value from FFI") - let baseSize = typ.sons[1].getSize - for i in 0 ..< result.len: - result.sons[i] = unpack(x +! i * baseSize, typ.sons[1], result.sons[i]) + globalError(conf, n.info, "cannot map value from FFI") + let baseSize = getSize(conf, typ.elementType) + for i in 0..<result.len: + result[i] = unpack(conf, x +! i * baseSize, typ.elementType, result[i]) proc canonNodeKind(k: TNodeKind): TNodeKind = case k @@ -301,7 +315,7 @@ proc canonNodeKind(k: TNodeKind): TNodeKind = of nkStrLit..nkTripleStrLit: result = nkStrLit else: result = k -proc unpack(x: pointer, typ: PType, n: PNode): PNode = +proc unpack(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode = template aw(k, v, field: untyped): untyped = if n.isNil: result = newNode(k) @@ -313,7 +327,7 @@ proc unpack(x: pointer, typ: PType, n: PNode): PNode = #echo "expected ", k, " but got ", result.kind #debug result return newNodeI(nkExceptBranch, n.info) - #globalError(n.info, "cannot map value from FFI") + #globalError(conf, n.info, "cannot map value from FFI") result.field = v template setNil() = @@ -323,7 +337,7 @@ proc unpack(x: pointer, typ: PType, n: PNode): PNode = else: reset n[] result = n - result.kind = nkNilLit + result[] = TNode(kind: nkNilLit) result.typ = typ template awi(kind, v: untyped): untyped = aw(kind, v, intVal) @@ -344,13 +358,14 @@ proc unpack(x: pointer, typ: PType, n: PNode): PNode = of tyUInt32: awi(nkUInt32Lit, rd(uint32, x).BiggestInt) of tyUInt64: awi(nkUInt64Lit, rd(uint64, x).BiggestInt) of tyEnum: - case typ.getSize + case getSize(conf, typ) of 1: awi(nkIntLit, rd(uint8, x).BiggestInt) of 2: awi(nkIntLit, rd(uint16, x).BiggestInt) of 4: awi(nkIntLit, rd(int32, x).BiggestInt) of 8: awi(nkIntLit, rd(int64, x).BiggestInt) else: - globalError(n.info, "cannot map value from FFI (tyEnum, tySet)") + 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)) of tyFloat64: awf(nkFloat64Lit, rd(float64, x)) @@ -363,24 +378,25 @@ proc unpack(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 n.kind == nkRefTy - n.sons[0] = unpack(p, typ.lastSon, n.sons[0]) + internalAssert(conf, n.kind == nkRefTy) + n[0] = unpack(conf, p, typ.elementType, n[0]) result = n else: - globalError(n.info, "cannot map value from FFI " & typeToString(typ)) + result = nil + globalError(conf, n.info, "cannot map value from FFI " & typeToString(typ)) of tyObject, tyTuple: - result = unpackObject(x, typ, n) + result = unpackObject(conf, x, typ, n) of tyArray: - result = unpackArray(x, typ, n) - of tyCString, tyString: + result = unpackArray(conf, x, typ, n) + of tyCstring, tyString: let p = rd(cstring, x) if p.isNil: setNil() @@ -389,14 +405,15 @@ proc unpack(x: pointer, typ: PType, n: PNode): PNode = of tyNil: setNil() of tyDistinct, tyGenericInst, tyAlias, tySink: - result = unpack(x, typ.lastSon, n) + result = unpack(conf, x, typ.skipModifier, n) else: # XXX what to do with 'array' here? - globalError(n.info, "cannot map value from FFI " & typeToString(typ)) + result = nil + globalError(conf, n.info, "cannot map value from FFI " & typeToString(typ)) -proc fficast*(x: PNode, destTyp: PType): PNode = +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 @@ -404,93 +421,93 @@ proc fficast*(x: PNode, destTyp: PType): PNode = result = newNodeIT(x.kind, x.info, destTyp) else: # we play safe here and allocate the max possible size: - let size = max(packSize(x, x.typ), packSize(x, destTyp)) + let size = max(packSize(conf, x, x.typ), packSize(conf, x, destTyp)) var a = alloc0(size) - pack(x, x.typ, a) + pack(conf, x, x.typ, a) # cast through a pointer needs a new inner object: let y = if x.kind == nkRefTy: newNodeI(nkRefTy, x.info, 1) else: x.copyTree y.typ = x.typ - result = unpack(a, destTyp, y) + result = unpack(conf, a, destTyp, y) dealloc a -proc callForeignFunction*(call: PNode): PNode = - internalAssert call.sons[0].kind == nkPtrLit +proc callForeignFunction*(conf: ConfigRef, call: PNode): PNode = + internalAssert conf, call[0].kind == nkPtrLit - var cif: TCif - var sig: TParamList + var cif: TCif = default(TCif) + var sig: ParamList = default(ParamList) # use the arguments' types for varargs support: - for i in 1..call.len-1: - sig[i-1] = mapType(call.sons[i].typ) + for i in 1..<call.len: + sig[i-1] = mapType(conf, call[i].typ) if sig[i-1].isNil: - globalError(call.info, "cannot map FFI type") - - let typ = call.sons[0].typ - if prep_cif(cif, mapCallConv(typ.callConv, call.info), cuint(call.len-1), - mapType(typ.sons[0]), sig) != OK: - globalError(call.info, "error in FFI call") - - var args: TArgList - let fn = cast[pointer](call.sons[0].intVal) - for i in 1 .. call.len-1: - var t = call.sons[i].typ - args[i-1] = alloc0(packSize(call.sons[i], t)) - pack(call.sons[i], t, args[i-1]) - let retVal = if isEmptyType(typ.sons[0]): pointer(nil) - else: alloc(typ.sons[0].getSize.int) + globalError(conf, call.info, "cannot map FFI type") + + let typ = call[0].typ + if prep_cif(cif, mapCallConv(conf, typ.callConv, call.info), cuint(call.len-1), + mapType(conf, typ.returnType), sig) != OK: + globalError(conf, call.info, "error in FFI call") + + 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.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(retVal, typ.sons[0], nil) + result = unpack(conf, retVal, typ.returnType, nil) result.info = call.info if retVal != nil: dealloc retVal - for i in 1 .. call.len-1: - call.sons[i] = unpack(args[i-1], typ.sons[i], call[i]) + for i in 1..<call.len: + call[i] = unpack(conf, args[i-1], typ[i], call[i]) dealloc args[i-1] -proc callForeignFunction*(fn: PNode, fntyp: PType, +proc callForeignFunction*(conf: ConfigRef, fn: PNode, fntyp: PType, args: var TNodeSeq, start, len: int, info: TLineInfo): PNode = - internalAssert fn.kind == nkPtrLit + internalAssert conf, fn.kind == nkPtrLit - var cif: TCif - var sig: TParamList + 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: - internalAssert i+1 < fntyp.len - aTyp = fntyp.sons[i+1] + internalAssert conf, i+1 < fntyp.len + aTyp = fntyp[i+1] args[i+start].typ = aTyp - sig[i] = mapType(aTyp) - if sig[i].isNil: globalError(info, "cannot map FFI type") + sig[i] = mapType(conf, aTyp) + if sig[i].isNil: globalError(conf, info, "cannot map FFI type") - if prep_cif(cif, mapCallConv(fntyp.callConv, info), cuint(len), - mapType(fntyp.sons[0]), sig) != OK: - globalError(info, "error in FFI call") + if prep_cif(cif, mapCallConv(conf, fntyp.callConv, info), cuint(len), + mapType(conf, fntyp[0]), sig) != OK: + globalError(conf, info, "error in FFI call") - var cargs: TArgList + var cargs: ArgList = default(ArgList) let fn = cast[pointer](fn.intVal) - for i in 0 .. len-1: + for i in 0..len-1: let t = args[i+start].typ - cargs[i] = alloc0(packSize(args[i+start], t)) - pack(args[i+start], t, cargs[i]) - let retVal = if isEmptyType(fntyp.sons[0]): pointer(nil) - else: alloc(fntyp.sons[0].getSize.int) + cargs[i] = alloc0(packSize(conf, args[i+start], t)) + pack(conf, args[i+start], t, cargs[i]) + let retVal = if isEmptyType(fntyp[0]): pointer(nil) + else: alloc(getSize(conf, fntyp[0]).int) libffi.call(cif, fn, retVal, cargs) if retVal.isNil: result = newNode(nkEmpty) else: - result = unpack(retVal, fntyp.sons[0], nil) + result = unpack(conf, retVal, fntyp[0], nil) result.info = info if retVal != nil: dealloc retVal - for i in 0 .. len-1: + for i in 0..len-1: let t = args[i+start].typ - args[i+start] = unpack(cargs[i], t, args[i+start]) + args[i+start] = unpack(conf, cargs[i], t, args[i+start]) dealloc cargs[i] diff --git a/compiler/evaltempl.nim b/compiler/evaltempl.nim index d6c630e79..77c136d63 100644 --- a/compiler/evaltempl.nim +++ b/compiler/evaltempl.nim @@ -9,56 +9,103 @@ ## Template evaluation engine. Now hygienic. -import - strutils, options, ast, astalgo, msgs, os, idents, wordrecg, renderer, - lineinfos +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 - mapping: TIdTable # every gensym'ed symbol needs to be mapped to some - # new symbol + isDeclarative: bool + mapping: SymMapping # every gensym'ed symbol needs to be mapped to some + # new symbol config: ConfigRef + ic: IdentCache + instID: int + idgen: IdGenerator 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) case templ.kind of nkSym: var s = templ.sym - if s.owner.id == c.owner.id: - if s.kind == skParam and sfGenSym notin s.flags: - handleParam actual.sons[s.position] - elif s.kind == skGenericParam or - s.kind == skType and s.typ != nil and s.typ.kind == tyGenericParam: - handleParam actual.sons[s.owner.typ.len + s.position - 1] + if (s.owner == nil and s.kind == skParam) or s.owner == c.owner: + if s.kind == skParam and {sfGenSym, sfTemplateParam} * s.flags == {sfTemplateParam}: + 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.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, false) - x.owner = c.genSymOwner + 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) - result.add newSymNode(x, if c.instLines: actual.info else: templ.info) + 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: + result.add newSymNode(x, if c.instLines: actual.info else: templ.info) else: result.add copyNode(c, templ, actual) of nkNone..nkIdent, nkType..nkNilLit: # atom result.add copyNode(c, templ, actual) + of nkCommentStmt: + # for the documentation generator we don't keep documentation comments + # in the AST that would confuse it (bug #9432), but only if we are not in a + # "declarative" context (bug #9235). + if c.isDeclarative: + var res = copyNode(c, templ, actual) + for i in 0..<templ.len: + evalTemplateAux(templ[i], actual, c, res) + result.add res + else: + result.add newNodeI(nkEmpty, templ.info) else: - var res = copyNode(c, templ, actual) - for i in countup(0, sonsLen(templ) - 1): - evalTemplateAux(templ.sons[i], actual, c, res) - result.add res + var isDeclarative = false + if templ.kind in {nkProcDef, nkFuncDef, nkMethodDef, nkIteratorDef, + nkMacroDef, nkTemplateDef, nkConverterDef, nkTypeSection, + nkVarSection, nkLetSection, nkConstSection} and + not c.isDeclarative: + c.isDeclarative = true + isDeclarative = true + 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 errWrongNumberOfArguments = "wrong number of arguments" @@ -81,9 +128,9 @@ proc evalTemplateArgs(n: PNode, s: PSym; conf: ConfigRef; fromHlo: bool): PNode # their bodies. We could try to fix this, but it may be # wiser to just deprecate immediate templates and macros # now that we have working untyped parameters. - genericParams = if sfImmediate in s.flags or fromHlo: 0 + 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 @@ -95,22 +142,22 @@ proc evalTemplateArgs(n: PNode, s: PSym; conf: ConfigRef; fromHlo: bool): PNode n.renderTree) result = newNodeI(nkArgList, n.info) - for i in 1 .. givenRegularParams: - result.addSon n[i] + for i in 1..givenRegularParams: + result.add n[i] # handle parameters with default values, which were # not supplied by the user - for i in givenRegularParams+1 .. expectedRegularParams: - let default = s.typ.n.sons[i].sym.ast + for i in givenRegularParams+1..expectedRegularParams: + let default = s.typ.n[i].sym.ast if default.isNil or default.kind == nkEmpty: localError(conf, n.info, errWrongNumberOfArguments) - addSon(result, newNodeI(nkEmpty, n.info)) + result.add newNodeI(nkEmpty, n.info) else: - addSon(result, default.copyTree) + result.add default.copyTree - # add any generic paramaters - for i in 1 .. genericParams: - result.addSon n.sons[givenRegularParams + i] + # add any generic parameters + for i in 1..genericParams: + result.add n[givenRegularParams + i] # to prevent endless recursion in template instantiation const evalTemplateLimit* = 1000 @@ -128,7 +175,7 @@ proc wrapInComesFrom*(info: TLineInfo; sym: PSym; res: PNode): PNode = if x.kind in nkCallKinds: for i in 1..<x.len: if x[i].kind in nkCallKinds: - x.sons[i].info = info + x[i].info = info else: result = newNodeI(nkStmtListExpr, info) var d = newNodeI(nkComesFrom, info) @@ -138,7 +185,10 @@ proc wrapInComesFrom*(info: TLineInfo; sym: PSym; res: PNode): PNode = result.typ = res.typ proc evalTemplate*(n: PNode, tmpl, genSymOwner: PSym; - conf: ConfigRef; fromHlo=false): PNode = + conf: ConfigRef; + ic: IdentCache; instID: ref int; + idgen: IdGenerator; + fromHlo=false): PNode = inc(conf.evalTemplateCounter) if conf.evalTemplateCounter > evalTemplateLimit: globalError(conf, n.info, errTemplateInstantiationTooNested) @@ -146,28 +196,35 @@ 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 - initIdTable(ctx.mapping) - - let body = tmpl.getBody + 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}) if isAtom(body): result = newNodeI(nkPar, body.info) evalTemplateAux(body, args, ctx, result) - if result.len == 1: result = result.sons[0] + if result.len == 1: result = result[0] else: localError(conf, result.info, "illformed AST: " & renderTree(result, {renderNoComments})) else: result = copyNode(body) - #ctx.instLines = body.kind notin {nkStmtList, nkStmtListExpr, - # nkBlockStmt, nkBlockExpr} - #if ctx.instLines: result.info = n.info - for i in countup(0, safeLen(body) - 1): - evalTemplateAux(body.sons[i], args, ctx, result) + ctx.instLines = sfCallsite in tmpl.flags + if ctx.instLines: + setInfoRecursive(result, n.info) + for i in 0..<body.safeLen: + evalTemplateAux(body[i], args, ctx, result) result.flags.incl nfFromTemplate result = wrapInComesFrom(n.info, tmpl, result) + #if ctx.debugActive: + # echo "instantion of ", renderTree(result, {renderIds}) dec(conf.evalTemplateCounter) - + # The instID must be unique for every template instantiation, so we increment it here + inc instID[] 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 615b8c1e1..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, os, strutils, osproc, platform, condsyms, options, msgs, - lineinfos, std / sha1, streams +import ropes, platform, condsyms, options, msgs, lineinfos, pathutils, modulepaths + +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 @@ -48,6 +56,8 @@ type # used on some platforms asmStmtFrmt: string, # format of ASM statement structStmtFmt: string, # Format for struct statement + produceAsm: string, # Format how to produce assembler listings + cppXsupport: string, # what to do to enable C++X support props: TInfoCCProps] # properties of the C compiler @@ -58,13 +68,16 @@ type template compiler(name, settings: untyped): untyped = proc name: TInfoCC {.compileTime.} = settings +const + gnuAsmListing = "-Wa,-acdl=$asmfile -g -fverbose-asm -masm=intel" + # GNU C and C++ Compiler compiler gcc: result = ( name: "gcc", objExt: "o", - optSpeed: " -O3 -ffast-math ", - optSize: " -Os -ffast-math ", + optSpeed: " -O3 -fno-ident", + optSize: " -Os -fno-ident", compilerExe: "gcc", cppCompiler: "g++", compileTmpl: "-c $options $include -o $objfile $file", @@ -78,10 +91,39 @@ compiler gcc: linkLibCmd: " -l$1", debug: "", pic: "-fPIC", + asmStmtFrmt: "__asm__($1);$n", + structStmtFmt: "$1 $3 $2 ", # struct|union [packed] $name + produceAsm: gnuAsmListing, + cppXsupport: "-std=gnu++17 -funsigned-char", + props: {hasSwitchRange, hasComputedGoto, hasCpp, hasGcGuard, hasGnuAsm, + hasAttribute, hasBuiltinUnreachable}) + +# GNU C and C++ Compiler +compiler nintendoSwitchGCC: + result = ( + name: "switch_gcc", + objExt: "o", + optSpeed: " -O3 ", + optSize: " -Os ", + compilerExe: "aarch64-none-elf-gcc", + cppCompiler: "aarch64-none-elf-g++", + compileTmpl: "-w -MMD -MP -MF $dfile -c $options $include -o $objfile $file", + buildGui: " -mwindows", + buildDll: " -shared", + buildLib: "aarch64-none-elf-gcc-ar rcs $libfile $objfiles", + linkerExe: "aarch64-none-elf-gcc", + linkTmpl: "$buildgui $builddll -Wl,-Map,$mapfile -o $exefile $objfiles $options", + includeCmd: " -I", + linkDirCmd: " -L", + linkLibCmd: " -l$1", + debug: "", + pic: "-fPIE", asmStmtFrmt: "asm($1);$n", structStmtFmt: "$1 $3 $2 ", # struct|union [packed] $name + produceAsm: gnuAsmListing, + cppXsupport: "-std=gnu++17 -funsigned-char", props: {hasSwitchRange, hasComputedGoto, hasCpp, hasGcGuard, hasGnuAsm, - hasAttribute}) + hasAttribute, hasBuiltinUnreachable}) # LLVM Frontend for GCC/G++ compiler llvmGcc: @@ -90,8 +132,8 @@ compiler llvmGcc: result.name = "llvm_gcc" result.compilerExe = "llvm-gcc" result.cppCompiler = "llvm-g++" - when defined(macosx): - # OS X has no 'llvm-ar' tool: + when defined(macosx) or defined(openbsd): + # `llvm-ar` not available result.buildLib = "ar rcs $libfile $objfiles" else: result.buildLib = "llvm-ar rcs $libfile $objfiles" @@ -109,16 +151,16 @@ compiler vcc: result = ( name: "vcc", objExt: "obj", - optSpeed: " /Ogityb2 /G7 /arch:SSE2 ", - optSize: " /O1 /G7 ", + optSpeed: " /Ogityb2 ", + optSize: " /O1 ", compilerExe: "cl", cppCompiler: "cl", - compileTmpl: "/c $options $include /Fo$objfile $file", - buildGui: " /link /SUBSYSTEM:WINDOWS ", + 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: "$options $builddll /Fe$exefile $objfiles $buildgui", + linkTmpl: "$builddll$vccplatform /Fe$exefile $objfiles $buildgui /nologo $options", includeCmd: " /I", linkDirCmd: " /LIBPATH:", linkLibCmd: " $1.lib", @@ -126,8 +168,34 @@ compiler vcc: pic: "", asmStmtFrmt: "__asm{$n$1$n}$n", structStmtFmt: "$3$n$1 $2", + produceAsm: "/Fa$asmfile", + 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" + result.compilerExe = "clang-cl" + result.cppCompiler = "clang-cl" + result.linkerExe = "clang-cl" + result.linkTmpl = "-fuse-ld=lld " & result.linkTmpl + # Intel C/C++ Compiler compiler icl: result = vcc() @@ -142,30 +210,6 @@ compiler icc: result.compilerExe = "icc" result.linkerExe = "icc" -# Local C Compiler -compiler lcc: - result = ( - name: "lcc", - objExt: "obj", - optSpeed: " -O -p6 ", - optSize: " -O -p6 ", - compilerExe: "lcc", - cppCompiler: "", - compileTmpl: "$options $include -Fo$objfile $file", - buildGui: " -subsystem windows", - buildDll: " -dll", - buildLib: "", # XXX: not supported yet - linkerExe: "lcclnk", - linkTmpl: "$options $buildgui $builddll -O $exefile $objfiles", - includeCmd: " -I", - linkDirCmd: "", # XXX: not supported yet - linkLibCmd: "", # XXX: not supported yet - debug: " -g5 ", - pic: "", - asmStmtFrmt: "_asm{$n$1$n}$n", - structStmtFmt: "$1 $2", - props: {}) - # Borland C Compiler compiler bcc: result = ( @@ -188,58 +232,11 @@ compiler bcc: pic: "", asmStmtFrmt: "__asm{$n$1$n}$n", structStmtFmt: "$1 $2", + produceAsm: "", + cppXsupport: "", props: {hasSwitchRange, hasComputedGoto, hasCpp, hasGcGuard, hasAttribute}) - -# Digital Mars C Compiler -compiler dmc: - result = ( - name: "dmc", - objExt: "obj", - optSpeed: " -ff -o -6 ", - optSize: " -ff -o -6 ", - compilerExe: "dmc", - cppCompiler: "", - compileTmpl: "-c $options $include -o$objfile $file", - buildGui: " -L/exet:nt/su:windows", - buildDll: " -WD", - buildLib: "", # XXX: not supported yet - linkerExe: "dmc", - linkTmpl: "$options $buildgui $builddll -o$exefile $objfiles", - includeCmd: " -I", - linkDirCmd: "", # XXX: not supported yet - linkLibCmd: "", # XXX: not supported yet - debug: " -g ", - pic: "", - asmStmtFrmt: "__asm{$n$1$n}$n", - structStmtFmt: "$3$n$1 $2", - props: {hasCpp}) - -# Watcom C Compiler -compiler wcc: - result = ( - name: "wcc", - objExt: "obj", - optSpeed: " -ox -on -6 -d0 -fp6 -zW ", - optSize: "", - compilerExe: "wcl386", - cppCompiler: "", - compileTmpl: "-c $options $include -fo=$objfile $file", - buildGui: " -bw", - buildDll: " -bd", - buildLib: "", # XXX: not supported yet - linkerExe: "wcl386", - linkTmpl: "$options $buildgui $builddll -fe=$exefile $objfiles ", - includeCmd: " -i=", - linkDirCmd: "", # XXX: not supported yet - linkLibCmd: "", # XXX: not supported yet - debug: " -d2 ", - pic: "", - asmStmtFrmt: "__asm{$n$1$n}$n", - structStmtFmt: "$1 $2", - props: {hasCpp}) - # Tiny C Compiler compiler tcc: result = ( @@ -260,49 +257,26 @@ compiler tcc: linkLibCmd: "", # XXX: not supported yet debug: " -g ", pic: "", - asmStmtFrmt: "__asm{$n$1$n}$n", - structStmtFmt: "$1 $2", - props: {hasSwitchRange, hasComputedGoto}) - -# Pelles C Compiler -compiler pcc: - # Pelles C - result = ( - name: "pcc", - objExt: "obj", - optSpeed: " -Ox ", - optSize: " -Os ", - compilerExe: "cc", - cppCompiler: "", - compileTmpl: "-c $options $include -Fo$objfile $file", - buildGui: " -SUBSYSTEM:WINDOWS", - buildDll: " -DLL", - buildLib: "", # XXX: not supported yet - linkerExe: "cc", - linkTmpl: "$options $buildgui $builddll -OUT:$exefile $objfiles", - includeCmd: " -I", - linkDirCmd: "", # XXX: not supported yet - linkLibCmd: "", # XXX: not supported yet - debug: " -Zi ", - pic: "", - asmStmtFrmt: "__asm{$n$1$n}$n", + asmStmtFrmt: "asm($1);$n", structStmtFmt: "$1 $2", - props: {}) + produceAsm: gnuAsmListing, + cppXsupport: "", + props: {hasSwitchRange, hasComputedGoto, hasGnuAsm}) # Your C Compiler -compiler ucc: +compiler envcc: result = ( - name: "ucc", + name: "env", objExt: "o", optSpeed: " -O3 ", optSize: " -O1 ", - compilerExe: "cc", + compilerExe: "", cppCompiler: "", - compileTmpl: "-c $options $include -o $objfile $file", + compileTmpl: "-c $ccenvflags $options $include -o $objfile $file", 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 @@ -311,49 +285,63 @@ compiler ucc: pic: "", asmStmtFrmt: "__asm{$n$1$n}$n", structStmtFmt: "$1 $2", - props: {}) + produceAsm: "", + cppXsupport: "", + props: {hasGnuAsm}) const CC*: array[succ(low(TSystemCC))..high(TSystemCC), TInfoCC] = [ gcc(), + nintendoSwitchGCC(), llvmGcc(), clang(), - lcc(), bcc(), - dmc(), - wcc(), vcc(), tcc(), - pcc(), - ucc(), + envcc(), icl(), - icc()] + icc(), + clangcl(), + hipcc(), + nvcc()] hExt* = ".h" -proc libNameTmpl(conf: ConfigRef): string {.inline.} = - result = if conf.target.targetOS == osWindows: "$1.lib" else: "lib$1.a" +template writePrettyCmdsStderr(cmd) = + if cmd.len > 0: + flushDot(conf) + stderr.writeLine(cmd) proc nameToCC*(name: string): TSystemCC = ## Returns the kind of compiler referred to by `name`, or ccNone ## if the name doesn't refer to any known compiler. - for i in countup(succ(ccNone), high(TSystemCC)): + for i in succ(ccNone)..high(TSystemCC): if cmpIgnoreStyle(name, CC[i].name) == 0: return i result = ccNone +proc listCCnames(): string = + result = "" + for i in succ(ccNone)..high(TSystemCC): + if i > succ(ccNone): result.add ", " + result.add CC[i].name + +proc isVSCompatible*(conf: ConfigRef): bool = + return conf.cCompiler == ccVcc or + conf.cCompiler == ccClangCl or + (conf.cCompiler == ccIcl and conf.target.hostOS in osDos..osWindows) + proc getConfigVar(conf: ConfigRef; c: TSystemCC, suffix: string): string = # use ``cpu.os.cc`` for cross compilation, unless ``--compileOnly`` is given # for niminst support - let fullSuffix = - if conf.cmd == cmdCompileToCpp: - ".cpp" & suffix - elif conf.cmd == cmdCompileToOC: - ".objc" & suffix - elif conf.cmd == cmdCompileToJS: - ".js" & suffix - else: - suffix + var fullSuffix = suffix + case conf.backend + of backendCpp, backendJs, backendObjc: fullSuffix = "." & $conf.backend & suffix + of backendC: discard + of backendInvalid: + # during parsing of cfg files; we don't know the backend yet, no point in + # guessing wrong thing + return "" if (conf.target.hostOS != conf.target.targetOS or conf.target.hostCPU != conf.target.targetCPU) and optCompileOnly notin conf.globalOptions: @@ -361,8 +349,10 @@ 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: - # not overriden for this cross compilation setting? + if existsConfigVar(conf, fullCCname): + result = getConfigVar(conf, fullCCname) + else: + # not overridden for this cross compilation setting? result = getConfigVar(conf, CC[c].name & fullSuffix) else: result = getConfigVar(conf, CC[c].name & fullSuffix) @@ -370,16 +360,16 @@ proc getConfigVar(conf: ConfigRef; c: TSystemCC, suffix: string): string = proc setCC*(conf: ConfigRef; ccname: string; info: TLineInfo) = conf.cCompiler = nameToCC(ccname) if conf.cCompiler == ccNone: - localError(conf, info, "unknown C compiler: '$1'" % ccname) + localError(conf, info, "unknown C compiler: '$1'. Available options are: $2" % [ccname, listCCnames()]) conf.compileOptions = getConfigVar(conf, conf.cCompiler, ".options.always") conf.linkOptions = "" - conf.ccompilerpath = getConfigVar(conf, conf.cCompiler, ".path") - for i in countup(low(CC), high(CC)): undefSymbol(conf.symbols, CC[i].name) + conf.cCompilerPath = getConfigVar(conf, conf.cCompiler, ".path") + for c in CC: undefSymbol(conf.symbols, c.name) defineSymbol(conf.symbols, CC[conf.cCompiler].name) proc addOpt(dest: var string, src: string) = - if len(dest) == 0 or dest[len(dest)-1] != ' ': add(dest, " ") - add(dest, src) + if dest.len == 0 or dest[^1] != ' ': dest.add(" ") + dest.add(src) proc addLinkOption*(conf: ConfigRef; option: string) = addOpt(conf.linkOptions, option) @@ -396,26 +386,32 @@ proc addCompileOptionCmd*(conf: ConfigRef; option: string) = proc initVars*(conf: ConfigRef) = # we need to define the symbol here, because ``CC`` may have never been set! - for i in countup(low(CC), high(CC)): undefSymbol(conf.symbols, CC[i].name) + for c in CC: undefSymbol(conf.symbols, c.name) defineSymbol(conf.symbols, CC[conf.cCompiler].name) addCompileOption(conf, getConfigVar(conf, conf.cCompiler, ".options.always")) #addLinkOption(getConfigVar(cCompiler, ".options.linker")) - if len(conf.ccompilerpath) == 0: - conf.ccompilerpath = getConfigVar(conf, conf.cCompiler, ".path") + if conf.cCompilerPath.len == 0: + conf.cCompilerPath = getConfigVar(conf, conf.cCompiler, ".path") -proc completeCFilePath*(conf: ConfigRef; cfile: string, createSubDir: bool = true): string = +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: string): string = +proc toObjFile*(conf: ConfigRef; filename: AbsoluteFile): AbsoluteFile = # Object file for compilation - #if filename.endsWith(".cpp"): - # result = changeFileExt(filename, "cpp." & CC[cCompiler].objExt) - #else: - result = changeFileExt(filename, CC[conf.cCompiler].objExt) + result = AbsoluteFile(filename.string & "." & CC[conf.cCompiler].objExt) proc addFileToCompile*(conf: ConfigRef; cf: Cfile) = conf.toCompile.add(cf) +proc addLocalCompileOption*(conf: ConfigRef; option: string; nimfile: AbsoluteFile) = + 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) + conf.cfileSpecificOptions[key] = value + proc resetCompilationLists*(conf: ConfigRef) = conf.toCompile.setLen 0 ## XXX: we must associate these with their originating module @@ -424,11 +420,11 @@ proc resetCompilationLists*(conf: ConfigRef) = # Maybe we can do that in checkDep on the other hand? conf.externalToLink.setLen 0 -proc addExternalFileToLink*(conf: ConfigRef; filename: string) = - conf.externalToLink.insert(filename, 0) +proc addExternalFileToLink*(conf: ConfigRef; filename: AbsoluteFile) = + conf.externalToLink.insert(filename.string, 0) proc execWithEcho(conf: ConfigRef; cmd: string, msg = hintExecuting): int = - rawMessage(conf, msg, cmd) + rawMessage(conf, msg, if msg == hintLinking and not(optListCmd in conf.globalOptions or conf.verbosity > 1): "" else: cmd) result = execCmd(cmd) proc execExternalProgram*(conf: ConfigRef; cmd: string, msg = hintExecuting) = @@ -436,14 +432,12 @@ proc execExternalProgram*(conf: ConfigRef; cmd: string, msg = hintExecuting) = rawMessage(conf, errGenerated, "execution of an external program failed: '$1'" % cmd) -proc generateScript(conf: ConfigRef; projectFile: string, script: Rope) = - let (dir, name, ext) = splitFile(projectFile) - let filename = getNimcacheDir(conf) / addFileExt("compile_" & name, - platform.OS[conf.target.targetOS].scriptExt) - if writeRope(script, filename): - copyFile(conf.libpath / "nimbase.h", getNimcacheDir(conf) / "nimbase.h") - else: - rawMessage(conf, errGenerated, "could not write to file: " & filename) +proc generateScript(conf: ConfigRef; script: Rope) = + let (_, name, _) = splitFile(conf.outFile.string) + let filename = getNimcacheDir(conf) / RelativeFile(addFileExt("compile_" & name, + platform.OS[conf.target.targetOS].scriptExt)) + if not writeRope(script, filename): + rawMessage(conf, errGenerated, "could not write to file: " & filename.string) proc getOptSpeed(conf: ConfigRef; c: TSystemCC): string = result = getConfigVar(conf, c, ".options.speed") @@ -465,32 +459,56 @@ 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; cfilename: string): string = +proc cFileSpecificOptions(conf: ConfigRef; nimname, fullNimFile: string): string = result = conf.compileOptions + for option in conf.compileOptionsCmd: if strutils.find(result, option, 0) < 0: addOpt(result, option) - let trunk = splitFile(cfilename).name if optCDebug in conf.globalOptions: - let key = trunk & ".debug" + let key = nimname & ".debug" if existsConfigVar(conf, key): addOpt(result, getConfigVar(conf, key)) else: addOpt(result, getDebug(conf, conf.cCompiler)) if optOptimizeSpeed in conf.options: - let key = trunk & ".speed" + let key = nimname & ".speed" if existsConfigVar(conf, key): addOpt(result, getConfigVar(conf, key)) else: addOpt(result, getOptSpeed(conf, conf.cCompiler)) elif optOptimizeSize in conf.options: - let key = trunk & ".size" + let key = nimname & ".size" if existsConfigVar(conf, key): addOpt(result, getConfigVar(conf, key)) else: addOpt(result, getOptSize(conf, conf.cCompiler)) - let key = trunk & ".always" + let key = nimname & ".always" if existsConfigVar(conf, key): addOpt(result, getConfigVar(conf, key)) + addOpt(result, conf.cfileSpecificOptions.getOrDefault(fullNimFile)) + proc getCompileOptions(conf: ConfigRef): string = - result = cFileSpecificOptions(conf, "__dummy__") + result = cFileSpecificOptions(conf, "__dummy__", "__dummy__") + +proc vccplatform(conf: ConfigRef): string = + # VCC specific but preferable over the config hacks people + # had to do before, see #11306 + if conf.cCompiler == ccVcc: + let exe = getConfigVar(conf, conf.cCompiler, ".exe") + if "vccexe.exe" == extractFilename(exe): + result = case conf.target.targetCPU + of cpuI386: " --platform:x86" + of cpuArm: " --platform:arm" + of cpuAmd64: " --platform:amd64" + else: "" + else: + result = "" + else: + result = "" proc getLinkOptions(conf: ConfigRef): string = result = conf.linkOptions & " " & conf.linkOptionsCmd & " " @@ -503,178 +521,275 @@ proc needsExeExt(conf: ConfigRef): bool {.inline.} = result = (optGenScript in conf.globalOptions and conf.target.targetOS == osWindows) or (conf.target.hostOS == osWindows) -proc getCompilerExe(conf: ConfigRef; compiler: TSystemCC; cfile: string): string = - result = if conf.cmd == cmdCompileToCpp and not cfile.endsWith(".c"): - CC[compiler].cppCompiler - else: - CC[compiler].compilerExe +proc useCpp(conf: ConfigRef; cfile: AbsoluteFile): bool = + # 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: + getEnv("CXXFLAGS") + else: + getEnv("CFLAGS") + +proc getCompilerExe(conf: ConfigRef; compiler: TSystemCC; isCpp: bool): string = + if compiler == ccEnv: + result = if isCpp: + getEnv("CXX") + else: + getEnv("CC") + else: + result = if isCpp: + CC[compiler].cppCompiler + else: + CC[compiler].compilerExe if result.len == 0: rawMessage(conf, errGenerated, "Compiler '$1' doesn't support the requested target" % CC[compiler].name) +proc ccHasSaneOverflow*(conf: ConfigRef): bool = + if conf.cCompiler == ccGcc: + result = false # assume an old or crappy GCC + var exe = getConfigVar(conf, conf.cCompiler, ".exe") + if exe.len == 0: exe = CC[conf.cCompiler].compilerExe + # 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 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.cmd != cmdCompileToCpp: CC[compiler].cppCompiler - else: getCompilerExe(conf, compiler, "") + 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 + 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 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 -proc getCompileCFileCmd*(conf: ConfigRef; cfile: Cfile): string = - var c = conf.cCompiler - var options = cFileSpecificOptions(conf, cfile.cname) 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 and + if (optGenDynLib in conf.globalOptions or (conf.hcrOn and not isMainFile)) and ospNeedsPIC in platform.OS[conf.target.targetOS].props: - add(options, ' ' & CC[c].pic) + options.add(' ' & CC[c].pic) - var includeCmd, compilePattern: string - if not noAbsolutePaths(conf): - # compute include paths: - includeCmd = CC[c].includeCmd & quoteShell(conf.libpath) + if cfile.customArgs != "": + options.add ' ' + options.add cfile.customArgs + var compilePattern: string + # compute include paths: + var includeCmd = CC[c].includeCmd & quoteShell(conf.libpath) + if not noAbsolutePaths(conf): for includeDir in items(conf.cIncludes): includeCmd.add(join([CC[c].includeCmd, includeDir.quoteShell])) - compilePattern = joinPath(conf.ccompilerpath, exe) + compilePattern = joinPath(conf.cCompilerPath, exe) else: - includeCmd = "" - compilePattern = getCompilerExe(conf, c, cfile.cname) + compilePattern = exe - var cf = if noAbsolutePaths(conf): extractFilename(cfile.cname) + includeCmd.add(join([CC[c].includeCmd, quoteShell(conf.projectPath.string)])) + + let cf = if noAbsolutePaths(conf): AbsoluteFile extractFilename(cfile.cname.string) else: cfile.cname - var objfile = - if cfile.obj.len == 0: - if not cfile.flags.contains(CfileFlag.External) or noAbsolutePaths(conf): - toObjFile(conf, cf) + let objfile = + if cfile.obj.isEmpty: + if CfileFlag.External notin cfile.flags or noAbsolutePaths(conf): + toObjFile(conf, cf).string else: - completeCFilePath(conf, toObjFile(conf, cf)) + completeCfilePath(conf, toObjFile(conf, cf)).string elif noAbsolutePaths(conf): - extractFilename(cfile.obj) + extractFilename(cfile.obj.string) else: - cfile.obj + cfile.obj.string + + # D files are required by nintendo switch libs for + # compilation. They are basically a list of all includes. + let dfile = objfile.changeFileExt(".d").quoteShell - objfile = quoteShell(objfile) - cf = quoteShell(cf) + let cfsh = quoteShell(cf) result = quoteShell(compilePattern % [ - "file", cf, "objfile", objfile, "options", options, - "include", includeCmd, "nim", getPrefixDir(conf), - "nim", getPrefixDir(conf), "lib", conf.libpath]) - add(result, ' ') - addf(result, CC[c].compileTmpl, [ - "file", cf, "objfile", objfile, + "dfile", dfile, + "file", cfsh, "objfile", quoteShell(objfile), "options", options, + "include", includeCmd, "nim", getPrefixDir(conf).string, + "lib", conf.libpath.string, + "ccenvflags", envFlags(conf)]) + + if optProduceAsm in conf.globalOptions: + if CC[conf.cCompiler].produceAsm.len > 0: + let asmfile = objfile.changeFileExt(".asm").quoteShell + addOpt(result, CC[conf.cCompiler].produceAsm % ["asmfile", asmfile]) + if produceOutput: + rawMessage(conf, hintUserRaw, "Produced assembler here: " & asmfile) + else: + if produceOutput: + rawMessage(conf, hintUserRaw, "Couldn't produce assembler listing " & + "for the selected C compiler: " & CC[conf.cCompiler].name) + + result.add(' ') + strutils.addf(result, CC[c].compileTmpl, [ + "dfile", dfile, + "file", cfsh, "objfile", quoteShell(objfile), "options", options, "include", includeCmd, "nim", quoteShell(getPrefixDir(conf)), - "nim", quoteShell(getPrefixDir(conf)), - "lib", quoteShell(conf.libpath)]) + "lib", quoteShell(conf.libpath), + "vccplatform", vccplatform(conf), + "ccenvflags", envFlags(conf)]) proc footprint(conf: ConfigRef; cfile: Cfile): SecureHash = result = secureHash( - $secureHashFile(cfile.cname) & + $secureHashFile(cfile.cname.string) & platform.OS[conf.target.targetOS].name & platform.CPU[conf.target.targetCPU].name & extccomp.CC[conf.cCompiler].name & getCompileCFileCmd(conf, cfile)) proc externalFileChanged(conf: ConfigRef; cfile: Cfile): bool = - if conf.cmd notin {cmdCompileToC, cmdCompileToCpp, cmdCompileToOC, cmdCompileToLLVM}: - return false + if conf.backend == backendJs: return false # pre-existing behavior, but not sure it's good - var hashFile = toGeneratedFile(conf, conf.withPackageName(cfile.cname), "sha1") - var currentHash = footprint(conf, cfile) - var f: File - if open(f, hashFile, fmRead): + let hashFile = toGeneratedFile(conf, conf.mangleModuleName(cfile.cname).AbsoluteFile, "sha1") + let currentHash = footprint(conf, cfile) + var f: File = default(File) + if open(f, hashFile.string, fmRead): let oldHash = parseSecureHash(f.readLine()) close(f) result = oldHash != currentHash else: result = true if result: - if open(f, hashFile, fmWrite): + if open(f, hashFile.string, fmWrite): f.writeLine($currentHash) close(f) proc addExternalFileToCompile*(conf: ConfigRef; c: var Cfile) = - if optForceFullMake notin conf.globalOptions and not externalFileChanged(conf, c): + # we want to generate the hash file unconditionally + let extFileChanged = externalFileChanged(conf, c) + if optForceFullMake notin conf.globalOptions and fileExists(c.obj) and + not extFileChanged: c.flags.incl CfileFlag.Cached + else: + # make sure Nim keeps recompiling the external file on reruns + # if compilation is not successful + discard tryRemoveFile(c.obj.string) conf.toCompile.add(c) -proc addExternalFileToCompile*(conf: ConfigRef; filename: string) = - var c = Cfile(cname: filename, - obj: toObjFile(conf, completeCFilePath(conf, changeFileExt(filename, ""), false)), +proc addExternalFileToCompile*(conf: ConfigRef; filename: AbsoluteFile) = + var c = Cfile(nimname: splitFile(filename).name, cname: filename, + obj: toObjFile(conf, completeCfilePath(conf, filename, false)), flags: {CfileFlag.External}) addExternalFileToCompile(conf, c) -proc compileCFile(conf: ConfigRef; list: CFileList, script: var Rope, cmds: var TStringSeq, - prettyCmds: var TStringSeq) = - for it in list: - # call the C compiler for the .c file: - if it.flags.contains(CfileFlag.Cached): continue - var compileCmd = getCompileCFileCmd(conf, it) - if optCompileOnly notin conf.globalOptions: - add(cmds, compileCmd) - let (_, name, _) = splitFile(it.cname) - add(prettyCmds, "CC: " & name) - if optGenScript in conf.globalOptions: - add(script, compileCmd) - add(script, "\n") - -proc getLinkCmd(conf: ConfigRef; projectfile, objfiles: string): string = +proc getLinkCmd(conf: ConfigRef; output: AbsoluteFile, + objfiles: string, isDllBuild: bool, removeStaticFile: bool): string = if optGenStaticLib in conf.globalOptions: - var libname: string - if conf.outFile.len > 0: - libname = conf.outFile.expandTilde - if not libname.isAbsolute(): - libname = getCurrentDir() / libname - else: - libname = (libNameTmpl(conf) % splitFile(conf.projectName).name) - result = CC[conf.cCompiler].buildLib % ["libfile", libname, - "objfiles", objfiles] + if removeStaticFile: + removeFile output # fixes: bug #16947 + result = CC[conf.cCompiler].buildLib % ["libfile", quoteShell(output), + "objfiles", objfiles, + "vccplatform", vccplatform(conf)] else: var linkerExe = getConfigVar(conf, conf.cCompiler, ".linkerexe") - if len(linkerExe) == 0: linkerExe = getLinkerExe(conf, conf.cCompiler) + if linkerExe.len == 0: linkerExe = getLinkerExe(conf, conf.cCompiler) # bug #6452: We must not use ``quoteShell`` here for ``linkerExe`` if needsExeExt(conf): linkerExe = addFileExt(linkerExe, "exe") if noAbsolutePaths(conf): result = linkerExe - else: result = joinPath(conf.cCompilerpath, linkerExe) - let buildgui = if optGenGuiApp in conf.globalOptions: CC[conf.cCompiler].buildGui - else: "" - var exefile, builddll: string - if optGenDynLib in conf.globalOptions: - exefile = platform.OS[conf.target.targetOS].dllFrmt % splitFile(projectfile).name - builddll = CC[conf.cCompiler].buildDll - else: - exefile = splitFile(projectfile).name & platform.OS[conf.target.targetOS].exeExt - builddll = "" - if conf.outFile.len > 0: - exefile = conf.outFile.expandTilde - if not exefile.isAbsolute(): - exefile = getCurrentDir() / exefile - if not noAbsolutePaths(conf): - if not exefile.isAbsolute(): - exefile = joinPath(splitFile(projectfile).dir, exefile) + else: result = joinPath(conf.cCompilerPath, linkerExe) + let buildgui = if optGenGuiApp in conf.globalOptions and conf.target.targetOS == osWindows: + CC[conf.cCompiler].buildGui + else: + "" + let builddll = if isDllBuild: CC[conf.cCompiler].buildDll else: "" + let exefile = quoteShell(output) + when false: if optCDebug in conf.globalOptions: writeDebugInfo(exefile.changeFileExt("ndb")) - exefile = quoteShell(exefile) + + # Map files are required by Nintendo Switch compilation. They are a list + # of all function calls in the library and where they come from. + let mapfile = quoteShell(getNimcacheDir(conf) / RelativeFile(splitFile(output).name & ".map")) + let linkOptions = getLinkOptions(conf) & " " & getConfigVar(conf, conf.cCompiler, ".options.linker") var linkTmpl = getConfigVar(conf, conf.cCompiler, ".linkTmpl") if linkTmpl.len == 0: linkTmpl = CC[conf.cCompiler].linkTmpl result = quoteShell(result % ["builddll", builddll, + "mapfile", mapfile, "buildgui", buildgui, "options", linkOptions, "objfiles", objfiles, - "exefile", exefile, "nim", getPrefixDir(conf), "lib", conf.libpath]) + "exefile", exefile, "nim", getPrefixDir(conf).string, "lib", conf.libpath.string]) result.add ' ' - addf(result, linkTmpl, ["builddll", builddll, + strutils.addf(result, linkTmpl, ["builddll", builddll, + "mapfile", mapfile, "buildgui", buildgui, "options", linkOptions, "objfiles", objfiles, "exefile", exefile, "nim", quoteShell(getPrefixDir(conf)), - "lib", quoteShell(conf.libpath)]) - -template tryExceptOSErrorMessage(conf: ConfigRef; errorPrefix: string = "", body: untyped): typed = + "lib", quoteShell(conf.libpath), + "vccplatform", vccplatform(conf)]) + # On windows the debug information for binaries is emitted in a separate .pdb + # file and the binaries (.dll and .exe) contain a full path to that .pdb file. + # This is a problem for hot code reloading because even when we copy the .dll + # and load the copy so the build process may overwrite the original .dll on + # the disk (windows locks the files of running binaries) the copy still points + # to the original .pdb (and a simple copy of the .pdb won't help). This is a + # problem when a debugger is attached to the program we are hot-reloading. + # This problem is nonexistent on Unix since there by default debug symbols + # are embedded in the binaries so loading a copy of a .so will be fine. There + # is the '/Z7' flag for the MSVC compiler to embed the debug info of source + # files into their respective .obj files but the linker still produces a .pdb + # when a final .dll or .exe is linked so the debug info isn't embedded. + # There is also the issue that even when a .dll is unloaded the debugger + # still keeps the .pdb for that .dll locked. This is a major problem and + # because of this we cannot just alternate between 2 names for a .pdb file + # when rebuilding a .dll - instead we need to accumulate differently named + # .pdb files in the nimcache folder - this is the easiest and most reliable + # way of being able to debug and rebuild the program at the same time. This + # is accomplished using the /PDB:<filename> flag (there also exists the + # /PDBALTPATH:<filename> flag). The only downside is that the .pdb files are + # at least 300kb big (when linking statically to the runtime - or else 5mb+) + # and will quickly accumulate. There is a hacky solution: we could try to + # delete all .pdb files with a pattern and swallow exceptions. + # + # links about .pdb files and hot code reloading: + # https://ourmachinery.com/post/dll-hot-reloading-in-theory-and-practice/ + # https://ourmachinery.com/post/little-machines-working-together-part-2/ + # https://github.com/fungos/cr + # https://fungos.github.io/blog/2017/11/20/cr.h-a-simple-c-hot-reload-header-only-library/ + # on forcing the debugger to unlock a locked .pdb of an unloaded library: + # https://blog.molecular-matters.com/2017/05/09/deleting-pdb-files-locked-by-visual-studio/ + # and a bit about the .pdb format in case that is ever needed: + # https://github.com/crosire/blink + # http://www.debuginfo.com/articles/debuginfomatch.html#pdbfiles + if conf.hcrOn and isVSCompatible(conf): + let t = now() + let pdb = output.string & "." & format(t, "MMMM-yyyy-HH-mm-") & $t.nanosecond & ".pdb" + result.add " /link /PDB:" & pdb + if optCDebug in conf.globalOptions and conf.cCompiler == ccVcc: + result.add " /Zi /FS /Od" + +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: body except OSError: @@ -686,22 +801,27 @@ template tryExceptOSErrorMessage(conf: ConfigRef; errorPrefix: string = "", body (ose.msg & " " & $ose.errorCode)) 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 + result.add "dsymutil " & $(output).quoteShell + proc execLinkCmd(conf: ConfigRef; linkCmd: string) = tryExceptOSErrorMessage(conf, "invocation of external linker program failed."): - execExternalProgram(conf, linkCmd, - if optListCmd in conf.globalOptions or conf.verbosity > 1: hintExecuting else: hintLinking) + execExternalProgram(conf, linkCmd, hintLinking) proc execCmdsInParallel(conf: ConfigRef; cmds: seq[string]; prettyCb: proc (idx: int)) = let runCb = proc (idx: int, p: Process) = let exitCode = p.peekExitCode if exitCode != 0: rawMessage(conf, errGenerated, "execution of an external compiler program '" & - cmds[idx] & "' failed with exit code: " & $exitCode & "\n\n" & - p.outputStream.readAll.strip) + cmds[idx] & "' failed with exit code: " & $exitCode & "\n\n") if conf.numberOfProcessors == 0: conf.numberOfProcessors = countProcessors() var res = 0 if conf.numberOfProcessors <= 1: - for i in countup(0, high(cmds)): + for i in 0..high(cmds): tryExceptOSErrorMessage(conf, "invocation of external compiler program failed."): res = execWithEcho(conf, cmds[i]) if res != 0: @@ -709,34 +829,107 @@ proc execCmdsInParallel(conf: ConfigRef; cmds: seq[string]; prettyCb: proc (idx: cmds[i]) else: tryExceptOSErrorMessage(conf, "invocation of external compiler program failed."): - if optListCmd in conf.globalOptions or conf.verbosity > 1: - res = execProcesses(cmds, {poEchoCmd, poStdErrToStdOut, poUsePath}, - conf.numberOfProcessors, afterRunEvent=runCb) - elif conf.verbosity == 1: - res = execProcesses(cmds, {poStdErrToStdOut, poUsePath}, + res = execProcesses(cmds, {poStdErrToStdOut, poUsePath, poParentStreams}, conf.numberOfProcessors, prettyCb, afterRunEvent=runCb) - else: - res = execProcesses(cmds, {poStdErrToStdOut, poUsePath}, - conf.numberOfProcessors, afterRunEvent=runCb) if res != 0: if conf.numberOfProcessors <= 1: rawMessage(conf, errGenerated, "execution of an external program failed: '$1'" % cmds.join()) -proc callCCompiler*(conf: ConfigRef; projectfile: string) = +proc linkViaResponseFile(conf: ConfigRef; cmd: string) = + # Extracting the linker.exe here is a bit hacky but the best solution + # given ``buildLib``'s design. + var i = 0 + var last = 0 + if cmd.len > 0 and cmd[0] == '"': + inc i + while i < cmd.len and cmd[i] != '"': inc i + last = i + inc i + else: + while i < cmd.len and cmd[i] != ' ': inc i + last = i + while i < cmd.len and cmd[i] == ' ': inc i + let linkerArgs = conf.projectName & "_" & "linkerArgs.txt" + let args = cmd.substr(i) + # GCC's response files don't support backslashes. Junk. + if conf.cCompiler == ccGcc or conf.cCompiler == ccCLang: + writeFile(linkerArgs, args.replace('\\', '/')) + else: + writeFile(linkerArgs, args) + try: + 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 + +proc hcrLinkTargetName(conf: ConfigRef, objFile: string, isMain = false): AbsoluteFile = + let basename = splitFile(objFile).name + let targetName = if isMain: basename & ".exe" + else: platform.OS[conf.target.targetOS].dllFrmt % basename + 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] % (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: + 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 = @[] - let prettyCb = proc (idx: int) = - when declared(echo): - echo prettyCmds[idx] - compileCFile(conf, conf.toCompile, script, cmds, prettyCmds) + 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: + # call the C compiler for the .c file: + if CfileFlag.Cached in it.flags: continue + let compileCmd = getCompileCFileCmd(conf, it, idx == conf.toCompile.len - 1, produceOutput=true) + if optCompileOnly notin conf.globalOptions: + cmds.add(compileCmd) + prettyCmds.add displayProgressCC(conf, $it.cname, compileCmd) + if optGenScript in conf.globalOptions: + script.add(compileCmd) + script.add("\n") + if optCompileOnly notin conf.globalOptions: execCmdsInParallel(conf, cmds, prettyCb) if optNoLinking notin conf.globalOptions: @@ -744,140 +937,186 @@ proc callCCompiler*(conf: ConfigRef; projectfile: string) = var objfiles = "" for it in conf.externalToLink: let objFile = if noAbsolutePaths(conf): it.extractFilename else: it - add(objfiles, ' ') - add(objfiles, quoteShell( + objfiles.add(' ') + objfiles.add(quoteShell( addFileExt(objFile, CC[conf.cCompiler].objExt))) - for x in conf.toCompile: - let objFile = if noAbsolutePaths(conf): x.obj.extractFilename else: x.obj - add(objfiles, ' ') - add(objfiles, quoteShell(objFile)) - linkCmd = getLinkCmd(conf, projectfile, objfiles) - if optCompileOnly notin conf.globalOptions: - execLinkCmd(conf, linkCmd) + if conf.hcrOn: # lets assume that optCompileOnly isn't on + cmds = @[] + let mainFileIdx = conf.toCompile.len - 1 + for idx, x in conf.toCompile: + # don't relink each of the many binaries (one for each source file) if the nim code is + # cached because that would take too much time for small changes - the only downside to + # this is that if an external-to-link file changes the final target wouldn't be relinked + if CfileFlag.Cached in x.flags: continue + # we pass each object file as if it is the project file - a .dll will be created for each such + # object file in the nimcache directory, and only in the case of the main project file will + # there be probably an executable (if the project is such) which will be copied out of the nimcache + 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, 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): + for pdb in walkFiles(objFile & ".*.pdb"): + discard tryRemoveFile(pdb) + # execute link commands in parallel - output will be a bit different + # if it fails than that from execLinkCmd() but that doesn't matter + prettyCmds = map(prettyCmds, proc (curr: string): string = return curr.replace("CC", "Link")) + execCmdsInParallel(conf, cmds, prettyCb) + # only if not cached - copy the resulting main file from the nimcache folder to its originally intended destination + if CfileFlag.Cached notin conf.toCompile[mainFileIdx].flags: + let mainObjFile = getObjFilePath(conf, conf.toCompile[mainFileIdx]) + let src = conf.hcrLinkTargetName(mainObjFile, true) + let dst = conf.prepareToWriteOutput + copyFileWithPermissions(src.string, dst.string) + else: + for x in conf.toCompile: + let objFile = if noAbsolutePaths(conf): x.obj.extractFilename else: x.obj.string + objfiles.add(' ') + objfiles.add(quoteShell(objFile)) + let mainOutput = if optGenScript notin conf.globalOptions: conf.prepareToWriteOutput + else: AbsoluteFile(conf.outFile) + + linkCmd = getLinkCmd(conf, mainOutput, objfiles, removeStaticFile = true) + extraCmds = getExtraCmds(conf, mainOutput) + if optCompileOnly notin conf.globalOptions: + preventLinkCmdMaxCmdLen(conf, linkCmd) + for cmd in extraCmds: + execExternalProgram(conf, cmd, hintExecuting) else: linkCmd = "" if optGenScript in conf.globalOptions: - add(script, linkCmd) - add(script, "\n") - generateScript(conf, projectfile, script) - -#from json import escapeJson -import json - -proc writeJsonBuildInstructions*(conf: ConfigRef; projectfile: string) = - template lit(x: untyped) = f.write x - template str(x: untyped) = - when compiles(escapeJson(x, buf)): - buf.setLen 0 - escapeJson(x, buf) - f.write buf - else: - f.write escapeJson(x) - - proc cfiles(conf: ConfigRef; f: File; buf: var string; clist: CfileList, isExternal: bool) = - var pastStart = false - for it in clist: - if CfileFlag.Cached in it.flags: continue - let compileCmd = getCompileCFileCmd(conf, it) - if pastStart: lit "],\L" - lit "[" - str it.cname - lit ", " - str compileCmd - pastStart = true - lit "]\L" - - 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) - add(objfiles, ' ') - add(objfiles, objstr) - if pastStart: lit ",\L" - str objstr - pastStart = true - - for it in clist: - let objstr = quoteShell(it.obj) - add(objfiles, ' ') - add(objfiles, objstr) - if pastStart: lit ",\L" - str objstr - pastStart = true - lit "\L" - - var buf = newStringOfCap(50) - - let file = projectfile.splitFile.name - let jsonFile = toGeneratedFile(conf, file, "json") - - var f: File - if open(f, jsonFile, fmWrite): - lit "{\"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, projectfile, objfiles) - lit "\L}\L" - close(f) - -proc runJsonBuildInstructions*(conf: ConfigRef; projectfile: string) = - let file = projectfile.splitFile.name - let jsonFile = toGeneratedFile(conf, file, "json") - try: - let data = json.parseFile(jsonFile) - let toCompile = data["compile"] - doAssert toCompile.kind == JArray - var cmds: TStringSeq = @[] - var prettyCmds: TStringSeq = @[] - for c in toCompile: - doAssert c.kind == JArray - doAssert c.len >= 2 - - add(cmds, c[1].getStr) - let (_, name, _) = splitFile(c[0].getStr) - add(prettyCmds, "CC: " & name) - - let prettyCb = proc (idx: int) = - when declared(echo): - echo prettyCmds[idx] - execCmdsInParallel(conf, cmds, prettyCb) - - let linkCmd = data["linkcmd"] - doAssert linkCmd.kind == JString - execLinkCmd(conf, linkCmd.getStr) - except: - when declared(echo): - echo getCurrentException().getStackTrace() - quit "error evaluating JSON file: " & jsonFile - -proc genMappingFiles(conf: ConfigRef; list: CFileList): Rope = + script.add(linkCmd) + script.add("\n") + generateScript(conf, script) + +template hashNimExe(): string = $secureHashFile(os.getAppFilename()) + +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 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 + 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: + 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() + 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: - addf(result, "--file:r\"$1\"$N", [rope(it.cname)]) + result.addf("--file:r\"$1\"$N", [rope(it.cname.string)]) proc writeMapping*(conf: ConfigRef; symbolMapping: Rope) = if optGenMapping notin conf.globalOptions: return var code = rope("[C_Files]\n") - add(code, genMappingFiles(conf, conf.toCompile)) - add(code, "\n[C_Compiler]\nFlags=") - add(code, strutils.escape(getCompileOptions(conf))) + code.add(genMappingFiles(conf, conf.toCompile)) + code.add("\n[C_Compiler]\nFlags=") + code.add(strutils.escape(getCompileOptions(conf))) - add(code, "\n[Linker]\nFlags=") - add(code, strutils.escape(getLinkOptions(conf) & " " & + code.add("\n[Linker]\nFlags=") + code.add(strutils.escape(getLinkOptions(conf) & " " & getConfigVar(conf, conf.cCompiler, ".options.linker"))) - add(code, "\n[Environment]\nlibpath=") - add(code, strutils.escape(conf.libpath)) + code.add("\n[Environment]\nlibpath=") + code.add(strutils.escape(conf.libpath.string)) - addf(code, "\n[Symbols]$n$1", [symbolMapping]) - let filename = joinPath(conf.projectPath, "mapping.txt") + code.addf("\n[Symbols]$n$1", [symbolMapping]) + let filename = conf.projectPath / RelativeFile"mapping.txt" if not writeRope(code, filename): - rawMessage(conf, errGenerated, "could not write to file: " & filename) + rawMessage(conf, errGenerated, "could not write to file: " & filename.string) diff --git a/compiler/filter_tmpl.nim b/compiler/filter_tmpl.nim index 09455ced7..921a94b31 100644 --- a/compiler/filter_tmpl.nim +++ b/compiler/filter_tmpl.nim @@ -10,8 +10,10 @@ # This module implements Nim's standard template filter. import - llstream, os, wordrecg, idents, strutils, ast, astalgo, msgs, options, - renderer, filters, lineinfos + llstream, ast, msgs, options, + filters, lineinfos, pathutils + +import std/strutils type TParseState = enum @@ -22,7 +24,7 @@ type info: TLineInfo indent, emitPar: int x: string # the current input line - outp: PLLStream # the ouput 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 @@ -75,7 +77,7 @@ proc parseLine(p: var TTmplParser) = let d = j var keyw = "" while j < len and p.x[j] in PatternChars: - add(keyw, p.x[j]) + keyw.add(p.x[j]) inc(j) scanPar(p, j) @@ -199,23 +201,22 @@ proc parseLine(p: var TTmplParser) = inc(j) llStreamWrite(p.outp, "\\n\"") -proc filterTmpl*(stdin: PLLStream, filename: string, call: PNode; conf: ConfigRef): 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) +proc filterTmpl*(conf: ConfigRef, stdin: PLLStream, filename: AbsoluteFile, + call: PNode): PLLStream = + 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): - p.info.line = p.info.line + 1'u16 + inc p.info.line while llStreamReadLine(p.inp, p.x): - p.info.line = p.info.line + 1'u16 + inc p.info.line parseLine(p) newLine(p) result = p.outp diff --git a/compiler/filters.nim b/compiler/filters.nim index 3ebbad678..3cd56e3be 100644 --- a/compiler/filters.nim +++ b/compiler/filters.nim @@ -10,8 +10,10 @@ # This module implements Nim's simple filters and helpers for filters. import - llstream, os, wordrecg, idents, strutils, ast, astalgo, msgs, options, - renderer + llstream, idents, ast, msgs, options, + renderer, pathutils + +import std/strutils proc invalidPragma(conf: ConfigRef; n: PNode) = localError(conf, n.info, @@ -20,34 +22,41 @@ proc invalidPragma(conf: ConfigRef; n: PNode) = proc getArg(conf: ConfigRef; n: PNode, name: string, pos: int): PNode = result = nil if n.kind in {nkEmpty..nkNilLit}: return - for i in countup(1, sonsLen(n) - 1): - if n.sons[i].kind == nkExprEqExpr: - if n.sons[i].sons[0].kind != nkIdent: invalidPragma(conf, n) - if cmpIgnoreStyle(n.sons[i].sons[0].ident.s, name) == 0: - return n.sons[i].sons[1] + for i in 1..<n.len: + if n[i].kind == nkExprEqExpr: + if n[i][0].kind != nkIdent: invalidPragma(conf, n) + if cmpIgnoreStyle(n[i][0].ident.s, name) == 0: + return n[i][1] elif i == pos: - return n.sons[i] + 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: string, call: PNode): PLLStream = +proc filterStrip*(conf: ConfigRef; stdin: PLLStream, filename: AbsoluteFile, call: PNode): PLLStream = var pattern = strArg(conf, call, "startswith", 1, "") var leading = boolArg(conf, call, "leading", 2, true) var trailing = boolArg(conf, call, "trailing", 3, true) @@ -55,15 +64,15 @@ proc filterStrip*(conf: ConfigRef; stdin: PLLStream, filename: string, call: PNo var line = newStringOfCap(80) while llStreamReadLine(stdin, line): var stripped = strip(line, leading, trailing) - if len(pattern) == 0 or startsWith(stripped, pattern): + if pattern.len == 0 or startsWith(stripped, pattern): llStreamWriteln(result, stripped) else: llStreamWriteln(result, line) llStreamClose(stdin) -proc filterReplace*(conf: ConfigRef; stdin: PLLStream, filename: string, call: PNode): PLLStream = +proc filterReplace*(conf: ConfigRef; stdin: PLLStream, filename: AbsoluteFile, call: PNode): PLLStream = var sub = strArg(conf, call, "sub", 1, "") - if len(sub) == 0: invalidPragma(conf, call) + if sub.len == 0: invalidPragma(conf, call) var by = strArg(conf, call, "by", 2, "") result = llStreamOpen("") var line = newStringOfCap(80) diff --git a/compiler/forloops.nim b/compiler/forloops.nim deleted file mode 100644 index 2cd1db7f7..000000000 --- a/compiler/forloops.nim +++ /dev/null @@ -1,89 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2015 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements for loop detection for better C code generation. - -import ast, astalgo - -const - someCmp = {mEqI, mEqF64, mEqEnum, mEqCh, mEqB, mEqRef, mEqProc, - mEqUntracedRef, mLeI, mLeF64, mLeU, mLeU64, mLeEnum, - mLeCh, mLeB, mLePtr, mLtI, mLtF64, mLtU, mLtU64, mLtEnum, - mLtCh, mLtB, mLtPtr} - -proc isCounter(s: PSym): bool {.inline.} = - s.kind in {skResult, skVar, skLet, skTemp} and - {sfGlobal, sfAddrTaken} * s.flags == {} - -proc isCall(n: PNode): bool {.inline.} = - n.kind in nkCallKinds and n[0].kind == nkSym - -proc fromSystem(op: PSym): bool = sfSystemModule in getModule(op).flags - -proc getCounter(lastStmt: PNode): PSym = - if lastStmt.isCall: - let op = lastStmt.sym - if op.magic in {mDec, mInc} or - ((op.name.s == "+=" or op.name.s == "-=") and op.fromSystem): - if op[1].kind == nkSym and isCounter(op[1].sym): - result = op[1].sym - -proc counterInTree(n, loop: PNode; counter: PSym): bool = - # prune the search tree: within the loop the counter may be used: - if n == loop: return - case n.kind - of nkSym: - if n.sym == counter: return true - of nkVarSection, nkLetSection: - # definitions are fine! - for it in n: - if counterInTree(it.lastSon): return true - else: - for i in 0 ..< safeLen(n): - if counterInTree(n[i], loop, counter): return true - -proc copyExcept(n: PNode, x, dest: PNode) = - if x == n: return - if n.kind in {nkStmtList, nkStmtListExpr}: - for i in 0 ..< n.len: copyExcept(n[i], x, dest) - else: - dest.add n - -type - ForLoop* = object - counter*: PSym - init*, cond*, increment*, body*: PNode - -proc extractForLoop*(loop, fullTree: PNode): ForLoop = - ## returns 'counter == nil' if the while loop 'n' is not a for loop: - assert loop.kind == nkWhileStmt - let cond == loop[0] - - if not cond.isCall: return - if cond[0].sym.magic notin someCmp: return - - var lastStmt = loop[1] - while lastStmt.kind in {nkStmtList, nkStmtListExpr}: - lastStmt = lastStmt.lastSon - - let counter = getCounter(lastStmt) - if counter.isNil or counter.ast.isNil: return - - template `=~`(a, b): expr = a.kind == nkSym and a.sym == b - - if cond[1] =~ counter or cond[2] =~ counter: - # ok, now check 'counter' is not used *after* the loop - if counterInTree(fullTree, loop, counter): return - # ok, success, fill in the fields: - result.counter = counter - result.init = counter.ast - result.cond = cond - result.increment = lastStmt - result.body = newNodeI(nkStmtList, loop[1].info) - copyExcept(loop[1], lastStmt, result.body) diff --git a/compiler/gorgeimpl.nim b/compiler/gorgeimpl.nim index 44ad46136..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, strutils, options, - lineinfos +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,35 +30,45 @@ proc readOutput(p: Process): (string, int) = proc opGorge*(cmd, input, cache: string, info: TLineInfo; conf: ConfigRef): (string, int) = let workingDir = parentDir(toFullPath(conf, info)) - if cache.len > 0:# and optForceFullMake notin gGlobalOptions: + result = ("", 0) + if cache.len > 0: let h = secureHash(cmd & "\t" & input & "\t" & cache) - let filename = options.toGeneratedFile(conf, "gorge_" & $h, "txt") - var f: File - if open(f, filename): + let filename = toGeneratedFile(conf, AbsoluteFile("gorge_" & $h), "txt").string + var f: File = default(File) + if optForceFullMake notin conf.globalOptions and open(f, filename): result = (f.readAll, 0) f.close return var readSuccessful = false try: var p = startProcess(cmd, workingDir, - options={poEvalCommand, poStderrToStdout}) + options={poEvalCommand, poStdErrToStdOut}) if input.len != 0: p.inputStream.write(input) p.inputStream.close() result = p.readOutput + p.close() readSuccessful = true # only cache successful runs: 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, - options={poEvalCommand, poStderrToStdout}) + options={poEvalCommand, poStdErrToStdOut}) if input.len != 0: p.inputStream.write(input) p.inputStream.close() 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 99bb51fce..bbb239867 100644 --- a/compiler/guards.nim +++ b/compiler/guards.nim @@ -10,22 +10,24 @@ ## This module implements the 'implies' relation for guards. import ast, astalgo, msgs, magicsys, nimsets, trees, types, renderer, idents, - saturate, modulegraphs, options, lineinfos + saturate, modulegraphs, options, lineinfos, int128 + +when defined(nimPreviewSlimSystem): + import std/assertions const someEq = {mEqI, mEqF64, mEqEnum, mEqCh, mEqB, mEqRef, mEqProc, - mEqUntracedRef, mEqStr, mEqSet, mEqCString} + mEqStr, mEqSet, mEqCString} # set excluded here as the semantics are vastly different: - someLe = {mLeI, mLeF64, mLeU, mLeU64, mLeEnum, + someLe = {mLeI, mLeF64, mLeU, mLeEnum, mLeCh, mLeB, mLePtr, mLeStr} - someLt = {mLtI, mLtF64, mLtU, mLtU64, mLtEnum, + someLt = {mLtI, mLtF64, mLtU, mLtEnum, mLtCh, mLtB, mLtPtr, mLtStr} - someLen = {mLengthOpenArray, mLengthStr, mLengthArray, mLengthSeq, - mXLenStr, mXLenSeq} + someLen = {mLengthOpenArray, mLengthStr, mLengthArray, mLengthSeq} - someIn = {mInRange, mInSet} + someIn = {mInSet} someHigh = {mHigh} # we don't list unsigned here because wrap around semantics suck for @@ -35,8 +37,8 @@ const someMul = {mMulI, mMulF64} someDiv = {mDivI, mDivF64} someMod = {mModI} - someMax = {mMaxI, mMaxF64} - someMin = {mMinI, mMinF64} + someMax = {mMaxI} + someMin = {mMinI} someBinaryOp = someAdd+someSub+someMul+someMax+someMin proc isValue(n: PNode): bool = n.kind in {nkCharLit..nkNilLit} @@ -47,8 +49,12 @@ proc isLet(n: PNode): bool = if n.sym.kind in {skLet, skTemp, skForVar}: result = true elif n.sym.kind == skParam and skipTypes(n.sym.typ, - abstractInst).kind != tyVar: + 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,16 +71,19 @@ proc isLetLocation(m: PNode, isApprox: bool): bool = while true: case n.kind of nkDotExpr, nkCheckedFieldExpr, nkObjUpConv, nkObjDownConv: - n = n.sons[0] - of nkDerefExpr, nkHiddenDeref: - n = n.sons[0] + n = n[0] + of nkDerefExpr: + n = n[0] inc derefs + of nkHiddenDeref: + n = n[0] + if not isApprox: inc derefs of nkBracketExpr: - if isConstExpr(n.sons[1]) or isLet(n.sons[1]): - n = n.sons[0] + if isConstExpr(n[1]) or isLet(n[1]) or isConstExpr(n[1].skipConv): + n = n[0] else: return of nkHiddenStdConv, nkHiddenSubConv, nkConv: - n = n.sons[1] + n = n[1] else: break result = n.isLet and derefs <= ord(isApprox) @@ -83,56 +92,36 @@ proc isLetLocation(m: PNode, isApprox: bool): bool = proc interestingCaseExpr*(m: PNode): bool = isLetLocation(m, true) -type - Operators* = object - opNot, opContains, opLe, opLt, opAnd, opOr, opIsNil, opEq: PSym - opAdd, opSub, opMul, opDiv, opLen: PSym - -proc initOperators*(g: ModuleGraph): Operators = - 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 swapArgs(fact: PNode, newOp: PSym): PNode = result = newNodeI(nkCall, fact.info, 3) - result.sons[0] = newSymNode(newOp) - result.sons[1] = fact.sons[2] - result.sons[2] = fact.sons[1] + result[0] = newSymNode(newOp) + result[1] = fact[2] + result[2] = fact[1] proc neg(n: PNode; o: Operators): PNode = if n == nil: return nil case n.getMagic of mNot: - result = n.sons[1] + result = n[1] of someLt: # not (a < b) == a >= b == b <= a result = swapArgs(n, o.opLe) of someLe: result = swapArgs(n, o.opLt) of mInSet: - if n.sons[1].kind != nkCurly: return nil - let t = n.sons[2].typ.skipTypes(abstractInst) + if n[1].kind != nkCurly: return nil + let t = n[2].typ.skipTypes(abstractInst) result = newNodeI(nkCall, n.info, 3) - result.sons[0] = n.sons[0] - result.sons[2] = n.sons[2] + result[0] = n[0] + result[2] = n[2] if t.kind == tyEnum: - var s = newNodeIT(nkCurly, n.info, n.sons[1].typ) + var s = newNodeIT(nkCurly, n.info, n[1].typ) for e in t.n: let eAsNode = newIntNode(nkIntLit, e.sym.position) - if not inSet(n.sons[1], eAsNode): s.add eAsNode - result.sons[1] = s + if not inSet(n[1], eAsNode): s.add eAsNode + result[1] = s #elif t.kind notin {tyString, tySequence} and lengthOrd(t) < 1000: - # result.sons[1] = complement(n.sons[1]) + # result[1] = complement(n[1]) else: # not ({2, 3, 4}.contains(x)) x != 2 and x != 3 and x != 4 # XXX todo @@ -140,33 +129,35 @@ proc neg(n: PNode; o: Operators): PNode = of mOr: # not (a or b) --> not a and not b let - a = n.sons[1].neg(o) - b = n.sons[2].neg(o) + a = n[1].neg(o) + b = n[2].neg(o) if a != nil and b != nil: result = newNodeI(nkCall, n.info, 3) - result.sons[0] = newSymNode(o.opAnd) - result.sons[1] = a - result.sons[2] = b + result[0] = newSymNode(o.opAnd) + result[1] = a + result[2] = b elif a != nil: result = a elif b != nil: result = b + else: + result = nil else: # leave not (a == 4) as it is result = newNodeI(nkCall, n.info, 2) - result.sons[0] = newSymNode(o.opNot) - result.sons[1] = n + result[0] = newSymNode(o.opNot) + result[1] = n -proc buildCall(op: PSym; a: PNode): PNode = +proc buildCall*(op: PSym; a: PNode): PNode = result = newNodeI(nkCall, a.info, 2) - result.sons[0] = newSymNode(op) - result.sons[1] = a + result[0] = newSymNode(op) + result[1] = a -proc buildCall(op: PSym; a, b: PNode): PNode = +proc buildCall*(op: PSym; a, b: PNode): PNode = result = newNodeI(nkInfix, a.info, 3) - result.sons[0] = newSymNode(op) - result.sons[1] = a - result.sons[2] = b + result[0] = newSymNode(op) + result[1] = a + result[2] = b proc `|+|`(a, b: PNode): PNode = result = copyNode(a) @@ -218,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 @@ -250,35 +241,35 @@ proc pred(n: PNode): PNode = else: result = n +proc buildLe*(o: Operators; a, b: PNode): PNode = + result = o.opLe.buildCall(a, b) + proc canon*(n: PNode; o: Operators): PNode = - # XXX for now only the new code in 'semparallel' uses this if n.safeLen >= 1: result = shallowCopy(n) - for i in 0 ..< n.len: - result.sons[i] = canon(n.sons[i], o) + for i in 0..<n.len: + result[i] = canon(n[i], o) elif n.kind == nkSym and n.sym.kind == skLet and - n.sym.ast.getMagic in (someEq + someAdd + someMul + someMin + - someMax + someHigh + {mUnaryLt} + someSub + someLen + someDiv): - result = n.sym.ast.copyTree + n.sym.astdef.getMagic in (someEq + someAdd + someMul + someMin + + someMax + someHigh + someSub + someLen + someDiv): + result = n.sym.astdef.copyTree else: result = n case result.getMagic of someEq, someAdd, someMul, someMin, someMax: # these are symmetric; put value as last: - if result.sons[1].isValue and not result.sons[2].isValue: - result = swapArgs(result, result.sons[0].sym) + if result[1].isValue and not result[2].isValue: + result = swapArgs(result, result[0].sym) # (4 + foo) + 2 --> (foo + 4) + 2 of someHigh: # high == len+(-1) result = o.opAdd.buildCall(o.opLen.buildCall(result[1]), minusOne()) - of mUnaryLt: - result = buildCall(o.opAdd, result[1], minusOne()) of someSub: # x - 4 --> x + (-4) result = negate(result[1], result[2], result, o) of someLen: - result.sons[0] = o.opLen.newSymNode - of someLt: + result[0] = o.opLen.newSymNode + of someLt - {mLtF64}: # x < y same as x <= y-1: let y = n[2].canon(o) let p = pred(y) @@ -318,16 +309,16 @@ proc canon*(n: PNode; o: Operators): PNode = if plus != nil and not isLetLocation(x, true): result = buildCall(result[0].sym, plus, y[1]) else: discard - elif x.isValue and y.getMagic in someAdd and y[2].isValue: + elif x.isValue and y.getMagic in someAdd and y[2].kind == x.kind: # 0 <= a.len + 3 # -3 <= a.len - result.sons[1] = x |-| y[2] - result.sons[2] = y[1] - elif x.isValue and y.getMagic in someSub and y[2].isValue: + result[1] = x |-| y[2] + result[2] = y[1] + elif x.isValue and y.getMagic in someSub and y[2].kind == x.kind: # 0 <= a.len - 3 # 3 <= a.len - result.sons[1] = x |+| y[2] - result.sons[2] = y[1] + result[1] = x |+| y[2] + result[2] = y[1] else: discard proc buildAdd*(a: PNode; b: BiggestInt; o: Operators): PNode = @@ -336,43 +327,57 @@ proc buildAdd*(a: PNode; b: BiggestInt; o: Operators): PNode = proc usefulFact(n: PNode; o: Operators): PNode = case n.getMagic of someEq: - if skipConv(n.sons[2]).kind == nkNilLit and ( - isLetLocation(n.sons[1], false) or isVar(n.sons[1])): - result = o.opIsNil.buildCall(n.sons[1]) + if skipConv(n[2]).kind == nkNilLit and ( + isLetLocation(n[1], false) or isVar(n[1])): + result = o.opIsNil.buildCall(n[1]) else: - if isLetLocation(n.sons[1], true) or isLetLocation(n.sons[2], true): + if isLetLocation(n[1], true) or isLetLocation(n[2], true): # XXX algebraic simplifications! 'i-1 < a.len' --> 'i < a.len+1' 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.sons[1], true) or isLetLocation(n.sons[2], true): + if isLetLocation(n[1], true) or isLetLocation(n[2], true): # XXX algebraic simplifications! 'i-1 < a.len' --> 'i < a.len+1' result = n 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.sons[1], false) or isVar(n.sons[1]): + if isLetLocation(n[1], false) or isVar(n[1]): result = n + else: + result = nil of someIn: - if isLetLocation(n.sons[1], true): + if isLetLocation(n[1], true): result = n + else: + result = nil of mAnd: let - a = usefulFact(n.sons[1], o) - b = usefulFact(n.sons[2], o) + a = usefulFact(n[1], o) + b = usefulFact(n[2], o) if a != nil and b != nil: result = newNodeI(nkCall, n.info, 3) - result.sons[0] = newSymNode(o.opAnd) - result.sons[1] = a - result.sons[2] = b + result[0] = newSymNode(o.opAnd) + result[1] = a + result[2] = b elif a != nil: result = a elif b != nil: result = b + else: + result = nil of mNot: - let a = usefulFact(n.sons[1], o) + 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... @@ -381,36 +386,52 @@ proc usefulFact(n: PNode; o: Operators): PNode = # (x == 3) or (y == 2) ---> not ( not (x==3) and not (y == 2)) # not (x != 3 and y != 2) let - a = usefulFact(n.sons[1], o).neg(o) - b = usefulFact(n.sons[2], o).neg(o) + a = usefulFact(n[1], o).neg(o) + b = usefulFact(n[2], o).neg(o) if a != nil and b != nil: result = newNodeI(nkCall, n.info, 3) - result.sons[0] = newSymNode(o.opAnd) - result.sons[1] = a - result.sons[2] = b + result[0] = newSymNode(o.opAnd) + 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 # if a: # ... # We make can easily replace 'a' by '2 < x' here: - if n.sym.ast != nil: - result = usefulFact(n.sym.ast, o) + 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 s*: seq[PNode] # the "knowledge base" - o*: Operators + g*: ModuleGraph + beSmart*: bool proc addFact*(m: var TModel, nn: PNode) = - let n = usefulFact(nn, m.o) - if n != nil: m.s.add n + let n = usefulFact(nn, m.g.operators) + if n != nil: + if not m.beSmart: + m.s.add n + else: + let c = canon(n, m.g.operators) + if c.getMagic == mAnd: + addFact(m, c[1]) + addFact(m, c[2]) + else: + m.s.add c proc addFactNeg*(m: var TModel, n: PNode) = - let n = n.neg(m.o) + let n = n.neg(m.g.operators) if n != nil: addFact(m, n) proc sameOpr(a, b: PSym): bool = @@ -436,24 +457,31 @@ proc sameTree*(a, b: PNode): bool = if not result and a.sym.magic != mNone: result = a.sym.magic == b.sym.magic or sameOpr(a.sym, b.sym) of nkIdent: result = a.ident.id == b.ident.id - of nkCharLit..nkInt64Lit: result = a.intVal == b.intVal + of nkCharLit..nkUInt64Lit: result = a.intVal == b.intVal of nkFloatLit..nkFloat64Lit: result = a.floatVal == b.floatVal of nkStrLit..nkTripleStrLit: result = a.strVal == b.strVal of nkType: result = a.typ == b.typ of nkEmpty, nkNilLit: result = true else: - if sonsLen(a) == sonsLen(b): - for i in countup(0, sonsLen(a) - 1): - if not sameTree(a.sons[i], b.sons[i]): return + if a.len == b.len: + for i in 0..<a.len: + if not sameTree(a[i], b[i]): return result = true proc hasSubTree(n, x: PNode): bool = if n.sameTree(x): result = true else: - for i in 0..safeLen(n)-1: - if hasSubTree(n.sons[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*(m: var TModel, n: PNode) = +proc invalidateFacts*(s: var seq[PNode], n: PNode) = # We are able to guard local vars (as opposed to 'let' variables)! # 'while p != nil: f(p); p = p.next' # This is actually quite easy to do: @@ -471,32 +499,47 @@ proc invalidateFacts*(m: var TModel, n: PNode) = # The same mechanism could be used for more complex data stored on the heap; # procs that 'write: []' cannot invalidate 'n.kind' for instance. In fact, we # could CSE these expressions then and help C's optimizer. - for i in 0..high(m.s): - if m.s[i] != nil and m.s[i].hasSubTree(n): m.s[i] = nil + for i in 0..high(s): + if s[i] != nil and s[i].hasSubTree(n): s[i] = nil + +proc invalidateFacts*(m: var TModel, n: PNode) = + invalidateFacts(m.s, n) 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.sons[1]): (1, 2) else: (2, 1) + let (loc, val) = if isLocation(eq[1]): (1, 2) else: (2, 1) - case fact.sons[0].sym.magic + case fact[0].sym.magic of someEq: - if sameTree(fact.sons[1], eq.sons[loc]): + if sameTree(fact[1], eq[loc]): # this is not correct; consider: a == b; a == 1 --> unknown! - if sameTree(fact.sons[2], eq.sons[val]): result = impYes - elif valuesUnequal(fact.sons[2], eq.sons[val]): result = impNo - elif sameTree(fact.sons[2], eq.sons[loc]): - if sameTree(fact.sons[1], eq.sons[val]): result = impYes - elif valuesUnequal(fact.sons[1], eq.sons[val]): result = impNo + 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.sons[2], eq.sons[loc]) and isValue(eq.sons[val]): - if inSet(fact.sons[1], eq.sons[val]): result = impYes + 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}: @@ -506,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}: @@ -522,44 +571,60 @@ proc geImpliesIn(x, c, aSet: PNode): TImplication = var value = newIntNode(c.kind, c.intVal) let max = lastOrd(nil, x.typ) # don't iterate too often: - if max - value.intVal < 1000: - var i, pos, neg: int + if max - getInt(value) < toInt128(1000): + 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.sons[0].sym.magic + case fact[0].sym.magic of someEq: - if sameTree(fact.sons[1], loc): - if inSet(aSet, fact.sons[2]): result = impYes + if sameTree(fact[1], loc): + if inSet(aSet, fact[2]): result = impYes else: result = impNo - elif sameTree(fact.sons[2], loc): - if inSet(aSet, fact.sons[1]): result = impYes + elif sameTree(fact[2], loc): + if inSet(aSet, fact[1]): result = impYes else: result = impNo + else: + result = impUnknown of mInSet: - if sameTree(fact.sons[2], loc): - result = compareSets(fact.sons[1], aSet) + if sameTree(fact[2], loc): + result = compareSets(fact[1], aSet) + else: + result = impUnknown of someLe: - if sameTree(fact.sons[1], loc): - result = leImpliesIn(fact.sons[1], fact.sons[2], aSet) - elif sameTree(fact.sons[2], loc): - result = geImpliesIn(fact.sons[2], fact.sons[1], aSet) + 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.sons[1], loc): - result = leImpliesIn(fact.sons[1], fact.sons[2].pred, aSet) - elif sameTree(fact.sons[2], loc): + 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.sons[2], fact.sons[1].pred, aSet) - of mNot, mOr, mAnd: assert(false, "impliesIn") - else: discard + result = geImpliesIn(fact[2], fact[1].pred, aSet) + 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 @@ -567,93 +632,151 @@ proc valueIsNil(n: PNode): TImplication = else: impUnknown proc impliesIsNil(fact, eq: PNode): TImplication = - case fact.sons[0].sym.magic + case fact[0].sym.magic of mIsNil: - if sameTree(fact.sons[1], eq.sons[1]): + if sameTree(fact[1], eq[1]): result = impYes + else: + result = impUnknown of someEq: - if sameTree(fact.sons[1], eq.sons[1]): - result = valueIsNil(fact.sons[2].skipConv) - elif sameTree(fact.sons[2], eq.sons[1]): - result = valueIsNil(fact.sons[1].skipConv) - of mNot, mOr, mAnd: assert(false, "impliesIsNil") - else: discard + if sameTree(fact[1], eq[1]): + result = valueIsNil(fact[2].skipConv) + elif sameTree(fact[2], eq[1]): + result = valueIsNil(fact[1].skipConv) + 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) - case fact.sons[0].sym.magic + case fact[0].sym.magic of someEq: - if sameTree(fact.sons[1], x): - if isValue(fact.sons[2]) and isValue(c): + if sameTree(fact[1], x): + if isValue(fact[2]) and isValue(c): # fact: x = 4; question x >= 56? --> true iff 4 >= 56 - if leValue(c, fact.sons[2]): result = impYes + if leValue(c, fact[2]): result = impYes else: result = impNo - elif sameTree(fact.sons[2], x): - if isValue(fact.sons[1]) and isValue(c): - if leValue(c, fact.sons[1]): result = impYes + 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.sons[1], x): - if isValue(fact.sons[2]) and isValue(c): + 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.sons[2], c): result = impNo + if leValue(fact[2], c): result = impNo + else: result = impUnknown # fact: x < 4; question 2 <= x? --> we don't know - elif sameTree(fact.sons[2], x): + else: + result = impUnknown + elif sameTree(fact[2], x): # fact: 3 < x; question: N-1 < x ? --> true iff N-1 <= 3 - if isValue(fact.sons[1]) and isValue(c): - if leValue(c.pred, fact.sons[1]): result = impYes + 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.sons[1], x): - if isValue(fact.sons[2]) and isValue(c): + 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.sons[2], c): result = impNo + if leValue(fact[2], c): result = impNo # fact: x <= 4; question x >= 2? --> we don't know - elif sameTree(fact.sons[2], x): + else: + result = impUnknown + else: + result = impUnknown + elif sameTree(fact[2], x): # fact: 3 <= x; question: x >= 2 ? --> true iff 2 <= 3 - if isValue(fact.sons[1]) and isValue(c): - if leValue(c, fact.sons[1]): result = impYes - of mNot, mOr, mAnd: assert(false, "impliesGe") - else: discard + if isValue(fact[1]) and isValue(c): + if leValue(c, fact[1]): result = impYes + 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): + if c.isValue: + if leValue(x, x): return impYes + else: return impNo return impliesGe(fact, c, x) - case fact.sons[0].sym.magic + case fact[0].sym.magic of someEq: - if sameTree(fact.sons[1], x): - if isValue(fact.sons[2]) and isValue(c): + 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.sons[2], c): result = impYes + if leValue(fact[2], c): result = impYes else: result = impNo - elif sameTree(fact.sons[2], x): - if isValue(fact.sons[1]) and isValue(c): - if leValue(fact.sons[1], c): result = impYes + 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.sons[1], x): - if isValue(fact.sons[2]) and isValue(c): + 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.sons[2], c.pred): result = impYes + if leValue(fact[2], c.pred): result = impYes + else: + result = impUnknown # fact: x < 4; question x <= 2? --> we don't know - elif sameTree(fact.sons[2], x): + else: + result = impUnknown + elif sameTree(fact[2], x): # fact: 3 < x; question: x <= 1 ? --> false iff 1 <= 3 - if isValue(fact.sons[1]) and isValue(c): - if leValue(c, fact.sons[1]): result = impNo - + 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.sons[1], x): - if isValue(fact.sons[2]) and isValue(c): + 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.sons[2], c): result = impYes + 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.sons[2], x): + elif sameTree(fact[2], x): # fact: 3 <= x; question: x <= 2 ? --> false iff 2 < 3 - if isValue(fact.sons[1]) and isValue(c): - if leValue(c, fact.sons[1].pred): result = impNo + 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: @@ -665,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 @@ -686,36 +811,37 @@ proc factImplies(fact, prop: PNode): TImplication = # (not a) -> b compute as not (a -> b) ??? # == not a or not b == not (a and b) - let arg = fact.sons[1] + let arg = fact[1] case arg.getMagic of mIsNil, mEqRef: return ~factImplies(arg, prop) of mAnd: # not (a and b) means not a or not b: # a or b --> both need to imply 'prop' - let a = factImplies(arg.sons[1], prop) - let b = factImplies(arg.sons[2], prop) + let a = factImplies(arg[1], prop) + let b = factImplies(arg[2], prop) if a == b: return ~a return impUnknown else: return impUnknown of mAnd: - result = factImplies(fact.sons[1], prop) + result = factImplies(fact[1], prop) if result != impUnknown: return result - return factImplies(fact.sons[2], prop) + return factImplies(fact[2], prop) else: discard - case prop.sons[0].sym.magic - of mNot: result = ~fact.factImplies(prop.sons[1]) + case prop[0].sym.magic + of mNot: result = ~fact.factImplies(prop[1]) of mIsNil: result = impliesIsNil(fact, prop) of someEq: result = impliesEq(fact, prop) - of someLe: result = impliesLe(fact, prop.sons[1], prop.sons[2]) - of someLt: result = impliesLt(fact, prop.sons[1], prop.sons[2]) - of mInSet: result = impliesIn(fact, prop.sons[2], prop.sons[1]) + of someLe: result = impliesLe(fact, prop[1], prop[2]) + of someLt: result = impliesLt(fact, prop[1], prop[2]) + of mInSet: result = impliesIn(fact, prop[2], prop[1]) else: result = impUnknown 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: @@ -723,7 +849,7 @@ proc doesImply*(facts: TModel, prop: PNode): TImplication = if result != impUnknown: return proc impliesNotNil*(m: TModel, arg: PNode): TImplication = - result = doesImply(m, m.o.opIsNil.buildCall(arg).neg(m.o)) + result = doesImply(m, m.g.operators.opIsNil.buildCall(arg).neg(m.g.operators)) proc simpleSlice*(a, b: PNode): BiggestInt = # returns 'c' if a..b matches (i+c)..(i+c), -1 otherwise. (i)..(i) is matched @@ -744,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) = @@ -777,12 +903,7 @@ macro `=~`(x: PNode, pat: untyped): bool = var conds = newTree(nnkBracket) m(x, pat, conds) - when compiles(nestList(ident"and", conds)): - result = nestList(ident"and", conds) - #elif declared(macros.toNimIdent): - # result = nestList(toNimIdent"and", conds) - else: - result = nestList(!"and", conds) + result = nestList(ident"and", conds) proc isMinusOne(n: PNode): bool = n.kind in {nkCharLit..nkUInt64Lit} and n.intVal == -1 @@ -802,7 +923,7 @@ proc ple(m: TModel; a, b: PNode): TImplication = if lastOrd(nil, a.typ) <= b.intVal: return impYes # 3 <= x iff low(x) <= 3 if a.isValue and b.typ != nil and b.typ.isOrdinalType: - if firstOrd(nil, b.typ) <= a.intVal: return impYes + if a.intVal <= firstOrd(nil, b.typ): return impYes # x <= x if sameTree(a, b): return impYes @@ -813,7 +934,11 @@ proc ple(m: TModel; a, b: PNode): TImplication = # x <= y+c if 0 <= c and x <= y # x <= y+(-c) if c <= 0 and y >= x - if b.getMagic in someAdd and zero() <=? b[2] and a <=? b[1]: return impYes + if b.getMagic in someAdd: + if zero() <=? b[2] and a <=? b[1]: return impYes + # x <= y-c if x+c <= y + if b[2] <=? zero() and (canon(m.g.operators.opSub.buildCall(a, b[2]), m.g.operators) <=? b[1]): + return impYes # x+c <= y if c <= 0 and x <= y if a.getMagic in someAdd and a[2] <=? zero() and a[1] <=? b: return impYes @@ -826,20 +951,20 @@ proc ple(m: TModel; a, b: PNode): TImplication = if a.getMagic in someMul and a[2].isValue and a[1].getMagic in someDiv and a[1][2].isValue: # simplify (x div 4) * 2 <= y to x div (c div d) <= y - if ple(m, buildCall(m.o.opDiv, a[1][1], `|div|`(a[1][2], a[2])), b) == impYes: + if ple(m, buildCall(m.g.operators.opDiv, a[1][1], `|div|`(a[1][2], a[2])), b) == impYes: return impYes # x*3 + x == x*4. It follows that: # x*3 + y <= x*4 if y <= x and 3 <= 4 if a =~ x*dc + y and b =~ x2*ec: if sameTree(x, x2): - let ec1 = m.o.opAdd.buildCall(ec, minusOne()) + let ec1 = m.g.operators.opAdd.buildCall(ec, minusOne()) if x >=? 1 and ec >=? 1 and dc >=? 1 and dc <=? ec1 and y <=? x: return impYes elif a =~ x*dc and b =~ x2*ec + y: #echo "BUG cam ehrer e ", a, " <=? ", b if sameTree(x, x2): - let ec1 = m.o.opAdd.buildCall(ec, minusOne()) + let ec1 = m.g.operators.opAdd.buildCall(ec, minusOne()) if x >=? 1 and ec >=? 1 and dc >=? 1 and dc <=? ec1 and y <=? zero(): return impYes @@ -881,8 +1006,8 @@ proc replaceSubTree(n, x, by: PNode): PNode = result = by elif hasSubTree(n, x): result = shallowCopy(n) - for i in 0 .. safeLen(n)-1: - result.sons[i] = replaceSubTree(n.sons[i], x, by) + for i in 0..n.safeLen-1: + result[i] = replaceSubTree(n[i], x, by) else: result = n @@ -892,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: @@ -902,10 +1028,13 @@ proc pleViaModelRec(m: var TModel; a, b: PNode): TImplication = # --> true if (len-100) <= (len-1) let x = fact[1] let y = fact[2] - if sameTree(x, a) and y.getMagic in someAdd and b.getMagic in someAdd and - sameTree(y[1], b[1]): - if ple(m, b[2], y[2]) == impYes: - return impYes + # x <= y. + # Question: x <= b? True iff y <= b. + if sameTree(x, a): + if ple(m, y, b) == impYes: return impYes + if y.getMagic in someAdd and b.getMagic in someAdd and sameTree(y[1], b[1]): + if ple(m, b[2], y[2]) == impYes: + return impYes # x <= y implies a <= b if a <= x and y <= b if ple(m, a, x) == impYes: @@ -934,17 +1063,17 @@ 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: m.s = @[] - m.o = model.o + m.g = model.g # make the other facts consistent: for fact in model.s: if fact != nil and fact.getMagic notin someEq: # XXX 'canon' should not be necessary here, but it is - m.s.add applyReplacements(fact, replacements).canon(m.o) + m.s.add applyReplacements(fact, replacements).canon(m.g.operators) a = applyReplacements(aa, replacements) b = applyReplacements(bb, replacements) else: @@ -953,54 +1082,60 @@ proc pleViaModel(model: TModel; aa, bb: PNode): TImplication = result = pleViaModelRec(m, a, b) proc proveLe*(m: TModel; a, b: PNode): TImplication = - let x = canon(m.o.opLe.buildCall(a, b), m.o) + let x = canon(m.g.operators.opLe.buildCall(a, b), m.g.operators) #echo "ROOT ", renderTree(x[1]), " <=? ", renderTree(x[2]) result = ple(m, x[1], x[2]) if result == impUnknown: # try an alternative: a <= b iff not (b < a) iff not (b+1 <= a): - let y = canon(m.o.opLe.buildCall(m.o.opAdd.buildCall(b, one()), a), m.o) + let y = canon(m.g.operators.opLe.buildCall(m.g.operators.opAdd.buildCall(b, one()), a), m.g.operators) result = ~ple(m, y[1], y[2]) proc addFactLe*(m: var TModel; a, b: PNode) = - m.s.add canon(m.o.opLe.buildCall(a, b), m.o) + m.s.add canon(m.g.operators.opLe.buildCall(a, b), m.g.operators) + +proc addFactLt*(m: var TModel; a, b: PNode) = + let bb = m.g.operators.opAdd.buildCall(b, minusOne()) + addFactLe(m, a, bb) proc settype(n: PNode): PType = - result = newType(tySet, n.typ.owner) - addSonSkipIntLit(result, n.typ) + 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 = var s = newNodeI(nkCurly, it.info, it.len-1) s.typ = settype(loc) - for i in 0..it.len-2: s.sons[i] = it.sons[i] + for i in 0..<it.len-1: s[i] = it[i] result = newNodeI(nkCall, it.info, 3) - result.sons[0] = newSymNode(o.opContains) - result.sons[1] = s - result.sons[2] = loc + result[0] = newSymNode(o.opContains) + result[1] = s + result[2] = loc proc buildElse(n: PNode; o: Operators): PNode = - var s = newNodeIT(nkCurly, n.info, settype(n.sons[0])) - for i in 1..n.len-2: - let branch = n.sons[i] - assert branch.kind == nkOfBranch - for j in 0..branch.len-2: - s.add(branch.sons[j]) + var s = newNodeIT(nkCurly, n.info, settype(n[0])) + for i in 1..<n.len-1: + let branch = n[i] + assert branch.kind != nkElse + if branch.kind == nkOfBranch: + for j in 0..<branch.len-1: + s.add(branch[j]) result = newNodeI(nkCall, n.info, 3) - result.sons[0] = newSymNode(o.opContains) - result.sons[1] = s - result.sons[2] = n.sons[0] + result[0] = newSymNode(o.opContains) + result[1] = s + result[2] = n[0] proc addDiscriminantFact*(m: var TModel, n: PNode) = var fact = newNodeI(nkCall, n.info, 3) - fact.sons[0] = newSymNode(m.o.opEq) - fact.sons[1] = n.sons[0] - fact.sons[2] = n.sons[1] + fact[0] = newSymNode(m.g.operators.opEq) + fact[1] = n[0] + fact[2] = n[1] m.s.add fact proc addAsgnFact*(m: var TModel, key, value: PNode) = var fact = newNodeI(nkCall, key.info, 3) - fact.sons[0] = newSymNode(m.o.opEq) - fact.sons[1] = key - fact.sons[2] = value + fact[0] = newSymNode(m.g.operators.opEq) + fact[1] = key + fact[2] = value m.s.add fact proc sameSubexprs*(m: TModel; a, b: PNode): bool = @@ -1014,34 +1149,38 @@ proc sameSubexprs*(m: TModel; a, b: PNode): bool = # However, nil checking requires exactly the same mechanism! But for now # we simply use sameTree and live with the unsoundness of the analysis. var check = newNodeI(nkCall, a.info, 3) - check.sons[0] = newSymNode(m.o.opEq) - check.sons[1] = a - check.sons[2] = b + check[0] = newSymNode(m.g.operators.opEq) + check[1] = a + check[2] = b result = m.doesImply(check) == impYes proc addCaseBranchFacts*(m: var TModel, n: PNode, i: int) = - let branch = n.sons[i] + let branch = n[i] if branch.kind == nkOfBranch: - m.s.add buildOf(branch, n.sons[0], m.o) + m.s.add buildOf(branch, n[0], m.g.operators) else: - m.s.add n.buildElse(m.o).neg(m.o) + m.s.add n.buildElse(m.g.operators).neg(m.g.operators) proc buildProperFieldCheck(access, check: PNode; o: Operators): PNode = - if check.sons[1].kind == nkCurly: + if check[1].kind == nkCurly: result = copyTree(check) if access.kind == nkDotExpr: var a = copyTree(access) - a.sons[1] = check.sons[2] - result.sons[2] = a + a[1] = check[2] + result[2] = a # 'access.kind != nkDotExpr' can happen for object constructors # which we don't check yet else: # it is some 'not' assert check.getMagic == mNot - result = buildProperFieldCheck(access, check.sons[1], o).neg(o) + result = buildProperFieldCheck(access, check[1], o).neg(o) -proc checkFieldAccess*(m: TModel, n: PNode; conf: ConfigRef) = - for i in 1..n.len-1: - let check = buildProperFieldCheck(n.sons[0], n.sons[i], m.o) +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.sons[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 bbbcb4e56..9fdec38c0 100644 --- a/compiler/hlo.nim +++ b/compiler/hlo.nim @@ -8,18 +8,21 @@ # # This include implements the high level optimization pass. +# included from sem.nim proc hlo(c: PContext, n: PNode): PNode proc evalPattern(c: PContext, n, orig: PNode): PNode = - internalAssert c.config, n.kind == nkCall and n.sons[0].kind == nkSym + internalAssert c.config, n.kind == nkCall and n[0].kind == nkSym # we need to ensure that the resulting AST is semchecked. However, it's - # aweful to semcheck before macro invocation, so we don't and treat + # awful to semcheck before macro invocation, so we don't and treat # templates and macros as immediate in this context. - var rule: string - if optHints in c.config.options and hintPattern in c.config.notes: - rule = renderTree(n, {renderNoComments}) - let s = n.sons[0].sym + var rule: string = + if c.config.hasHint(hintPattern): + renderTree(n, {renderNoComments}) + else: + "" + let s = n[0].sym case s.kind of skMacro: result = semMacroExpr(c, n, orig, s) @@ -27,7 +30,7 @@ proc evalPattern(c: PContext, n, orig: PNode): PNode = result = semTemplateExpr(c, n, s, {efFromHlo}) else: result = semDirectOp(c, n, {}) - if optHints in c.config.options and hintPattern in c.config.notes: + if c.config.hasHint(hintPattern): message(c.config, orig.info, hintPattern, rule & " --> '" & renderTree(result, {renderNoComments}) & "'") @@ -50,7 +53,7 @@ proc applyPatterns(c: PContext, n: PNode): PNode = c.patterns[i] = nil if x.kind == nkStmtList: assert x.len == 3 - x.sons[1] = evalPattern(c, x.sons[1], result) + x[1] = evalPattern(c, x[1], result) result = flattenStmts(x) else: result = evalPattern(c, x, result) @@ -67,18 +70,18 @@ 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 - n.sons[0].kind == nkSym and - {sfGlobal, sfPure} * n.sons[0].sym.flags == {sfGlobal, sfPure}: + if n.kind in {nkFastAsgn, nkAsgn, nkSinkAsgn, nkIdentDefs, nkVarTuple} and + n[0].kind == nkSym and + {sfGlobal, sfPure} <= n[0].sym.flags: # do not optimize 'var g {.global} = re(...)' again! return n result = applyPatterns(c, n) if result == n: # no optimization applied, try subtrees: - for i in 0 ..< safeLen(result): - let a = result.sons[i] + for i in 0..<result.safeLen: + let a = result[i] let h = hlo(c, a) - if h != a: result.sons[i] = h + if h != a: result[i] = h else: # perform type checking, so that the replacement still fits: if isEmptyType(n.typ) and isEmptyType(result.typ): @@ -86,18 +89,18 @@ proc hlo(c: PContext, n: PNode): PNode = else: result = fitNode(c, n.typ, result, n.info) # optimization has been applied so check again: - result = commonOptimizations(c.graph, c.module, result) + result = commonOptimizations(c.graph, c.idgen, c.module, result) result = hlo(c, result) - result = commonOptimizations(c.graph, c.module, result) + result = commonOptimizations(c.graph, c.idgen, c.module, result) proc hloBody(c: PContext, n: PNode): PNode = # fast exit: - if c.patterns.len == 0 or optPatterns notin c.config.options: return n + if c.patterns.len == 0 or optTrMacros notin c.config.options: return n c.hloLoopDetector = 0 result = hlo(c, n) proc hloStmt(c: PContext, n: PNode): PNode = # fast exit: - if c.patterns.len == 0 or optPatterns notin c.config.options: return n + if c.patterns.len == 0 or optTrMacros notin c.config.options: return n c.hloLoopDetector = 0 result = hlo(c, n) diff --git a/compiler/ic/bitabs.nim b/compiler/ic/bitabs.nim new file mode 100644 index 000000000..0c9994c83 --- /dev/null +++ b/compiler/ic/bitabs.nim @@ -0,0 +1,178 @@ +## A BiTable is a table that can be seen as an optimized pair +## of `(Table[LitId, Val], Table[Val, LitId])`. + +import std/hashes +import rodfiles + +when defined(nimPreviewSlimSystem): + import std/assertions + +type + LitId* = distinct uint32 + + BiTable*[T] = object + 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 + +template maxHash(t): untyped = high(t.keys) +template isFilled(x: LitId): bool = x.uint32 > 0'u32 + +proc `$`*(x: LitId): string {.borrow.} +proc `<`*(x, y: LitId): bool {.borrow.} +proc `<=`*(x, y: LitId): bool {.borrow.} +proc `==`*(x, y: LitId): bool {.borrow.} +proc hash*(x: LitId): Hash {.borrow.} + + +proc len*[T](t: BiTable[T]): int = t.vals.len + +proc mustRehash(length, counter: int): bool {.inline.} = + assert(length > counter) + result = (length * 2 < counter * 3) or (length - counter < 4) + +const + 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) + swap(t.keys, n) + for i in 0..high(n): + let eh = n[i] + if isFilled(eh): + var j = hash(t.vals[idToIdx eh]) and maxHash(t) + while isFilled(t.keys[j]): + j = nextTry(j, maxHash(t)) + t.keys[j] = move n[i] + +proc getKeyId*[T](t: BiTable[T]; v: T): LitId = + let origH = hash(v) + var h = origH and maxHash(t) + if t.keys.len != 0: + while true: + let litId = t.keys[h] + if not isFilled(litId): break + if t.vals[idToIdx t.keys[h]] == v: return litId + h = nextTry(h, maxHash(t)) + return LitId(0) + +proc getOrIncl*[T](t: var BiTable[T]; v: T): LitId = + let origH = hash(v) + var h = origH and maxHash(t) + if t.keys.len != 0: + while true: + let litId = t.keys[h] + if not isFilled(litId): break + if t.vals[idToIdx t.keys[h]] == v: return litId + h = nextTry(h, maxHash(t)) + # not found, we need to insert it: + if mustRehash(t.keys.len, t.vals.len): + enlarge(t) + # recompute where to insert: + h = origH and maxHash(t) + while true: + let litId = t.keys[h] + if not isFilled(litId): break + h = nextTry(h, maxHash(t)) + else: + setLen(t.keys, 16) + h = origH and maxHash(t) + + result = LitId(t.vals.len + idStart) + t.keys[h] = result + t.vals.add v + + +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 + assert idx < t.vals.len + result = t.vals[idx] + +proc hash*[T](t: BiTable[T]): Hash = + ## as the keys are hashes of the values, we simply use them instead + var h: Hash = 0 + for i, n in pairs t.keys: + h = h !& hash((i, n)) + result = !$h + +proc store*[T](f: var RodFile; t: BiTable[T]) = + storeSeq(f, t.vals) + storeSeq(f, t.keys) + +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] + + echo getOrIncl(t, "hello") + + echo getOrIncl(t, "hello") + echo getOrIncl(t, "hello3") + echo getOrIncl(t, "hello4") + echo getOrIncl(t, "helloasfasdfdsa") + echo getOrIncl(t, "hello") + echo getKeyId(t, "hello") + echo getKeyId(t, "none") + + for i in 0 ..< 100_000: + discard t.getOrIncl($i & "___" & $i) + + for i in 0 ..< 100_000: + assert t.getOrIncl($i & "___" & $i).idToIdx == i + 4 + echo "begin" + echo t.vals.len + + echo t.vals[0] + echo t.vals[1004] + + echo "middle" + + var tf: BiTable[float] + + discard tf.getOrIncl(0.4) + discard tf.getOrIncl(16.4) + discard tf.getOrIncl(32.4) + echo getKeyId(tf, 32.4) + + var f2 = open("testblah.bin", fmWrite) + echo store(f2, tf) + f2.close + + var f1 = open("testblah.bin", fmRead) + + var t2: BiTable[float] + + echo f1.load(t2) + echo t2.vals.len + + echo getKeyId(t2, 32.4) + + echo "end" + + + f1.close diff --git a/compiler/ic/cbackend.nim b/compiler/ic/cbackend.nim new file mode 100644 index 000000000..83f1b4cc7 --- /dev/null +++ b/compiler/ic/cbackend.nim @@ -0,0 +1,180 @@ +# +# +# The Nim Compiler +# (c) Copyright 2021 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## New entry point into our C/C++ code generator. Ideally +## somebody would rewrite the old backend (which is 8000 lines of crufty Nim code) +## to work on packed trees directly and produce the C code as an AST which can +## then be rendered to text in a very simple manner. Unfortunately nobody wrote +## this code. So instead we wrap the existing cgen.nim and its friends so that +## we call directly into the existing code generation logic but avoiding the +## naive, outdated `passes` design. Thus you will see some +## `useAliveDataFromDce in flags` checks in the old code -- the old code is +## also doing cross-module dependency tracking and DCE that we don't need +## anymore. DCE is now done as prepass over the entire packed module graph. + +import std/[packedsets, algorithm, tables] + +when defined(nimPreviewSlimSystem): + import std/assertions + +import ".."/[ast, options, lineinfos, modulegraphs, cgendata, cgen, + pathutils, extccomp, msgs, modulepaths] + +import packed_ast, ic, dce, rodfiles + +proc unpackTree(g: ModuleGraph; thisModule: int; + tree: PackedTree; n: NodePos): PNode = + var decoder = initPackedDecoder(g.config, g.cache) + result = loadNodes(decoder, g.packed, thisModule, tree, n) + +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] + + for p in allNodes(m.fromDisk.topLevel): + let n = unpackTree(g, m.module.position, m.fromDisk.topLevel, p) + 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) = + let filename = AbsoluteFile toFullPath(config, m.position.FileIndex) + let ext = + if config.backend == backendCpp: ".nim.cpp" + elif config.backend == backendObjc: ".nim.m" + else: ".nim.c" + 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, + obj: objFile, + flags: {CfileFlag.Cached}) + addFileToCompile(config, cf) + +when defined(debugDce): + import os, std/packedsets + +proc storeAliveSymsImpl(asymFile: AbsoluteFile; s: seq[int32]) = + var f = rodfiles.create(asymFile.string) + f.storeHeader() + f.storeSection aliveSymsSection + f.storeSeq(s) + close f + +template prepare {.dirty.} = + let asymFile = toRodFile(config, AbsoluteFile toFullPath(config, position.FileIndex), ".alivesyms") + var s = newSeqOfCap[int32](alive[position].len) + for a in items(alive[position]): s.add int32(a) + sort(s) + +proc storeAliveSyms(config: ConfigRef; position: int; alive: AliveSyms) = + prepare() + storeAliveSymsImpl(asymFile, s) + +proc aliveSymsChanged(config: ConfigRef; position: int; alive: AliveSyms): bool = + prepare() + var f2 = rodfiles.open(asymFile.string) + f2.loadHeader() + f2.loadSection aliveSymsSection + var oldData: seq[int32] = @[] + f2.loadSeq(oldData) + f2.close + if f2.err == ok and oldData == s: + result = false + else: + when defined(debugDce): + 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), " 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) + + 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, stored: + assert false + of storing, outdated: + 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): + 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 new file mode 100644 index 000000000..6eb36431e --- /dev/null +++ b/compiler/ic/dce.nim @@ -0,0 +1,169 @@ +# +# +# The Nim Compiler +# (c) Copyright 2021 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Dead code elimination (=DCE) for IC. + +import std/[intsets, tables] + +when defined(nimPreviewSlimSystem): + import std/assertions + +import ".." / [ast, options, lineinfos, types] + +import packed_ast, ic, bitabs + +type + AliveSyms* = seq[IntSet] + AliveContext* = object ## Purpose is to fill the 'alive' field. + stack: seq[(int, TOptions, NodePos)] ## A stack for marking symbols as alive. + decoder: PackedDecoder ## We need a PackedDecoder for module ID address translations. + thisModule: int ## The module we're currently analysing for DCE. + alive: AliveSyms ## The final result of our computation. + options: TOptions + compilerProcs: Table[string, (int, int32)] + +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 = 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 + # is to eliminate unused procs. So there is no special logic required for this case. + if sfCompileTime notin flags: + 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.strings[symPtr.name]] = (c.thisModule, symId) + else: + result = false + +template isNotGeneric(n: NodePos): bool = ithSon(tree, n, genericParamsPos).kind == nkEmpty + +proc followLater(c: var AliveContext; g: PackedModuleGraph; module: int; item: int32) = + ## 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.syms[item].ast + if body != emptyNodeId: + 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.syms[item].name + if nid != LitId(0): + let name = g[module].fromDisk.strings[nid] + if name in ["nimFrame", "callDepthLimitReached"]: + echo "I was called! ", name, " body exists: ", body != emptyNodeId, " ", module, " ", item + +proc requestCompilerProc(c: var AliveContext; g: PackedModuleGraph; name: string) = + let (module, item) = c.compilerProcs[name] + 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.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.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) = + ## Replicates the logic of `ccgexprs.genRangeChck`. + ## XXX Refactor so that the duplicated logic is avoided. However, for now it's not clear + ## the approach has enough merit. + var dest = loadTypeKind(n.typ, c, g, abstractVar) + if optRangeCheck notin c.options or dest in {tyUInt..tyUInt64}: + discard "no need to generate a check because it was disabled" + else: + let n0t = loadTypeKind(n.firstSon.typ, c, g, {}) + if n0t in {tyUInt, tyUInt64}: + c.requestCompilerProc(g, "raiseRangeErrorNoArgs") + else: + let raiser = + case loadTypeKind(n.typ, c, g, abstractVarRange) + of tyUInt..tyUInt64, tyChar: "raiseRangeErrorU" + of tyFloat..tyFloat128: "raiseRangeErrorF" + else: "raiseRangeErrorI" + c.requestCompilerProc(g, raiser) + +proc aliveCode(c: var AliveContext; g: PackedModuleGraph; tree: PackedTree; n: NodePos) = + ## Marks the symbols we encounter when we traverse the AST at `tree[n]` as alive, unless + ## it is purely in a declarative context (type section etc.). + case n.kind + of nkNone..pred(nkSym), succ(nkSym)..nkNilLit: + discard "ignore non-sym atoms" + of nkSym: + # This symbol is alive and everything its body references. + followLater(c, g, c.thisModule, tree[n].soperand) + of nkModuleRef: + let (n1, n2) = sons2(tree, n) + assert n1.kind == nkNone + assert n2.kind == nkNone + let m = n1.litId + 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, + nkCommentStmt, nkIncludeStmt, + nkImportStmt, nkImportExceptStmt, nkExportStmt, nkExportExceptStmt, + nkFromStmt, nkStaticStmt: + discard + of nkVarSection, nkLetSection, nkConstSection: + # XXX ignore the defining local variable name? + for son in sonsReadonly(tree, n): + aliveCode(c, g, tree, son) + of nkChckRangeF, nkChckRange64, nkChckRange: + rangeCheckAnalysis(c, g, tree, n) + of nkProcDef, nkConverterDef, nkMethodDef, nkFuncDef, nkIteratorDef: + if n.firstSon.kind == nkSym and isNotGeneric(n): + 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) + else: + for son in sonsReadonly(tree, n): + aliveCode(c, g, tree, son) + +proc followNow(c: var AliveContext; g: PackedModuleGraph) = + ## Mark all entries in the stack. Marking can add more entries + ## to the stack but eventually we have looked at every alive symbol. + while c.stack.len > 0: + let (modId, opt, ast) = c.stack.pop() + c.thisModule = modId + c.options = opt + aliveCode(c, g, g[modId].fromDisk.bodies, ast) + +proc computeAliveSyms*(g: PackedModuleGraph; conf: ConfigRef): AliveSyms = + ## Entry point for our DCE algorithm. + var c = AliveContext(stack: @[], decoder: PackedDecoder(config: conf), + thisModule: -1, alive: newSeq[IntSet](g.len), + options: conf.options) + for i in countdown(len(g)-1, 0): + if g[i].status != undefined: + c.thisModule = i + for p in allNodes(g[i].fromDisk.topLevel): + aliveCode(c, g, g[i].fromDisk.topLevel, p) + + followNow(c, g) + result = move(c.alive) + +proc isAlive*(a: AliveSyms; module: int, item: int32): bool = + ## Backends use this to query if a symbol is `alive` which means + ## we need to produce (C/C++/etc) code for it. + result = a[module].contains(item) + diff --git a/compiler/ic/design.rst b/compiler/ic/design.rst new file mode 100644 index 000000000..b096e3103 --- /dev/null +++ b/compiler/ic/design.rst @@ -0,0 +1,56 @@ +==================================== + Incremental Recompilations +==================================== + +We split the Nim compiler into a frontend and a backend. +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. 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 + `.nim` file, there can be no inconsistency. There can also be no + partial updates. +- No dependency to external packages (SQLite). SQLite simply is too + slow and the old way of serialization was too slow too. We use a + format designed for Nim and expect to base further tools on this + file format. + +References to external modules must be (moduleId, symId) pairs. +The symbol IDs are module specific. This way no global ID increment +mechanism needs to be implemented that we could get wrong. ModuleIds +are rod-file specific too. + + + +Global state +------------ + +There is no global state. + +Rod File Format +--------------- + +It's a simple binary file format. `rodfiles.nim` contains some details. + + +Backend +------- + +Nim programmers have to come to enjoy whole-program dead code elimination, +by default. Since this is a "whole program" optimization, it does break +modularity. However, thanks to the packed AST representation we can perform +this global analysis without having to unpack anything. This is basically +a mark&sweep GC algorithm: + +- Start with the top level statements. Every symbol that is referenced + from a top level statement is not "dead" and needs to be compiled by + the backend. +- Every symbol referenced from a referenced symbol also has to be + compiled. + +Caching logic: Only if the set of alive symbols is different from the +last run, the module has to be regenerated. diff --git a/compiler/ic/ic.nim b/compiler/ic/ic.nim new file mode 100644 index 000000000..8e81633ef --- /dev/null +++ b/compiler/ic/ic.nim @@ -0,0 +1,1343 @@ +# +# +# The Nim Compiler +# (c) Copyright 2020 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +import std/[hashes, tables, intsets, monotimes] +import packed_ast, bitabs, rodfiles +import ".." / [ast, idents, lineinfos, msgs, ropes, options, + pathutils, condsyms, packages, modulepaths] +#import ".." / [renderer, astalgo] +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 + backend: TBackend + selectedGC: TGCMode + cCompiler: TSystemCC + options: TOptions + globalOptions: TGlobalOptions + + ModuleBackendFlag* = enum + HasDatInitProc + HasModuleInitProc + + PackedModule* = object ## the parts of a PackedEncoder that are part of the .rod file + definedSymbols: string + moduleFlags: TSymFlags + includes*: seq[(LitId, string)] # first entry is the module filename itself + imports: seq[LitId] # the modules this module depends on + toReplay*: PackedTree # pragmas and VM specific state to replay. + topLevel*: PackedTree # top level statements + bodies*: PackedTree # other trees. Referenced from typ.n and sym.ast by their position. + #producedGenerics*: Table[GenericKey, SymId] + exports*: seq[(LitId, int32)] + hidden: seq[(LitId, int32)] + reexports: seq[(LitId, PackedItemId)] + compilerProcs*: seq[(LitId, int32)] + converters*, methods*, trmacros*, pureEnums*: seq[int32] + + typeInstCache*: seq[(PackedItemId, PackedItemId)] + procInstCache*: seq[PackedInstantiation] + 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 + + cfg: PackedConfig + + PackedEncoder* = object + #m*: PackedModule + thisModule*: int32 + lastFile*: FileIndex # remember the last lookup entry. + lastLit*: LitId + filenames*: Table[FileIndex, LitId] + pendingTypes*: seq[PType] + pendingSyms*: seq[PSym] + typeMarker*: IntSet #Table[ItemId, TypeId] # ItemId.item -> TypeId + 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 + +template primConfigFields(fn: untyped) {.dirty.} = + fn backend + fn selectedGC + fn cCompiler + fn options + fn globalOptions + +proc definedSymbolsAsString(config: ConfigRef): string = + result = newStringOfCap(200) + result.add "config" + for d in definedSymbolNames(config.symbols): + result.add ' ' + result.add d + +proc rememberConfig(c: var PackedEncoder; m: var PackedModule; config: ConfigRef; pc: PackedConfig) = + m.definedSymbols = definedSymbolsAsString(config) + #template rem(x) = + # c.m.cfg.x = config.x + #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) + 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 + when debugConfigDiff: + if m.cfg.x != config.x: + echo "B ", m.cfg.x, " ", config.x + primConfigFields eq + +proc rememberStartupConfig*(dest: var PackedConfig, config: ConfigRef) = + template rem(x) = + dest.x = config.x + primConfigFields rem + dest.globalOptions.excl optForceFullMake + +proc hashFileCached(conf: ConfigRef; fileIdx: FileIndex): string = + result = msgs.getHash(conf, fileIdx) + if result.len == 0: + let fullpath = msgs.toFullPath(conf, fileIdx) + result = $secureHashFile(fullpath) + msgs.setHash(conf, fileIdx, result) + +proc toLitId(x: FileIndex; c: var PackedEncoder; m: var PackedModule): LitId = + ## store a file index as a literal + if x == c.lastFile: + result = c.lastLit + else: + result = c.filenames.getOrDefault(x) + if result == LitId(0): + let p = msgs.toFullPath(c.config, x) + result = getOrIncl(m.strings, p) + c.filenames[x] = result + c.lastFile = x + c.lastLit = result + assert result != LitId(0) + +proc toFileIndex*(x: LitId; m: PackedModule; config: ConfigRef): FileIndex = + result = msgs.fileInfoIdx(config, AbsoluteFile m.strings[x]) + +proc includesIdentical(m: var PackedModule; config: ConfigRef): bool = + for it in mitems(m.includes): + if hashFileCached(config, toFileIndex(it[0], m, config)) != it[1]: + return false + result = true + +proc initEncoder*(c: var PackedEncoder; m: var PackedModule; moduleSym: PSym; config: ConfigRef; pc: PackedConfig) = + ## setup a context for serializing to packed ast + 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: + let fullpath = msgs.toFullPath(config, thisNimFile) + if isAbsolute(fullpath): + # For NimScript compiler API support the main Nim file might be from a stream. + h = $secureHashFile(fullpath) + msgs.setHash(config, thisNimFile, h) + m.includes.add((toLitId(thisNimFile, c, m), h)) # the module itself + + rememberConfig(c, m, config, pc) + +proc addIncludeFileDep*(c: var PackedEncoder; m: var PackedModule; f: FileIndex) = + m.includes.add((toLitId(f, c, m), hashFileCached(c.config, f))) + +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) = + 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) = + m.trmacros.add(s.itemId.item) + +proc addPureEnum*(c: var PackedEncoder; m: var PackedModule; s: PSym) = + assert s.kind == skType + m.pureEnums.add(s.itemId.item) + +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) = + 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.strings, s.name.s) + m.compilerProcs.add((nameId, s.itemId.item)) + +proc toPackedNode*(n: PNode; ir: var PackedTree; c: var PackedEncoder; m: var PackedModule) +proc storeSym*(s: PSym; c: var PackedEncoder; m: var PackedModule): PackedItemId +proc storeType(t: PType; c: var PackedEncoder; m: var PackedModule): PackedItemId + +proc flush(c: var PackedEncoder; m: var PackedModule) = + ## serialize any pending types or symbols from the context + while true: + if c.pendingTypes.len > 0: + discard storeType(c.pendingTypes.pop, c, m) + elif c.pendingSyms.len > 0: + discard storeSym(c.pendingSyms.pop, c, m) + else: + break + +proc toLitId(x: string; m: var PackedModule): LitId = + ## store a string as a literal + result = getOrIncl(m.strings, x) + +proc toLitId(x: BiggestInt; m: var PackedModule): LitId = + ## store an integer as a literal + result = getOrIncl(m.numbers, x) + +proc toPackedInfo(x: TLineInfo; c: var PackedEncoder; m: var PackedModule): PackedLineInfo = + 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 + ## for local or remote symbols, packing the symbol as necessary + if s == nil or s.kind == skPackage: + result = nilItemId + #elif s.itemId.module == c.thisModule: + # result = PackedItemId(module: LitId(0), item: s.itemId.item) + else: + assert int(s.itemId.module) >= 0 + result = PackedItemId(module: toLitId(s.itemId.module.FileIndex, c, m), + item: s.itemId.item) + +proc addMissing(c: var PackedEncoder; p: PSym) = + ## consider queuing a symbol for later addition to the packed tree + if p != nil and p.itemId.module == c.thisModule: + if p.itemId.item notin c.symMarker: + if not (sfForward in p.flags and p.kind in routineKinds): + c.pendingSyms.add p + +proc addMissing(c: var PackedEncoder; p: PType) = + ## consider queuing a type for later addition to the packed tree + if p != nil and p.uniqueId.module == c.thisModule: + if p.uniqueId.item notin c.typeMarker: + c.pendingTypes.add p + +template storeNode(dest, src, field) = + var nodeId: NodeId + if src.field != nil: + nodeId = getNodeId(m.bodies) + toPackedNode(src.field, m.bodies, c, m) + else: + nodeId = emptyNodeId + dest.field = nodeId + +proc storeTypeLater(t: PType; c: var PackedEncoder; m: var PackedModule): PackedItemId = + # We store multiple different trees in m.bodies. For this to work out, we + # cannot immediately store types/syms. We enqueue them instead to ensure + # we only write one tree into m.bodies after the other. + if t.isNil: return nilItemId + + 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 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 + assert s.itemId.item >= 0 + result = PackedItemId(module: toLitId(s.itemId.module.FileIndex, c, m), item: s.itemId.item) + 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 + + 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 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(id: t.uniqueId.item, kind: t.kind, flags: t.flags, callConv: t.callConv, + size: t.size, align: t.align, nonUniqueId: t.itemId.item, + paddingAtEnd: t.paddingAtEnd) + storeNode(p, t, n) + p.typeInst = t.typeInst.storeType(c, m) + for kid in kids t: + p.types.add kid.storeType(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.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 = 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 = + ## serialize a psym + 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 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(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) + storeNode(p, s, constraint) + + if s.kind in {skLet, skVar, skField, skForVar}: + c.addMissing s.guard + p.guard = s.guard.safeItemId(c, m) + p.bitsize = s.bitsize + p.alignment = s.alignment + + p.externalName = toLitId(s.loc.snippet, m) + p.locFlags = s.loc.flags + c.addMissing s.typ + p.typ = s.typ.storeType(c, m) + c.addMissing s.owner + p.owner = s.owner.safeItemId(c, m) + 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.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) + 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.addNode(kind = nkNilRodNode, operand = 1, info = NoLineInfo) + return + let info = toPackedInfo(n.info, c, m) + case n.kind + of nkNone, nkEmpty, nkNilLit, nkType: + ir.addNode(kind = n.kind, flags = n.flags, operand = 0, + typeId = storeTypeLater(n.typ, c, m), info = info) + of nkIdent: + 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 + 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 externIntLit: + 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.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.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) + for i in 0..<n.len: + toPackedNode(n[i], ir, c, m) + ir.patch patchPos + +proc storeTypeInst*(c: var PackedEncoder; m: var PackedModule; s: PSym; inst: PType) = + m.typeInstCache.add (storeSymLater(s, c, m), storeTypeLater(inst, c, m)) + +proc addPragmaComputation*(c: var PackedEncoder; m: var PackedModule; n: PNode) = + toPackedNode(n, m.toReplay, c, m) + +proc toPackedProcDef(n: PNode; ir: var PackedTree; c: var PackedEncoder; m: var PackedModule) = + let info = toPackedInfo(n.info, c, m) + let patchPos = ir.prepare(n.kind, n.flags, + storeTypeLater(n.typ, c, m), info) + for i in 0..<n.len: + if i != bodyPos: + toPackedNode(n[i], ir, c, m) + else: + # 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.addNode(kind = nkEmpty, flags = {}, operand = 0, + typeId = nilItemId, info = info) + ir.patch patchPos + +proc toPackedNodeIgnoreProcDefs(n: PNode, encoder: var PackedEncoder; m: var PackedModule) = + case n.kind + of routineDefs: + toPackedProcDef(n, m.topLevel, encoder, m) + when false: + # we serialize n[namePos].sym instead + if n[namePos].kind == nkSym: + let s = n[namePos].sym + discard storeSym(s, encoder, m) + if s.flags * {sfExportc, sfCompilerProc, sfCompileTime} == {sfExportc}: + m.exportCProcs.add(s.itemId.item) + else: + toPackedNode(n, m.topLevel, encoder, m) + 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) + +proc toPackedNodeTopLevel*(n: PNode, encoder: var PackedEncoder; m: var PackedModule) = + toPackedNodeIgnoreProcDefs(n, encoder, m) + flush encoder, m + +proc toPackedGeneratedProcDef*(s: PSym, encoder: var PackedEncoder; m: var PackedModule) = + ## Generic procs and generated `=hook`'s need explicit top-level entries so + ## that the code generator can work without having to special case these. These + ## entries will also be useful for other tools and are the cleanest design + ## I can come up with. + assert s.kind in routineKinds + 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): + t[j] = storeTypeLater(i.concreteTypes[j], c, m) + m.procInstCache.add PackedInstantiation(key: storeSymLater(s, c, m), + sym: storeSymLater(i.sym, c, m), + 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: + rawMessage(config, warnCannotOpenFile, filename.string) + of includeFileChanged: + rawMessage(config, warnFileChanged, filename.string) + else: + 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 = + 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: + f.err = configMismatch + + template loadSeqSection(section, data) {.dirty.} = + 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.strings + + loadSeqSection checkSumsSection, m.includes + if config.cmd != cmdM and not includesIdentical(m, config): + f.err = includeFileChanged + + loadSeqSection depsSection, m.imports + + bench gloadBodies: + + loadTabSection numbersSection, m.numbers + + loadSeqSection exportsSection, m.exports + loadSeqSection hiddenSection, m.hidden + loadSeqSection reexportsSection, m.reexports + + loadSeqSection compilerProcsSection, m.compilerProcs + + loadSeqSection trmacrosSection, m.trmacros + + loadSeqSection convertersSection, m.converters + loadSeqSection methodsSection, m.methods + loadSeqSection pureEnumsSection, m.pureEnums + + loadTabSection toReplaySection, m.toReplay + loadTabSection topLevelSection, m.topLevel + + 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 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 + +# ------------------------------------------------------------------------- + +proc storeError(err: RodFileError; filename: AbsoluteFile) = + echo "Error: ", $err, "; couldn't write to ", filename.string + removeFile(filename.string) + +proc saveRodFile*(filename: AbsoluteFile; encoder: var PackedEncoder; m: var PackedModule) = + flush encoder, m + #rememberConfig(encoder, encoder.config) + + var f = rodfiles.create(filename.string) + f.storeHeader() + f.storeSection configSection + f.storePrim m.definedSymbols + f.storePrim m.moduleFlags + f.storePrim m.cfg + + template storeSeqSection(section, data) {.dirty.} = + f.storeSection section + f.storeSeq data + + template storeTabSection(section, data) {.dirty.} = + f.storeSection section + f.store data + + template storeTableSection(section, data) {.dirty.} = + f.storeSection section + f.storeOrderedTable data + + storeTabSection stringsSection, m.strings + + storeSeqSection checkSumsSection, m.includes + + storeSeqSection depsSection, m.imports + + storeTabSection numbersSection, m.numbers + + storeSeqSection exportsSection, m.exports + storeSeqSection hiddenSection, m.hidden + storeSeqSection reexportsSection, m.reexports + + storeSeqSection compilerProcsSection, m.compilerProcs + + storeSeqSection trmacrosSection, m.trmacros + storeSeqSection convertersSection, m.converters + storeSeqSection methodsSection, m.methods + storeSeqSection pureEnumsSection, m.pureEnums + + storeTabSection toReplaySection, m.toReplay + storeTabSection topLevelSection, m.topLevel + + storeTabSection bodiesSection, m.bodies + storeTableSection symsSection, m.syms + + storeTableSection typesSection, m.types + + storeSeqSection typeInstCacheSection, m.typeInstCache + storeSeqSection procInstCacheSection, m.procInstCache + storeSeqSection attachedOpsSection, m.attachedOps + 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: + storeError(f.err, filename) + + when false: + # basic loader testing: + var m2: PackedModule + discard loadRodFile(filename, m2, encoder.config) + echo "loaded ", filename.string + +# ---------------------------------------------------------------------------- + +type + PackedDecoder* = object + lastModule: int + lastLit: LitId + lastFile: FileIndex # remember the last lookup entry. + config*: ConfigRef + cache*: IdentCache + +type + ModuleStatus* = enum + undefined, + storing, # state is strictly for stress-testing purposes + loading, + loaded, + outdated, + stored # store is complete, no further additions possible + + LoadedModule* = object + status*: ModuleStatus + symsInit, typesInit, loadedButAliveSetChanged*: bool + fromDisk*: PackedModule + syms: OrderedTable[int32, PSym] # indexed by itemId + types: OrderedTable[int32, PType] + module*: PSym # the one true module symbol. + iface, ifaceHidden: Table[PIdent, seq[PackedItemId]] + # PackedItemId so that it works with reexported symbols too + # ifaceHidden includes private symbols + +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 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) + c.lastModule = thisModule + c.lastLit = f + c.lastFile = result + +proc translateLineInfo(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; + x: PackedLineInfo): TLineInfo = + 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 = + let k = n.kind + if k == nkNilRodNode: + return nil + when false: + echo "loading node ", c.config $ translateLineInfo(c, g, thisModule, n.info) + result = newNodeIT(k, translateLineInfo(c, g, thisModule, n.info), + loadType(c, g, thisModule, n.typ)) + result.flags = n.flags + + case k + of nkNone, nkEmpty, nkNilLit, nkType: + discard + of nkIdent: + result.ident = getIdent(c.cache, g[thisModule].fromDisk.strings[n.litId]) + of nkSym: + result.sym = loadSym(c, g, thisModule, PackedItemId(module: LitId(0), item: tree[n].soperand)) + if result.typ == nil: + result.typ = result.sym.typ + of externIntLit: + result.intVal = g[thisModule].fromDisk.numbers[n.litId] + of nkStrLit..nkTripleStrLit: + result.strVal = g[thisModule].fromDisk.strings[n.litId] + of nkFloatLit..nkFloat128Lit: + result.floatVal = cast[BiggestFloat](g[thisModule].fromDisk.numbers[n.litId]) + of nkModuleRef: + let (n1, n2) = sons2(tree, n) + assert n1.kind == nkNone + assert n2.kind == nkNone + transitionNoneToSym(result) + result.sym = loadSym(c, g, thisModule, PackedItemId(module: n1.litId, item: tree[n2].soperand)) + if result.typ == nil: + result.typ = result.sym.typ + else: + for n0 in sonsReadonly(tree, n): + result.addAllowNil loadNodes(c, g, thisModule, tree, n0) + +proc initPackedDecoder*(config: ConfigRef; cache: IdentCache): PackedDecoder = + result = PackedDecoder( + lastModule: int32(-1), + lastLit: LitId(0), + lastFile: FileIndex(-1), + config: config, + cache: cache) + +proc loadProcHeader(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; + tree: PackedTree; n: NodePos): PNode = + # do not load the body of the proc. This will be done later in + # getProcBody, if required. + let k = n.kind + result = newNodeIT(k, translateLineInfo(c, g, thisModule, n.info), + loadType(c, g, thisModule, n.typ)) + result.flags = n.flags + assert k in {nkProcDef, nkMethodDef, nkIteratorDef, nkFuncDef, nkConverterDef, nkLambda} + var i = 0 + for n0 in sonsReadonly(tree, n): + if i != bodyPos: + result.add loadNodes(c, g, thisModule, tree, n0) + else: + result.addAllowNil nil + inc i + +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: + result = loadNodes(c, g, thisModule, tree, n0) + inc i + +proc moduleIndex*(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; + s: PackedItemId): int32 {.inline.} = + result = if s.module == LitId(0): thisModule.int32 + else: toFileIndexCached(c, g, thisModule, s.module).int32 + +proc symHeaderFromPacked(c: var PackedDecoder; g: var PackedModuleGraph; + s: PackedSym; si, item: int32): PSym = + result = PSym(itemId: ItemId(module: si, item: item), + kind: s.kind, magic: s.magic, flags: s.flags, + info: translateLineInfo(c, g, si, s.info), + options: s.options, + position: if s.kind in {skForVar, skVar, skLet, skTemp}: 0 else: s.position, + offset: if s.kind in routineKinds: defaultOffset else: s.offset, + disamb: s.disamb, + name: getIdent(c.cache, g[si].fromDisk.strings[s.name]) + ) + +template loadAstBody(p, field) = + if p.field != emptyNodeId: + result.field = loadNodes(c, g, si, g[si].fromDisk.bodies, NodePos p.field) + +template loadAstBodyLazy(p, field) = + if p.field != emptyNodeId: + result.field = loadProcHeader(c, g, si, g[si].fromDisk.bodies, NodePos p.field) + +proc loadLib(c: var PackedDecoder; g: var PackedModuleGraph; + si, item: int32; l: PackedLib): PLib = + # XXX: hack; assume a zero LitId means the PackedLib is all zero (empty) + if l.name.int == 0: + result = nil + else: + 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; + s: PackedSym; si, item: int32; result: PSym) = + result.typ = loadType(c, g, si, s.typ) + loadAstBody(s, constraint) + if result.kind in {skProc, skFunc, skIterator, skConverter, skMethod}: + loadAstBodyLazy(s, ast) + else: + loadAstBody(s, ast) + result.annex = loadLib(c, g, si, item, s.annex) + when hasFFI: + 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.strings[s.externalName] + if 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) + 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.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] + +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, + uniqueId: ItemId(module: si, item: item), + callConv: t.callConv) + +proc typeBodyFromPacked(c: var PackedDecoder; g: var PackedModuleGraph; + t: PackedType; si, item: int32; result: PType) = + result.sym = loadSym(c, g, si, t.sym) + result.owner = loadSym(c, g, si, t.owner) + when false: + 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: + sons.add loadType(c, g, si, son) + result.setSons(sons) + loadAstBody(t, n) + when false: + for gen, id in items t.methods: + result.methods.add((gen, loadSym(c, g, si, id))) + +proc loadType(c: var PackedDecoder; g: var PackedModuleGraph; thisModule: int; t: PackedItemId): PType = + if t == nilItemId: + result = nil + else: + let si = moduleIndex(c, g, thisModule, t) + assert g[si].status in {loaded, storing, stored} + assert t.item > 0 + + #if not g[si].typesInit: + # g[si].typesInit = true + # setLen g[si].types, g[si].fromDisk.types.len + + if 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.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, "2" + +proc setupLookupTables(g: var PackedModuleGraph; conf: ConfigRef; cache: IdentCache; + fileIdx: FileIndex; m: var LoadedModule) = + m.iface = initTable[PIdent, seq[PackedItemId]]() + m.ifaceHidden = initTable[PIdent, seq[PackedItemId]]() + template impl(iface, e) = + let nameLit = e[0] + 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 + # mechanism, which we do in order to assign each module a persistent ID. + m.module = PSym(kind: skModule, itemId: ItemId(module: int32(fileIdx), item: 0'i32), + name: getIdent(cache, splitFile(filename).name), + info: newLineInfo(fileIdx, 1, 1), + position: int(fileIdx)) + 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) = + m.module.ast = newNode(nkStmtList) + if m.fromDisk.toReplay.len > 0: + var decoder = PackedDecoder( + lastModule: int32(-1), + lastLit: LitId(0), + lastFile: FileIndex(-1), + config: conf, + cache: cache) + for p in allNodes(m.fromDisk.toReplay): + m.module.ast.add loadNodes(decoder, g, int(fileIdx), m.fromDisk.toReplay, p) + +proc needsRecompile(g: var PackedModuleGraph; conf: ConfigRef; cache: IdentCache; + fileIdx: FileIndex; cachedModules: var seq[FileIndex]): bool = + # Does the file belong to the fileIdx need to be recompiled? + let m = int(fileIdx) + if m >= g.len: + 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, ignoreConfig = conf.cmd == cmdM) + if err == ok: + if conf.cmd == cmdM: + setupLookupTables(g, conf, cache, fileIdx, g[m]) + cachedModules.add fileIdx + g[m].status = loaded + result = false + else: + 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 + result = true + when false: loadError(err, rod, conf) + of loading, loaded: + # For loading: Assume no recompile is required. + result = false + 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. + 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]) + +template setupDecoder() {.dirty.} = + var decoder = PackedDecoder( + lastModule: int32(-1), + lastLit: LitId(0), + lastFile: FileIndex(-1), + config: config, + cache: cache) + +proc loadProcBody*(config: ConfigRef, cache: IdentCache; + g: var PackedModuleGraph; s: PSym): PNode = + bench g.loadBody: + 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.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 = + 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): + ItemId(module: thisModule.int32, item: id.item) + else: + ItemId(module: toFileIndex(id.module, g[thisModule].fromDisk, config).int32, item: id.item) + +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 + # compiler's memory consumption. + let idx = moduleSym.position + assert g[idx].status in {storing} + g[idx].status = loaded + assert g[idx].module == moduleSym + setupLookupTables(g, conf, cache, FileIndex(idx), g[idx]) + loadToReplayNodes(g, conf, cache, FileIndex(idx), g[idx]) + +# ---------------- symbol table handling ---------------- + +type + RodIter* = object + decoder: PackedDecoder + 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, importHidden: bool): PSym = + it.decoder = PackedDecoder( + lastModule: int32(-1), + lastLit: LitId(0), + lastFile: FileIndex(-1), + config: config, + cache: cache) + 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; importHidden: bool): PSym = + it.decoder = PackedDecoder( + lastModule: int32(-1), + lastLit: LitId(0), + lastFile: FileIndex(-1), + config: config, + cache: cache) + it.values = @[] + it.module = int(module) + 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, importHidden: bool): PSym = + setupDecoder() + let values = g[int module].interfSelect(importHidden).getOrDefault(name) + for pid in values: + let s = loadSym(decoder, g, int(module), pid) + assert s != nil + yield s + +proc interfaceSymbol*(config: ConfigRef, cache: IdentCache; + g: var PackedModuleGraph; module: FileIndex; + name: PIdent, importHidden: bool): PSym = + setupDecoder() + 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.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.strings[it[0]] == name: + return it[1] + return -1 + +# ------------------------- .rod file viewer --------------------------------- + +proc rodViewer*(rodfile: AbsoluteFile; config: ConfigRef, cache: IdentCache) = + var m: PackedModule = PackedModule() + let err = loadRodFile(rodfile, m, config, ignoreConfig=true) + if err != ok: + config.quitOrRaise "Error: could not load: " & $rodfile.string & " reason: " & $err + + when false: + echo "exports:" + for ex in m.exports: + 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.strings[ex[0]] + # reexports*: seq[(LitId, PackedItemId)] + + 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 "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 new file mode 100644 index 000000000..a39bb7adf --- /dev/null +++ b/compiler/ic/packed_ast.nim @@ -0,0 +1,367 @@ +# +# +# The Nim Compiler +# (c) Copyright 2020 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Packed AST representation, mostly based on a seq of nodes. +## For IC support. Far future: Rewrite the compiler passes to +## use this representation directly in all the transformations, +## it is superior. + +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 + NodePos* = distinct int + + NodeId* = distinct int32 + + PackedItemId* = object + module*: LitId # 0 if it's this module + item*: int32 # same as the in-memory representation + +const + nilItemId* = PackedItemId(module: LitId(0), item: 0.int32) + +const + emptyNodeId* = NodeId(-1) + +type + PackedLib* = object + kind*: TLibKind + generated*: bool + isOverridden*: bool + name*: LitId + path*: NodeId + + PackedSym* = object + id*: int32 + kind*: TSymKind + name*: LitId + typ*: PackedItemId + flags*: TSymFlags + magic*: TMagic + info*: PackedLineInfo + ast*: NodeId + owner*: PackedItemId + guard*: PackedItemId + bitsize*: int + alignment*: int # for alignment + options*: TOptions + position*: 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 + flags*: TTypeFlags + types*: seq[PackedItemId] + n*: NodeId + #nodeflags*: TNodeFlags + sym*: PackedItemId + owner*: PackedItemId + size*: BiggestInt + align*: int16 + paddingAtEnd*: int16 + # not serialized: loc*: TLoc because it is backend-specific + typeInst*: PackedItemId + nonUniqueId*: int32 + + PackedNode* = object # 8 bytes + x: uint32 + info*: PackedLineInfo + + PackedTree* = object ## usually represents a full Nim module + 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.} + +proc `==`*(a, b: NodePos): bool {.borrow.} +#proc `==`*(a, b: PackedItemId): bool {.borrow.} +proc `==`*(a, b: NodeId): bool {.borrow.} + +proc newTreeFrom*(old: PackedTree): PackedTree = + result = PackedTree(nodes: @[]) + when false: result.sh = old.sh + +proc addIdent*(tree: var PackedTree; s: LitId; info: PackedLineInfo) = + tree.nodes.add PackedNode(x: toX(nkIdent, uint32(s)), info: info) + +proc addSym*(tree: var PackedTree; s: int32; info: PackedLineInfo) = + 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(x: toX(nkSym, cast[uint32](s)), info: info) + +proc isAtom*(tree: PackedTree; pos: int): bool {.inline.} = tree.nodes[pos].kind <= nkNilLit + +type + PatchPos = distinct int + +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.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 + dest.nodes.add source.nodes[sourcePos.int] + +proc patch*(tree: var PackedTree; pos: PatchPos) = + let pos = pos.int + let k = tree.nodes[pos].kind + assert k > nkNilLit + let distance = int32(tree.nodes.len - pos) + 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: 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].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].rawSpan + inc pos + while pos < last: + yield NodePos pos + nextChild tree, pos + +iterator sons*(dest: var PackedTree; tree: PackedTree; n: NodePos): NodePos = + let patchPos = prepare(dest, tree, n) + for x in sonsReadonly(tree, n): yield x + patch dest, patchPos + +iterator isons*(dest: var PackedTree; tree: PackedTree; + n: NodePos): (int, NodePos) = + var i = 0 + for ch0 in sons(dest, tree, n): + yield (i, ch0) + inc i + +iterator sonsFrom1*(tree: PackedTree; n: NodePos): NodePos = + var pos = n.int + assert tree.nodes[pos].kind > nkNilLit + let last = pos + tree.nodes[pos].rawSpan + inc pos + if pos < last: + nextChild tree, pos + while pos < last: + yield NodePos pos + nextChild tree, pos + +iterator sonsWithoutLast2*(tree: PackedTree; n: NodePos): NodePos = + var count = 0 + for child in sonsReadonly(tree, n): + inc count + var pos = n.int + assert tree.nodes[pos].kind > nkNilLit + let last = pos + tree.nodes[pos].rawSpan + inc pos + while pos < last and count > 2: + yield NodePos pos + dec count + nextChild tree, pos + +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].rawSpan - 1 < n.int)): + dec pos + #assert pos >= 0, "node has no parent" + result = NodePos(pos) + +template parent*(n: NodePos): NodePos = parentImpl(tree, n) + +proc hasXsons*(tree: PackedTree; n: NodePos; x: int): bool = + var count = 0 + if tree.nodes[n.int].kind > nkNilLit: + for child in sonsReadonly(tree, n): inc count + result = count == x + +proc hasAtLeastXsons*(tree: PackedTree; n: NodePos; x: int): bool = + if tree.nodes[n.int].kind > nkNilLit: + var count = 0 + for child in sonsReadonly(tree, n): + inc count + if count >= x: return true + return false + +proc firstSon*(tree: PackedTree; n: NodePos): NodePos {.inline.} = + NodePos(n.int+1) +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].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.findType(n) +template flags*(n: NodePos): TNodeFlags = + tree.findFlags(n) + +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].rawSpan + +proc sons2*(tree: PackedTree; n: NodePos): (NodePos, NodePos) = + assert(not isAtom(tree, n.int)) + let a = n.int+1 + let b = a + span(tree, a) + result = (NodePos a, NodePos b) + +proc sons3*(tree: PackedTree; n: NodePos): (NodePos, NodePos, NodePos) = + assert(not isAtom(tree, n.int)) + let a = n.int+1 + let b = a + span(tree, a) + let c = b + span(tree, b) + result = (NodePos a, NodePos b, NodePos c) + +proc 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): + if count == i: return child + inc count + assert false, "node has no i-th child" + +when false: + proc `@`*(tree: PackedTree; lit: LitId): lent string {.inline.} = + tree.sh.strings[lit] + +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].uoperand + +template symId*(n: NodePos): SymId = SymId tree.nodes[n.int].soperand + +proc firstSon*(n: NodePos): NodePos {.inline.} = NodePos(n.int+1) + +const + externIntLit* = {nkCharLit, + nkIntLit, + nkInt8Lit, + nkInt16Lit, + nkInt32Lit, + nkInt64Lit, + nkUIntLit, + nkUInt8Lit, + nkUInt16Lit, + nkUInt32Lit, + nkUInt64Lit} + + externSIntLit* = {nkIntLit, nkInt8Lit, nkInt16Lit, nkInt32Lit, nkInt64Lit} + externUIntLit* = {nkUIntLit, nkUInt8Lit, nkUInt16Lit, nkUInt32Lit, nkUInt64Lit} + directIntLit* = nkNone + +template copyInto*(dest, n, body) = + let patchPos = prepare(dest, tree, n) + body + patch dest, patchPos + +template copyIntoKind*(dest, kind, info, body) = + let patchPos = prepare(dest, kind, info) + body + patch dest, patchPos + +proc getNodeId*(tree: PackedTree): NodeId {.inline.} = NodeId tree.nodes.len + +iterator allNodes*(tree: PackedTree): NodePos = + var p = 0 + while p < tree.len: + yield NodePos(p) + let s = span(tree, p) + inc p, s + +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 new file mode 100644 index 000000000..b244ec885 --- /dev/null +++ b/compiler/ic/replayer.nim @@ -0,0 +1,171 @@ +# +# +# The Nim Compiler +# (c) Copyright 2020 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Module that contains code to replay global VM state changes and pragma +## state like ``{.compile: "foo.c".}``. For IC (= Incremental compilation) +## support. + +import ".." / [ast, modulegraphs, trees, extccomp, btrees, + msgs, lineinfos, pathutils, options, cgmeth] + +import std/tables + +when defined(nimPreviewSlimSystem): + import std/assertions + +import packed_ast, ic, bitabs + +proc replayStateChanges*(module: PSym; g: ModuleGraph) = + let list = module.ast + assert list != nil + assert list.kind == nkStmtList + for n in list: + assert n.kind == nkReplayAction + # Fortunately only a tiny subset of the available pragmas need to + # be replayed here. This is always a subset of ``pragmas.stmtPragmas``. + if n.len >= 2: + internalAssert g.config, n[0].kind == nkStrLit and n[1].kind == nkStrLit + case n[0].strVal + of "hint": message(g.config, n.info, hintUser, n[1].strVal) + of "warning": message(g.config, n.info, warnUser, n[1].strVal) + of "error": localError(g.config, n.info, errUser, n[1].strVal) + of "compile": + internalAssert g.config, n.len == 4 and n[2].kind == nkStrLit + let cname = AbsoluteFile n[1].strVal + var cf = Cfile(nimname: splitFile(cname).name, cname: cname, + obj: AbsoluteFile n[2].strVal, + flags: {CfileFlag.External}, + customArgs: n[3].strVal) + extccomp.addExternalFileToCompile(g.config, cf) + of "link": + extccomp.addExternalFileToLink(g.config, AbsoluteFile n[1].strVal) + of "passl": + extccomp.addLinkOption(g.config, n[1].strVal) + of "passc": + extccomp.addCompileOption(g.config, n[1].strVal) + of "localpassc": + extccomp.addLocalCompileOption(g.config, n[1].strVal, toFullPathConsiderDirty(g.config, module.info.fileIndex)) + of "cppdefine": + options.cppDefine(g.config, n[1].strVal) + of "inc": + let destKey = n[1].strVal + let by = n[2].intVal + let v = getOrDefault(g.cacheCounters, destKey) + g.cacheCounters[destKey] = v+by + of "put": + let destKey = n[1].strVal + let key = n[2].strVal + let val = n[3] + if not contains(g.cacheTables, destKey): + g.cacheTables[destKey] = initBTree[string, PNode]() + if not contains(g.cacheTables[destKey], key): + g.cacheTables[destKey].add(key, val) + else: + internalError(g.config, n.info, "key already exists: " & key) + of "incl": + let destKey = n[1].strVal + let val = n[2] + if not contains(g.cacheSeqs, destKey): + g.cacheSeqs[destKey] = newTree(nkStmtList, val) + else: + block search: + for existing in g.cacheSeqs[destKey]: + if exprStructuralEquivalent(existing, val, strictSymEquality=true): + break search + g.cacheSeqs[destKey].add val + of "add": + let destKey = n[1].strVal + let val = n[2] + if not contains(g.cacheSeqs, destKey): + g.cacheSeqs[destKey] = newTree(nkStmtList, val) + else: + g.cacheSeqs[destKey].add val + 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 + ## to imply. This is cheaper than deduplication of identical + ## generic instantiations. However, deduplication is more + ## powerful and general and I hope to implement it soon too + ## (famous last words). + assert g.packed[module].status == loaded + for it in g.packed[module].fromDisk.typeInstCache: + let key = translateId(it[0], g.packed, module, g.config) + g.typeInstCache.mgetOrPut(key, @[]).add LazyType(id: FullId(module: module, packed: it[1]), typ: nil) + + for it in mitems(g.packed[module].fromDisk.procInstCache): + let key = translateId(it.key, g.packed, module, g.config) + let sym = translateId(it.sym, g.packed, module, g.config) + var concreteTypes = newSeq[FullId](it.concreteTypes.len) + for i in 0..high(it.concreteTypes): + let tmp = translateId(it.concreteTypes[i], g.packed, module, g.config) + concreteTypes[i] = FullId(module: tmp.module, packed: it.concreteTypes[i]) + + g.procInstCache.mgetOrPut(key, @[]).add LazyInstantiation( + module: module, sym: FullId(module: sym.module, packed: it.sym), + concreteTypes: concreteTypes, inst: nil) + + 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.methodsPerGenericType.mgetOrPut(key, @[]).add (col, 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, + PackedItemId(module: LitId(0), item: it)) + methodDef(g, g.idgen, sym) + + when false: + # not used anymore: + for it in mitems(g.packed[module].fromDisk.compilerProcs): + let symId = FullId(module: module, packed: PackedItemId(module: LitId(0), item: it[1])) + g.lazyCompilerprocs[g.packed[module].fromDisk.sh.strings[it[0]]] = symId + + for it in mitems(g.packed[module].fromDisk.converters): + let symId = FullId(module: module, packed: PackedItemId(module: LitId(0), item: it)) + g.ifaces[module].converters.add LazySym(id: symId, sym: nil) + + for it in mitems(g.packed[module].fromDisk.trmacros): + let symId = FullId(module: module, packed: PackedItemId(module: LitId(0), item: it)) + g.ifaces[module].patterns.add LazySym(id: symId, sym: nil) + + for it in mitems(g.packed[module].fromDisk.pureEnums): + let symId = FullId(module: module, packed: PackedItemId(module: LitId(0), item: it)) + g.ifaces[module].pureEnums.add LazySym(id: symId, sym: nil) diff --git a/compiler/ic/rodfiles.nim b/compiler/ic/rodfiles.nim new file mode 100644 index 000000000..ac995dd2e --- /dev/null +++ b/compiler/ic/rodfiles.nim @@ -0,0 +1,283 @@ +# +# +# The Nim Compiler +# (c) Copyright 2020 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## 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 + versionSection + configSection + stringsSection + checkSumsSection + depsSection + numbersSection + exportsSection + hiddenSection + reexportsSection + compilerProcsSection + trmacrosSection + convertersSection + methodsSection + pureEnumsSection + toReplaySection + topLevelSection + bodiesSection + symsSection + typesSection + typeInstCacheSection + procInstCacheSection + attachedOpsSection + 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, + includeFileChanged + + RodFile* = object + f*: File + currentSection*: RodSection # for error checking + err*: RodFileError # little experiment to see if this works + # better than exceptions. + +const + 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.} = + f.err = err + #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 + return + var lenPrefix = int32(s.len) + if writeBuffer(f.f, addr lenPrefix, sizeof(lenPrefix)) != sizeof(lenPrefix): + setError f, ioFailure + else: + if s.len != 0: + if writeBuffer(f.f, unsafeAddr(s[0]), s.len) != s.len: + 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): + setError f, ioFailure + elif T is tuple: + for y in fields(x): + storePrim(f, y) + elif T is object: + for y in fields(x): + when y is seq: + storeSeq(f, y) + else: + storePrim(f, y) + else: + {.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 + return + var lenPrefix = int32(s.len) + if writeBuffer(f.f, addr lenPrefix, sizeof(lenPrefix)) != sizeof(lenPrefix): + setError f, ioFailure + else: + 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): + setError f, ioFailure + else: + s = newString(lenPrefix) + if lenPrefix > 0: + if readBuffer(f.f, unsafeAddr(s[0]), s.len) != s.len: + 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): + setError f, ioFailure + elif T is tuple: + for y in fields(x): + loadPrim(f, y) + elif T is object: + for y in fields(x): + when y is seq: + loadSeq(f, y) + else: + loadPrim(f, y) + else: + {.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): + setError f, ioFailure + else: + s = newSeq[T](lenPrefix) + for i in 0..<lenPrefix: + loadPrim(f, s[i]) + +proc loadOrderedTable*[K, T](f: var RodFile; s: var OrderedTable[K, T]) = + ## `T` must be compatible with `copyMem`, see `loadPrim` + if f.err != ok: return + var lenPrefix = int32(0) + if readBuffer(f.f, addr lenPrefix, sizeof(lenPrefix)) != sizeof(lenPrefix): + setError f, ioFailure + else: + s = initOrderedTable[K, T](lenPrefix) + for i in 0..<lenPrefix: + var x = default T + loadPrim(f, x) + s[x.id] = x + +proc storeHeader*(f: var RodFile; cookie = defaultCookie) = + ## stores the header which is described by `cookie`. + if f.err != ok: return + if f.f.writeBytes(cookie, 0, cookie.len) != cookie.len: + setError f, ioFailure + +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] = 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 = 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 0a2f2d5cf..34177e76d 100644 --- a/compiler/idents.nim +++ b/compiler/idents.nim @@ -11,16 +11,16 @@ # 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, strutils, wordrecg +import wordrecg +import std/hashes -type - TIdObj* = object of RootObj - id*: int # unique id; use this for comparisons and not the pointers +when defined(nimPreviewSlimSystem): + import std/assertions - PIdObj* = ref TIdObj +type PIdent* = ref TIdent - TIdent*{.acyclic.} = object of TIdObj + TIdent*{.acyclic.} = object + id*: int # unique id; use this for comparisons and not the pointers s*: string next*: PIdent # for hash-table chaining h*: Hash # hash value of s @@ -30,14 +30,7 @@ type wordCounter: int idAnon*, idDelegator*, emptyIdent*: PIdent -when false: - var - legacy: IdentCache - -proc resetIdentCache*() = - when false: - for i in low(legacy.buckets)..high(legacy.buckets): - legacy.buckets[i] = nil +proc resetIdentCache*() = discard proc cmpIgnoreStyle*(a, b: cstring, blen: int): int = if a[0] != b[0]: return 1 @@ -73,11 +66,9 @@ proc cmpExact(a, b: cstring, blen: int): int = if result == 0: if a[i] != '\0': result = 1 -{.this: self.} - -proc getIdent*(self: IdentCache; identifier: cstring, length: int, h: Hash): PIdent = - var idx = h and high(buckets) - result = buckets[idx] +proc getIdent*(ic: IdentCache; identifier: cstring, length: int, h: Hash): PIdent = + var idx = h and high(ic.buckets) + result = ic.buckets[idx] var last: PIdent = nil var id = 0 while result != nil: @@ -85,8 +76,8 @@ proc getIdent*(self: IdentCache; identifier: cstring, length: int, h: Hash): PId if last != nil: # make access to last looked up identifier faster: last.next = result.next - result.next = buckets[idx] - buckets[idx] = result + result.next = ic.buckets[idx] + ic.buckets[idx] = result return elif cmpIgnoreStyle(cstring(result.s), identifier, length) == 0: assert((id == 0) or (id == result.id)) @@ -96,21 +87,21 @@ proc getIdent*(self: IdentCache; identifier: cstring, length: int, h: Hash): PId new(result) result.h = h result.s = newString(length) - for i in countup(0, length - 1): result.s[i] = identifier[i] - result.next = buckets[idx] - buckets[idx] = result + for i in 0..<length: result.s[i] = identifier[i] + result.next = ic.buckets[idx] + ic.buckets[idx] = result if id == 0: - inc(wordCounter) - result.id = -wordCounter + inc(ic.wordCounter) + result.id = -ic.wordCounter else: result.id = id -proc getIdent*(self: IdentCache; identifier: string): PIdent = - result = getIdent(cstring(identifier), len(identifier), +proc getIdent*(ic: IdentCache; identifier: string): PIdent = + result = getIdent(ic, cstring(identifier), identifier.len, hashIgnoreStyle(identifier)) -proc getIdent*(self: IdentCache; identifier: string, h: Hash): PIdent = - result = getIdent(cstring(identifier), len(identifier), h) +proc getIdent*(ic: IdentCache; identifier: string, h: Hash): PIdent = + result = getIdent(ic, cstring(identifier), identifier.len, h) proc newIdentCache*(): IdentCache = result = IdentCache() @@ -119,9 +110,14 @@ proc newIdentCache*(): IdentCache = result.idDelegator = result.getIdent":delegator" result.emptyIdent = result.getIdent("") # initialize the keywords: - for s in countup(succ(low(specialWords)), high(specialWords)): - result.getIdent(specialWords[s], hashIgnoreStyle(specialWords[s])).id = ord(s) + for s in succ(low(TSpecialWord))..high(TSpecialWord): + result.getIdent($s, hashIgnoreStyle($s)).id = ord(s) proc whichKeyword*(id: PIdent): TSpecialWord = if id.id < 0: result = wInvalid else: result = TSpecialWord(id.id) + +proc hash*(x: PIdent): Hash {.inline.} = x.h +proc `==`*(a, b: PIdent): bool {.inline.} = + if a.isNil or b.isNil: result = system.`==`(a, b) + else: result = a.id == b.id diff --git a/compiler/idgen.nim b/compiler/idgen.nim deleted file mode 100644 index 7d103ffd7..000000000 --- a/compiler/idgen.nim +++ /dev/null @@ -1,59 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2012 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module contains a simple persistent id generator. - -import idents, strutils, os, options - -var gFrontEndId*: int - -const - debugIds* = false - -when debugIds: - import intsets - - var usedIds = initIntSet() - -proc registerID*(id: PIdObj) = - when debugIds: - if id.id == -1 or containsOrIncl(usedIds, id.id): - internalError("ID already used: " & $id.id) - -proc getID*(): int {.inline.} = - result = gFrontEndId - inc(gFrontEndId) - -proc setId*(id: int) {.inline.} = - gFrontEndId = max(gFrontEndId, id + 1) - -proc idSynchronizationPoint*(idRange: int) = - gFrontEndId = (gFrontEndId div idRange + 1) * idRange + 1 - -proc toGid(conf: ConfigRef; f: string): string = - # we used to use ``f.addFileExt("gid")`` (aka ``$project.gid``), but this - # will cause strange bugs if multiple projects are in the same folder, so - # we simply use a project independent name: - result = options.completeGeneratedFilePath(conf, "nim.gid") - -proc saveMaxIds*(conf: ConfigRef; project: string) = - var f = open(toGid(conf, project), fmWrite) - f.writeLine($gFrontEndId) - f.close() - -proc loadMaxIds*(conf: ConfigRef; project: string) = - var f: File - if open(f, toGid(conf, project), fmRead): - var line = newStringOfCap(20) - if f.readLine(line): - var frontEndId = parseInt(line) - if f.readLine(line): - # var backEndId = parseInt(line) - gFrontEndId = max(gFrontEndId, frontEndId) - f.close() diff --git a/compiler/importer.nim b/compiler/importer.nim index c013b93ab..ffb7e0305 100644 --- a/compiler/importer.nim +++ b/compiler/importer.nim @@ -7,106 +7,214 @@ # distribution, for details about the copyright. # -# This module implements the symbol importing mechanism. +## This module implements the symbol importing mechanism. import - intsets, strutils, os, ast, astalgo, msgs, options, idents, lookups, - semdata, passes, renderer, modulepaths, sigmatch, lineinfos + 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] -proc evalImport*(c: PContext, n: PNode): PNode -proc evalFrom*(c: PContext, n: PNode): PNode +when defined(nimPreviewSlimSystem): + import std/assertions proc readExceptSet*(c: PContext, n: PNode): IntSet = assert n.kind in {nkImportExceptStmt, nkExportExceptStmt} result = initIntSet() - for i in 1 ..< n.len: + for i in 1..<n.len: let ident = lookups.considerQuotedIdent(c, n[i]) result.incl(ident.id) -proc importPureEnumField*(c: PContext; s: PSym) = - var check = strTableGet(c.importTable.symbols, s.name) - if check == nil: +proc declarePureEnumField*(c: PContext; s: PSym) = + # XXX Remove the outer 'if' statement and see what breaks. + var amb = false + if someSymFromImportTable(c, s.name, amb) == nil: strTableAdd(c.pureEnumFields, s) + when false: + let checkB = strTableGet(c.pureEnumFields, s.name) + if checkB == nil: + strTableAdd(c.pureEnumFields, s) + when false: + # mark as ambiguous: + incl(c.ambiguousSymbols, checkB.id) + incl(c.ambiguousSymbols, s.id) -proc rawImportSymbol(c: PContext, s: PSym) = +proc importPureEnumField(c: PContext; s: PSym) = + var amb = false + if someSymFromImportTable(c, s.name, amb) == nil: + strTableAdd(c.pureEnumFields, s) + when false: + let checkB = strTableGet(c.pureEnumFields, s.name) + if checkB == nil: + strTableAdd(c.pureEnumFields, s) + when false: + # mark as ambiguous: + incl(c.ambiguousSymbols, checkB.id) + incl(c.ambiguousSymbols, s.id) + +proc importPureEnumFields(c: PContext; s: PSym; etyp: PType) = + assert sfPure in s.flags + for j in 0..<etyp.n.len: + var e = etyp.n[j].sym + if e.kind != skEnumField: + internalError(c.config, s.info, "rawImportSymbol") + # BUGFIX: because of aliases for enums the symbol may already + # have been put into the symbol table + # BUGFIX: but only iff they are the same symbols! + for check in importedItems(c, e.name): + if check.id == e.id: + e = nil + break + if e != nil: + importPureEnumField(c, e) + +proc rawImportSymbol(c: PContext, s, origin: PSym; importSet: var IntSet) = # This does not handle stubs, because otherwise loading on demand would be # pointless in practice. So importing stubs is fine here! # check if we have already a symbol of the same name: - var check = strTableGet(c.importTable.symbols, s.name) - if check != nil and check.id != s.id: - if s.kind notin OverloadableSyms or check.kind notin OverloadableSyms: - # s and check need to be qualified: - incl(c.ambiguousSymbols, s.id) - incl(c.ambiguousSymbols, check.id) + when false: + var check = someSymFromImportTable(c, s.name) + if check != nil and check.id != s.id: + if s.kind notin OverloadableSyms or check.kind notin OverloadableSyms: + # s and check need to be qualified: + incl(c.ambiguousSymbols, s.id) + incl(c.ambiguousSymbols, check.id) # thanks to 'export' feature, it could be we import the same symbol from - # multiple sources, so we need to call 'StrTableAdd' here: - strTableAdd(c.importTable.symbols, s) + # multiple sources, so we need to call 'strTableAdd' here: + when false: + # now lazy. Speeds up the compiler and is a prerequisite for IC. + strTableAdd(c.importTable.symbols, s) + else: + importSet.incl s.id if s.kind == skType: var etyp = s.typ if etyp.kind in {tyBool, tyEnum}: - for j in countup(0, sonsLen(etyp.n) - 1): - var e = etyp.n.sons[j].sym + for j in 0..<etyp.n.len: + var e = etyp.n[j].sym if e.kind != skEnumField: internalError(c.config, s.info, "rawImportSymbol") # BUGFIX: because of aliases for enums the symbol may already # have been put into the symbol table # BUGFIX: but only iff they are the same symbols! - var it: TIdentIter - check = initIdentIter(it, c.importTable.symbols, e.name) - while check != nil: + for check in importedItems(c, e.name): if check.id == e.id: e = nil break - check = nextIdentIter(it, c.importTable.symbols) if e != nil: if sfPure notin s.flags: - rawImportSymbol(c, e) + rawImportSymbol(c, e, origin, importSet) else: importPureEnumField(c, e) else: - # rodgen assures that converters and patterns are no stubs - if s.kind == skConverter: addConverter(c, s) - if hasPattern(s): addPattern(c, s) + if s.kind == skConverter: addConverter(c, LazySym(sym: s)) + if hasPattern(s): addPattern(c, LazySym(sym: s)) + 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") -proc importSymbol(c: PContext, n: PNode, fromMod: PSym) = let ident = lookups.considerQuotedIdent(c, n) - let s = strTableGet(fromMod.tab, ident) + let s = someSym(c.graph, fromMod, ident) if s == nil: errorUndeclaredIdentifier(c, n.info, ident.s) else: when false: if s.kind == skStub: loadStub(s) - if s.kind notin ExportableSymKinds: - internalError(c.config, n.info, "importSymbol: 2") + let multiImport = s.kind notin ExportableSymKinds or s.kind in skProcKinds # for an enumeration we have to add all identifiers - case s.kind - of skProcKinds: + if multiImport: # for a overloadable syms add all overloaded routines - var it: TIdentIter - var e = initIdentIter(it, fromMod.tab, s.name) + 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") - rawImportSymbol(c, e) - e = nextIdentIter(it, fromMod.tab) - else: rawImportSymbol(c, s) + if s.kind in ExportableSymKinds: + rawImportSymbol(c, e, fromMod, importSet) + e = nextModuleIter(it, c.graph) + else: + rawImportSymbol(c, s, fromMod, importSet) + suggestSym(c.graph, n.info, s, c.graph.usageSym, false) + +proc addImport(c: PContext; im: sink ImportedModule) = + for i in 0..high(c.imports): + if c.imports[i].m == im.m: + # we have already imported the module: Check which import + # is more "powerful": + case c.imports[i].mode + of importAll: discard "already imported all symbols" + of importSet: + case im.mode + of importAll, importExcept: + # XXX: slightly wrong semantics for 'importExcept'... + # But we should probably change the spec and disallow this case. + c.imports[i] = im + of importSet: + # merge the import sets: + c.imports[i].imported.incl im.imported + of importExcept: + case im.mode + of importAll: + c.imports[i] = im + of importSet: + discard + of importExcept: + var cut = initIntSet() + # only exclude what is consistent between the two sets: + for j in im.exceptSet: + if j in c.imports[i].exceptSet: + cut.incl j + c.imports[i].exceptSet = cut + return + c.imports.add im + +template addUnnamedIt(c: PContext, fromMod: PSym; filter: untyped) {.dirty.} = + for it in mitems c.graph.ifaces[fromMod.position].converters: + if filter: + 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: + 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) = - var i: TTabIter - var s = initTabIter(i, fromMod.tab) - while s != nil: - if s.kind != skModule: - if s.kind != skEnumField: - if s.kind notin ExportableSymKinds: - internalError(c.config, s.info, "importAllSymbols: " & $s.kind) - if exceptSet.isNil or s.name.id notin exceptSet: - rawImportSymbol(c, s) - s = nextIter(i, fromMod.tab) + c.addImport ImportedModule(m: fromMod, mode: importExcept, exceptSet: exceptSet) + addUnnamedIt(c, fromMod, it.sym.name.id notin exceptSet) proc importAllSymbols*(c: PContext, fromMod: PSym) = - var exceptSet: IntSet - importAllSymbolsExcept(c, fromMod, exceptSet) + c.addImport ImportedModule(m: fromMod, mode: importAll) + addUnnamedIt(c, fromMod, true) + when false: + var exceptSet: IntSet + importAllSymbolsExcept(c, fromMod, exceptSet) -proc importForwarded(c: PContext, n: PNode, exceptSet: IntSet) = +proc importForwarded(c: PContext, n: PNode, exceptSet: IntSet; fromMod: PSym; importSet: var IntSet) = if n.isNil: return case n.kind of nkExportStmt: @@ -116,98 +224,170 @@ proc importForwarded(c: PContext, n: PNode, exceptSet: IntSet) = if s.kind == skModule: importAllSymbolsExcept(c, s, exceptSet) elif exceptSet.isNil or s.name.id notin exceptSet: - rawImportSymbol(c, s) + rawImportSymbol(c, s, fromMod, importSet) of nkExportExceptStmt: localError(c.config, n.info, "'export except' not implemented") else: - for i in 0..safeLen(n)-1: - importForwarded(c, n.sons[i], exceptSet) + 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 + 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.sons[1].kind != nkIdent: + elif n.len != 2 or n[1].kind != nkIdent: localError(c.config, n.info, "module alias must be an identifier") - elif n.sons[1].ident.id != realModule.name.id: + elif n[1].ident.id != realModule.name.id: # some misguided guy will write 'import abc.foo as foo' ... - result = createModuleAlias(realModule, n.sons[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 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: PNode; importStmtResult: PNode): PSym = - var f = checkModuleName(c.config, n) - if f != InvalidFileIDX: +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) let L = c.graph.importStack.len let recursion = c.graph.importStack.find(f) c.graph.importStack.add f #echo "adding ", toFullPath(f), " at ", L+1 if recursion >= 0: var err = "" - for i in countup(recursion, L-1): + for i in recursion..<L: if i > recursion: err.add "\n" err.add toFullPath(c.config, c.graph.importStack[i]) & " imports " & toFullPath(c.config, c.graph.importStack[i+1]) c.recursiveDep = err - result = importModuleAs(c, n, c.graph.importModuleCallback(c.graph, c.module, f)) + + var realModule: PSym + discard pushOptionEntry(c) + 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) + # 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) - suggestSym(c.config, n.info, result, c.graph.usageSym, false) - importStmtResult.add newStrNode(toFullPath(c.config, f), n.info) + suggestSym(c.graph, n.info, s, c.graph.usageSym, false) + suggestMod(n, result) + importStmtResult.add newSymNode(result, n.info) + #newStrNode(toFullPath(c.config, f), n.info) + else: + 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) = + var it = it let m = myImportModule(c, it, importStmtResult) if m != nil: - var emptySet: IntSet # ``addDecl`` needs to be done before ``importAllSymbols``! addDecl(c, m, it.info) # add symbol to symbol table of module - importAllSymbolsExcept(c, m, emptySet) - #importForwarded(c, m.ast, emptySet) + importAllSymbols(c, m) + #importForwarded(c, m.ast, emptySet, m) + afterImport(c, m) -proc evalImport(c: PContext, n: PNode): PNode = - #result = n +proc evalImport*(c: PContext, n: PNode): PNode = result = newNodeI(nkImportStmt, n.info) - for i in countup(0, sonsLen(n) - 1): - let it = n.sons[i] - if it.kind == nkInfix and it.len == 3 and it[2].kind == nkBracket: - let sep = it[0] - let dir = it[1] - let a = newNodeI(nkInfix, it.info) - a.add sep - a.add dir - a.add sep # dummy entry, replaced in the loop - for x in it[2]: - a.sons[2] = x - impMod(c, a, result) + for i in 0..<n.len: + let it = n[i] + 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": + var impAs = copyNode(x) + newSons(impAs, 3) + impAs[0] = x[0] + imp[lastPos] = x[1] + impAs[1] = imp + impAs[2] = x[2] + impMod(c, impAs, result) + else: + imp[lastPos] = x + impMod(c, imp, result) else: impMod(c, it, result) -proc evalFrom(c: PContext, n: PNode): PNode = +proc evalFrom*(c: PContext, n: PNode): PNode = result = newNodeI(nkImportStmt, n.info) checkMinSonsLen(n, 2, c.config) - var m = myImportModule(c, n.sons[0], result) + var m = myImportModule(c, n[0], result) if m != nil: - n.sons[0] = newSymNode(m) + n[0] = newSymNode(m) addDecl(c, m, n.info) # add symbol to symbol table of module - for i in countup(1, sonsLen(n) - 1): - if n.sons[i].kind != nkNilLit: - importSymbol(c, n.sons[i], m) + + var im = ImportedModule(m: m, mode: importSet, imported: initIntSet()) + for i in 1..<n.len: + 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) - var m = myImportModule(c, n.sons[0], result) + var m = myImportModule(c, n[0], result) if m != nil: - n.sons[0] = newSymNode(m) + 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) + #importForwarded(c, m.ast, exceptSet, m) + afterImport(c, m) diff --git a/compiler/incremental.nim b/compiler/incremental.nim deleted file mode 100644 index 2008d35de..000000000 --- a/compiler/incremental.nim +++ /dev/null @@ -1,196 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2018 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Basic type definitions the module graph needs in order to support -## incremental compilations. - -const nimIncremental* = defined(nimIncremental) - -import options, lineinfos - -when nimIncremental: - import ast, msgs, intsets, btrees, db_sqlite, std / sha1 - from strutils import parseInt - - type - Writer* = object - sstack*: seq[PSym] # a stack of symbols to process - tstack*: seq[PType] # a stack of types to process - tmarks*, smarks*: IntSet - forwardedSyms*: seq[PSym] - - Reader* = object - syms*: BTree[int, PSym] - types*: BTree[int, PType] - - IncrementalCtx* = object - db*: DbConn - w*: Writer - r*: Reader - configChanged*: bool - - proc init*(incr: var IncrementalCtx) = - incr.w.sstack = @[] - incr.w.tstack = @[] - incr.w.tmarks = initIntSet() - incr.w.smarks = initIntSet() - incr.w.forwardedSyms = @[] - incr.r.syms = initBTree[int, PSym]() - incr.r.types = initBTree[int, PType]() - - - proc hashFileCached*(conf: ConfigRef; fileIdx: FileIndex; fullpath: string): string = - result = msgs.getHash(conf, fileIdx) - if result.len == 0: - result = $secureHashFile(fullpath) - msgs.setHash(conf, fileIdx, result) - - proc toDbFileId*(incr: var IncrementalCtx; conf: ConfigRef; fileIdx: FileIndex): int = - if fileIdx == FileIndex(-1): return -1 - let fullpath = toFullPath(conf, fileIdx) - let row = incr.db.getRow(sql"select id, fullhash from filenames where fullpath = ?", - fullpath) - let id = row[0] - let fullhash = hashFileCached(conf, fileIdx, fullpath) - if id.len == 0: - result = int incr.db.insertID(sql"insert into filenames(fullpath, fullhash) values (?, ?)", - fullpath, fullhash) - else: - if row[1] != fullhash: - incr.db.exec(sql"update filenames set fullhash = ? where fullpath = ?", fullhash, fullpath) - result = parseInt(id) - - proc fromDbFileId*(incr: var IncrementalCtx; conf: ConfigRef; dbId: int): FileIndex = - if dbId == -1: return FileIndex(-1) - let fullpath = incr.db.getValue(sql"select fullpath from filenames where id = ?", dbId) - doAssert fullpath.len > 0, "cannot find file name for DB ID " & $dbId - result = fileInfoIdx(conf, fullpath) - - - proc addModuleDep*(incr: var IncrementalCtx; conf: ConfigRef; - module, fileIdx: FileIndex; - isIncludeFile: bool) = - if conf.symbolFiles != v2Sf: return - - let a = toDbFileId(incr, conf, module) - let b = toDbFileId(incr, conf, fileIdx) - - incr.db.exec(sql"insert into deps(module, dependency, isIncludeFile) values (?, ?, ?)", - a, b, ord(isIncludeFile)) - - # --------------- Database model --------------------------------------------- - - proc createDb*(db: DbConn) = - db.exec(sql""" - create table if not exists controlblock( - idgen integer not null - ); - """) - - db.exec(sql""" - create table if not exists config( - config varchar(8000) not null - ); - """) - - db.exec(sql""" - create table if not exists filenames( - id integer primary key, - fullpath varchar(8000) not null, - fullHash varchar(256) not null - ); - """) - db.exec sql"create index if not exists FilenameIx on filenames(fullpath);" - - db.exec(sql""" - create table if not exists modules( - id integer primary key, - nimid integer not null, - fullpath varchar(8000) not null, - interfHash varchar(256) not null, - fullHash varchar(256) not null, - - created timestamp not null default (DATETIME('now')) - );""") - db.exec(sql"""create unique index if not exists SymNameIx on modules(fullpath);""") - - db.exec(sql""" - create table if not exists deps( - id integer primary key, - module integer not null, - dependency integer not null, - isIncludeFile integer not null, - foreign key (module) references filenames(id), - foreign key (dependency) references filenames(id) - );""") - db.exec(sql"""create index if not exists DepsIx on deps(module);""") - - db.exec(sql""" - create table if not exists types( - id integer primary key, - nimid integer not null, - module integer not null, - data blob not null, - foreign key (module) references module(id) - ); - """) - db.exec sql"create index TypeByModuleIdx on types(module);" - db.exec sql"create index TypeByNimIdIdx on types(nimid);" - - db.exec(sql""" - create table if not exists syms( - id integer primary key, - nimid integer not null, - module integer not null, - name varchar(256) not null, - data blob not null, - exported int not null, - foreign key (module) references module(id) - ); - """) - db.exec sql"create index if not exists SymNameIx on syms(name);" - db.exec sql"create index SymByNameAndModuleIdx on syms(name, module);" - db.exec sql"create index SymByModuleIdx on syms(module);" - db.exec sql"create index SymByNimIdIdx on syms(nimid);" - - - db.exec(sql""" - create table if not exists toplevelstmts( - id integer primary key, - position integer not null, - module integer not null, - data blob not null, - foreign key (module) references module(id) - ); - """) - db.exec sql"create index TopLevelStmtByModuleIdx on toplevelstmts(module);" - db.exec sql"create index TopLevelStmtByPositionIdx on toplevelstmts(position);" - - db.exec(sql""" - create table if not exists statics( - id integer primary key, - module integer not null, - data blob not null, - foreign key (module) references module(id) - ); - """) - db.exec sql"create index StaticsByModuleIdx on toplevelstmts(module);" - db.exec sql"insert into controlblock(idgen) values (0)" - - -else: - type - IncrementalCtx* = object - - template init*(incr: IncrementalCtx) = discard - - template addModuleDep*(incr: var IncrementalCtx; conf: ConfigRef; - module, fileIdx: FileIndex; - isIncludeFile: bool) = - discard diff --git a/compiler/index.nim b/compiler/index.nim new file mode 100644 index 000000000..2c2a34fb5 --- /dev/null +++ b/compiler/index.nim @@ -0,0 +1,18 @@ +##[ +This module only exists to generate docs for the compiler. + +## links +* [main docs](../lib.html) +* [compiler user guide](../nimc.html) +* [Internals of the Nim Compiler](../intern.html) +]## + +#[ +note: this is named `index` so that navigating to https://nim-lang.github.io/Nim/compiler/ +will work. + +xxx this should also import other modules, not transitively imported by `compiler/nim.nim`, +eg `evalffi`, otherwise these aren't shown. A glob could be used at CT. +]# + +import nim diff --git a/compiler/injectdestructors.nim b/compiler/injectdestructors.nim new file mode 100644 index 000000000..3dcc364a3 --- /dev/null +++ b/compiler/injectdestructors.nim @@ -0,0 +1,1284 @@ +# +# +# The Nim Compiler +# (c) Copyright 2017 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Injects destructor calls into Nim code as well as +## an optimizer that optimizes copies to moves. This is implemented as an +## AST to AST transformation so that every backend benefits from it. + +## See doc/destructors.rst for a spec of the implemented rewrite rules + +import + ast, astalgo, msgs, renderer, magicsys, types, idents, + options, lowerings, modulegraphs, + lineinfos, parampatterns, sighashes, liftdestructors, optimizer, + varpartitions, aliasanalysis, dfa, wordrecg + +import std/[strtabs, tables, strutils, intsets] + +when defined(nimPreviewSlimSystem): + import std/assertions + +from trees import exprStructuralEquivalent, getRoot, whichPragma + +type + Con = object + owner: PSym + when true: + g: ControlFlowGraph + graph: ModuleGraph + inLoop, inSpawn, inLoopCond: int + uninit: IntSet # set of uninit'ed vars + 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 + # (try: statements; dest = y(); finally: destructors(); dest) + vars: seq[PSym] + wasMoved: seq[PNode] + final: seq[PNode] # finally section + locals: seq[PSym] + body: PNode + needsTry: bool + parent: ptr Scope + + ProcessMode = enum + normal + consumed + 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, gcAtomicArc}: + assert(not containsGarbageCollectedRef(t)) + +proc getTemp(c: var Con; s: var Scope; typ: PType; info: TLineInfo): PNode = + 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; 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] + +proc isLastReadImpl(n: PNode; c: var Con; scope: var Scope): bool = + let root = parampatterns.exprRoot(n, allowCalls=false) + if root == nil: return false + + var s = addr(scope) + while s != nil: + if s.locals.contains(root): break + s = s.parent + + 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 = skipConvDfa(n) + result = nfFirstWrite in m.flags + +proc isCursor(n: PNode): bool = + case n.kind + of nkSym: + sfCursor in n.sym.flags + of nkDotExpr: + isCursor(n[1]) + of nkCheckedFieldExpr: + isCursor(n[0]) + else: + false + +template isUnpackedTuple(n: PNode): bool = + ## we move out all elements of unpacked tuples, + ## hence unpacked tuples themselves don't need to be destroyed + ## 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) + +proc checkForErrorPragma(c: Con; t: PType; ri: PNode; opname: string; inferredFromCopy = false) = + var m = "'" & opname & "' is not available for type <" & typeToString(t) & ">" + 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 c.otherUsage != unknownLineInfo: + # ri.comment.startsWith('\n'): + m.add "; another read is done here: " + 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, c.idgen, c.owner) + addSonSkipIntLit(result, baseType, c.idgen) + +proc genOp(c: var Con; op: PSym; dest: PNode): PNode = + 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, c.graph.config, {CoType, CoConsiderOwned, CoDistinct}) + let canon = c.graph.canonTypes.getOrDefault(h) + if canon != nil: + op = getAttachedOp(c.graph, canon, kind) + if op == nil: + #echo dest.typ.id + globalError(c.graph.config, dest.info, "internal error: '" & AttachedOpToStr[kind] & + "' operator not found for type " & typeToString(t)) + elif op.ast.isGenericRoutine: + globalError(c.graph.config, dest.info, "internal error: '" & AttachedOpToStr[kind] & + "' operator is generic") + dbg: + if kind == attachedDestructor: + echo "destructor is ", op.id, " ", op.ast + if sfError in op.flags: checkForErrorPragma(c, t, ri, AttachedOpToStr[kind]) + c.genOp(op, dest) + +proc genDestroy(c: var Con; dest: PNode): PNode = + let t = dest.typ.skipTypes({tyGenericInst, tyAlias, tySink}) + result = c.genOp(t, attachedDestructor, dest, nil) + +proc canBeMoved(c: Con; t: PType): bool {.inline.} = + let t = t.skipTypes({tyGenericInst, tyAlias, tySink}) + if optOwnedRefs in c.graph.config.globalOptions: + result = t.kind != tyRef and getAttachedOp(c.graph, t, attachedSink) != nil + else: + result = getAttachedOp(c.graph, t, attachedSink) != nil + +proc isNoInit(dest: PNode): bool {.inline.} = + result = dest.kind == nkSym and sfNoInit in dest.sym.flags + +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) or IsReturn in flags: + # optimize sink call into a bitwise memcopy + result = newTree(nkFastAsgn, dest, ri) + else: + let t = dest.typ.skipTypes({tyGenericInst, tyAlias, tySink}) + if getAttachedOp(c.graph, t, attachedSink) != nil: + result = c.genOp(t, attachedSink, dest, ri) + result.add ri + else: + # the default is to use combination of `=destroy(dest)` and + # and copyMem(dest, source). This is efficient. + 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 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. + + These constructs cannot possibly create cycles:: + + local = ... + + new(x) + dest = ObjectConstructor(field: noalias(dest)) + + But since 'ObjectConstructor' is already moved into 'dest' all we really have + to look for is assignments to local variables. + ]# + result = dest.kind != nkSym + +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(c.graph, t): + if t.kind == tyRef: + result.add callCodegenProc(c.graph, "nimMarkCyclic", dest.info, dest) + else: + let xenv = genBuiltin(c.graph, c.idgen, mAccessEnv, "accessEnv", dest) + xenv.typ = getSysType(c.graph, dest.info, tyPointer) + result.add callCodegenProc(c.graph, "nimMarkCyclic", dest.info, xenv) + +proc genCopyNoCheck(c: var Con; dest, ri: PNode; a: TTypeAttachedOp): PNode = + let t = dest.typ.skipTypes({tyGenericInst, tyAlias, tySink}) + result = c.genOp(t, a, dest, ri) + assert ri.typ != nil + +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: + 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 + # but fields within active case branch might need destruction + + # tmp to support self assignments + let tmp = c.getTemp(s, n[1].typ, n.info) + + result = newTree(nkStmtList) + result.add newTree(nkFastAsgn, tmp, p(n[1], c, s, consumed)) + result.add p(n[0], c, s, normal) + + let le = p(n[0], c, s, normal) + let leDotExpr = if le.kind == nkCheckedFieldExpr: le[0] else: le + let objType = leDotExpr[0].typ + + if hasDestructor(c, objType): + if getAttachedOp(c.graph, objType, attachedDestructor) != nil and + 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) + 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 = + 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) + result.add(newSymNode(createMagic(c.graph, c.idgen, "default", mDefault))) + result.typ = t + +proc destructiveMoveVar(n: PNode; c: var Con; s: var Scope): PNode = + # generate: (let tmp = v; reset(v); tmp) + if (not hasDestructor(c, n.typ)) and c.inEnsureMove == 0: + assert n.kind != nkSym or not hasDestructor(c, n.sym.typ) 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"), c.idgen, c.owner, n.info) + temp.typ = n.typ + var v = newNodeI(nkLetSection, n.info) + let tempAsNode = newSymNode(temp) + + var vpart = newNodeI(nkIdentDefs, tempAsNode.info, 3) + vpart[0] = tempAsNode + vpart[1] = newNodeI(nkEmpty, tempAsNode.info) + vpart[2] = n + v.add(vpart) + + result.add v + let nn = skipConv(n) + if hasDestructor(c, n.typ): + c.genMarkCyclic(result, nn) + let wasMovedCall = c.genWasMoved(nn) + result.add wasMovedCall + result.add tempAsNode + +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 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, 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 + # no need to destroy it. + result.add tmp + +proc isDangerousSeq(t: PType): bool {.inline.} = + let t = t.skipTypes(abstractInst) + 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, nkCast: + result = containsConstSeq(n[1]) + of nkObjConstr, nkClosure: + for i in 1..<n.len: + if containsConstSeq(n[i]): return true + of nkCurly, nkBracket, nkPar, nkTupleConstr: + for son in n: + if containsConstSeq(son): return true + else: discard + +proc ensureDestruction(arg, orig: PNode; c: var Con; s: var Scope): PNode = + # it can happen that we need to destroy expression contructors + # like [], (), closures explicitly in order to not leak them. + if arg.typ != nil and hasDestructor(c, arg.typ): + # produce temp creation for (fn, env). But we need to move 'env'? + # 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(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 notin {gcArc, gcAtomicArc}: return + var value = n[1] + if value.kind == nkClosure: + value = value[1] + if value.kind == nkNilLit: return + let destTyp = n[0].typ.skipTypes(abstractInst) + if destTyp.kind != tyRef and not (destTyp.kind == tyProc and destTyp.callConv == ccClosure): + return + + var x = n[0] + var field: PNode = nil + while true: + if x.kind == nkDotExpr: + field = x[1] + if field.kind == nkSym and sfCursor in field.sym.flags: return + x = x[0] + elif x.kind in {nkBracketExpr, nkCheckedFieldExpr, nkDerefExpr, nkHiddenDeref}: + x = x[0] + else: + break + if exprStructuralEquivalent(x, value, strictSymEquality = true): + let msg = + if field != nil: + "'$#' creates an uncollectable ref cycle; annotate '$#' with .cursor" % [$n, $field] + else: + "'$#' creates an uncollectable ref cycle" % [$n] + message(c.graph.config, n.info, warnCycleCreated, msg) + break + +proc pVarTopLevel(v: PNode; c: var Con; s: var Scope; res: PNode) = + # move the variable declaration to the top of the frame: + s.vars.add v.sym + if isUnpackedTuple(v): + if c.inLoop > 0: + # unpacked tuple needs reset at every loop iteration + 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, 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) + +proc processScope(c: var Con; s: var Scope; ret: PNode): PNode = + result = newNodeI(nkStmtList, ret.info) + if s.vars.len > 0: + let varSection = newNodeI(nkVarSection, ret.info) + for tmp in s.vars: + varSection.add newTree(nkIdentDefs, newSymNode(tmp), newNodeI(nkEmpty, ret.info), + newNodeI(nkEmpty, ret.info)) + result.add varSection + if s.wasMoved.len > 0 or s.final.len > 0: + let finSection = newNodeI(nkStmtList, ret.info) + for m in s.wasMoved: finSection.add m + for i in countdown(s.final.high, 0): finSection.add s.final[i] + if s.needsTry: + result.add newTryFinally(ret, finSection) + else: + result.add ret + result.add finSection + else: + result.add ret + + 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, tmpFlags: TSymFlags): PNode = + assert not ret.typ.isEmptyType + 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 = 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)) + + if s.vars.len > 0: + let varSection = newNodeI(nkVarSection, ret.info) + for tmp in s.vars: + varSection.add newTree(nkIdentDefs, newSymNode(tmp), newNodeI(nkEmpty, ret.info), + newNodeI(nkEmpty, ret.info)) + result.add varSection + let finSection = newNodeI(nkStmtList, ret.info) + for m in s.wasMoved: finSection.add m + for i in countdown(s.final.high, 0): finSection.add s.final[i] + if s.needsTry: + result.add newTryFinally(newTree(nkStmtListExpr, cpy, processCall(tmp, s.parent[])), finSection) + else: + result.add cpy + result.add finSection + result.add processCall(tmp, s.parent[]) + + if s.parent != nil: s.parent[].needsTry = s.parent[].needsTry or s.needsTry + + result + +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) + + case n.kind + of nkStmtList, nkStmtListExpr: + # a statement list does not open a new scope + if n.len == 0: return n + result = copyNode(n) + for i in 0..<n.len-1: + result.add p(n[i], c, s, normal) + result.add maybeVoid(n[^1], s) + + of nkCaseStmt: + result = copyNode(n) + result.add p(n[0], c, s, normal) + for i in 1..<n.len: + let it = n[i] + assert it.kind in {nkOfBranch, nkElse} + + var branch = shallowCopy(it) + for j in 0 ..< it.len-1: + branch[j] = copyTree(it[j]) + 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, tmpFlags) + result.add branch + + of nkWhileStmt: + inc c.inLoop + inc c.inLoopCond + result = copyNode(n) + result.add p(n[0], c, s, normal) + dec c.inLoopCond + var bodyScope = nestedScope(s, n[1]) + let bodyResult = p(n[1], c, bodyScope, normal) + result.add processScope(c, bodyScope, bodyResult) + dec c.inLoop + + of nkParForStmt: + inc c.inLoop + result = shallowCopy(n) + let last = n.len-1 + for i in 0..<last-1: + result[i] = n[i] + result[last-1] = p(n[last-1], c, s, normal) + var bodyScope = nestedScope(s, n[1]) + let bodyResult = p(n[last], c, bodyScope, normal) + result[last] = processScope(c, bodyScope, bodyResult) + dec c.inLoop + + of nkBlockStmt, nkBlockExpr: + result = copyNode(n) + result.add n[0] + 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, 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, 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 n.typ.isEmptyType or it[^1].typ.isEmptyType or willProduceStmt: + processScope(c, branchScope, maybeVoid(it[^1], branchScope)) + else: + processScopeExpr(c, branchScope, it[^1], processCall, tmpFlags) + result.add branch + + of nkTryStmt: + result = copyNode(n) + 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, tmpFlags) + + for i in 1..<n.len: + let it = n[i] + var branch = copyTree(it) + 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, tmpFlags) + result.add branch + + of nkWhen: # This should be a "when nimvm" node. + result = copyTree(n) + result[1][0] = processCall(n[1][0], s) + + 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: + if n[0].kind in nkCallKinds: + let call = p(n[0], c, s, normal) + result = copyNode(n) + result.add call + else: + let tmp = c.getTemp(s, n[0].typ, n.info) + var m = c.genCopyNoCheck(tmp, n[0], attachedAsgn) + m.add p(n[0], c, s, normal) + c.finishCopy(m, n[0], {}, isFromSink = false) + result = newTree(nkStmtList, c.genWasMoved(tmp), m) + var toDisarm = n[0] + if toDisarm.kind == nkStmtListExpr: toDisarm = toDisarm.lastSon + if toDisarm.kind == nkSym and toDisarm.sym.owner == c.owner: + result.add c.genWasMoved(toDisarm) + result.add newTree(nkRaiseStmt, tmp) + else: + result = copyNode(n) + if n[0].kind != nkEmpty: + result.add p(n[0], c, s, sinkArg) + else: + result.add copyNode(n[0]) + s.needsTry = true + +template isCustomDestructor(c: Con, t: PType): bool = + hasDestructor(c, t) and + getAttachedOp(c.graph, t, attachedDestructor) != nil and + sfOverridden in getAttachedOp(c.graph, t, attachedDestructor).flags + +proc hasCustomDestructor(c: Con, t: PType): bool = + result = isCustomDestructor(c, t) + var obj = t + while obj.baseClass != nil: + obj = skipTypes(obj.baseClass, abstractPtrs) + result = result or isCustomDestructor(c, obj) + +proc p(n: PNode; c: var Con; s: var Scope; mode: ProcessMode; tmpFlags = {sfSingleUsedTemp}; inReturn = false): PNode = + if n.kind in {nkStmtList, nkStmtListExpr, nkBlockStmt, nkBlockExpr, nkIfStmt, + nkIfExpr, nkCaseStmt, nkWhen, nkWhileStmt, nkParForStmt, nkTryStmt, nkPragmaBlock}: + template process(child, s): untyped = p(child, c, s, mode) + 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 + # sink parameter (bug #11524). Note that the string implementation is + # different and can deal with 'const string sunk into var'. + result = passCopyToSink(n, c, s) + elif n.kind in {nkBracket, nkObjConstr, nkTupleConstr, nkClosure, nkNilLit} + + nkCallKinds + nkLiterals: + 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, 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) + elif n.kind in {nkHiddenSubConv, nkHiddenStdConv, nkConv}: + result = copyTree(n) + if n.typ.skipTypes(abstractInst-{tyOwned}).kind != tyOwned and + n[1].typ.skipTypes(abstractInst-{tyOwned}).kind == tyOwned: + # allow conversions from owned to unowned via this little hack: + let nTyp = n[1].typ + n[1].typ = n.typ + result[1] = p(n[1], c, s, sinkArg) + result[1].typ = nTyp + else: + result[1] = p(n[1], c, s, sinkArg) + 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) + else: + # copy objects that are not temporary but passed to a 'sink' parameter + result = passCopyToSink(n, c, s) + else: + case n.kind + 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). + # If it doesn't own the data, it's harmful to destroy it (double frees etc). + # We have the freedom to choose whether it owns it or not so we are smart about it + # and we say, "if passed to a sink we demand C(x) to own its data" + # otherwise we say "C(x) is just some temporary storage, it doesn't own anything, + # 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 m = if mode == normal: normal + else: sinkArg + + result = copyTree(n) + 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: + result[i][0] = p(n[i][0], c, s, m) + result[i][1] = p(n[i][1], c, s, m) + else: + result[i] = p(n[i], c, s, m) + 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 + + # 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 + if n[0].kind == nkSym and n[0].sym.magic in {mOr, mAnd}: + inc c.inDangerousBranch + isDangerous = true + + result = shallowCopy(n) + for i in 1..<n.len: + if i < L and isCompileTimeOnly(parameters[i]): + result[i] = n[i] + elif i < L and (isSinkTypeForParam(parameters[i]) or inSpawn > 0): + result[i] = p(n[i], c, s, sinkArg) + else: + result[i] = p(n[i], c, s, normal) + + when false: + if isDangerous: + dec c.inDangerousBranch + + 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, 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: + 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: + result[0] = p(n[0], c, s, normal) + else: + result[0] = copyNode(n[0]) + of nkVarSection, nkLetSection: + # transform; var x = y to var x; x op y where op is a move or copy + result = newNodeI(nkStmtList, n.info) + 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, skipPragmaExpr(it[0]).typ): + for j in 0..<it.len-2: + 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, if v.kind == nkSym: {IsDecl} else: {}) + elif ri.kind == nkEmpty and c.inLoop > 0: + 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] + 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, 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, 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: + result = copyNode(n) + result.add p(n[0], c, s, mode) + result.add p(n[1], c, s, consumed) + of nkRaiseStmt: + result = pRaiseStmt(n, c, s) + of nkWhileStmt: + internalError(c.graph.config, n.info, "nkWhileStmt should have been handled earlier") + result = n + of nkNone..nkNilLit, nkTypeSection, nkProcDef, nkConverterDef, + nkMethodDef, nkIteratorDef, nkMacroDef, nkTemplateDef, nkLambda, nkDo, + nkFuncDef, nkConstSection, nkConstDef, nkIncludeStmt, nkImportStmt, + nkExportStmt, nkPragma, nkCommentStmt, nkBreakState, + nkTypeOfExpr, nkMixinStmt, nkBindStmt: + result = n + + of nkStringToCString, nkCStringToString, nkChckRangeF, nkChckRange64, nkChckRange: + result = shallowCopy(n) + for i in 0 ..< n.len: + result[i] = p(n[i], c, s, normal) + if n.typ != nil and hasDestructor(c, n.typ): + if mode == normal: + result = ensureDestruction(result, n, c, s) + + of nkHiddenSubConv, nkHiddenStdConv, nkConv: + # we have an "ownership invariance" for all constructors C(x). + # See the comment for nkBracket construction. If the caller wants + # to own 'C(x)', it really wants to own 'x' too. If it doesn't, + # we need to destroy 'x' but the function call handling ensures that + # already. + result = copyTree(n) + if n.typ.skipTypes(abstractInst-{tyOwned}).kind != tyOwned and + n[1].typ.skipTypes(abstractInst-{tyOwned}).kind == tyOwned: + # allow conversions from owned to unowned via this little hack: + let nTyp = n[1].typ + n[1].typ = n.typ + result[1] = p(n[1], c, s, mode) + result[1].typ = nTyp + else: + result[1] = p(n[1], c, s, mode) + + of nkObjDownConv, nkObjUpConv: + result = copyTree(n) + result[0] = p(n[0], c, s, mode) + + of nkDotExpr: + result = shallowCopy(n) + result[0] = p(n[0], c, s, normal) + 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, s): + s.wasMoved.add c.genWasMoved(n) + else: + result = passCopyToSink(result, c, s) + + of nkBracketExpr, nkAddr, nkHiddenAddr, nkDerefExpr, nkHiddenDeref: + result = shallowCopy(n) + 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, 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)': + s.wasMoved.add c.genWasMoved(n) + else: + result = passCopyToSink(result, c, s) + + of nkDefer, nkRange: + result = shallowCopy(n) + for i in 0 ..< n.len: + result[i] = p(n[i], c, s, normal) + + of nkBreakStmt: + s.needsTry = true + result = n + of nkReturnStmt: + result = shallowCopy(n) + for i in 0..<n.len: + result[i] = p(n[i], c, s, mode, inReturn=true) + s.needsTry = true + of nkCast: + result = shallowCopy(n) + result[0] = n[0] + result[1] = p(n[1], c, s, mode) + of nkCheckedFieldExpr: + result = shallowCopy(n) + result[0] = p(n[0], c, s, mode) + for i in 1..<n.len: + result[i] = n[i] + 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 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: + if a.kind == b.kind: + case a.kind + of nkSym: a.sym == b.sym + of nkDotExpr, nkCheckedFieldExpr: sameLocation(a[0], b[0]) and sameLocation(a[1], b[1]) + of nkBracketExpr: sameLocation(a[0], b[0]) and sameConstant(a[1], b[1]) + else: false + else: false + else: + case a.kind + of nkSym, nkDotExpr, nkCheckedFieldExpr, nkBracketExpr: + # Reached an endpoint, flip to recurse the other side. + sameLocation(b, a) + of nkAddr, nkHiddenAddr, nkDerefExpr, nkHiddenDeref: + # We don't need to check addr/deref levels or differentiate between the two, + # since pointers don't have hooks :) (e.g: var p: ptr pointer; p[] = addr p) + sameLocation(a[0], b) + of nkObjDownConv, nkObjUpConv: sameLocation(a[0], b) + of nkHiddenStdConv, nkHiddenSubConv: sameLocation(a[1], b) + else: false + +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) 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, 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: + let ri2 = if ri.kind == nkWhen: ri[1][0] else: ri + case ri2.kind + of nkCallKinds: + 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(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) + 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(s, dest, destructiveMoveVar(ri, c, s), flags) + else: + 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, flags, isFromSink = false) + of nkBracket: + # array constructor + if ri.len > 0 and isDangerousSeq(ri.typ): + 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, flags, isFromSink = false) + else: + result = c.genSink(s, dest, p(ri, c, s, consumed), flags) + of nkObjConstr, nkTupleConstr, nkClosure, nkCharLit..nkNilLit: + result = c.genSink(s, dest, p(ri, c, s, consumed), flags) + of nkSym: + if isSinkParam(ri.sym) and isLastRead(ri, c, s): + # Rule 3: `=sink`(x, z); wasMoved(z) + let snk = c.genSink(s, dest, ri, flags) + result = newTree(nkStmtList, snk, c.genWasMoved(ri)) + elif ri.sym.kind != skParam and + isAnalysableFieldAccess(ri, c.owner) and + isLastRead(ri, c, s) and canBeMoved(c, dest.typ): + # Rule 3: `=sink`(x, z); wasMoved(z) + let snk = c.genSink(s, dest, ri, flags) + result = newTree(nkStmtList, snk, c.genWasMoved(ri)) + else: + 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, 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, 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, s) and + canBeMoved(c, dest.typ): + # Rule 3: `=sink`(x, z); wasMoved(z) + let snk = c.genSink(s, dest, ri, flags) + result = newTree(nkStmtList, snk, c.genWasMoved(ri)) + else: + 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, flags, isFromSink = false) + +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 = 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, idgen: idgen, body: n, otherUsage: unknownLineInfo) + + if optCursorInference in g.config.options: + computeCursors(owner, n, g) + + var scope = Scope(body: n) + let body = p(n, c, scope, normal) + + if owner.kind in {skProc, skFunc, skMethod, skIterator, skConverter}: + let params = owner.typ.n + for i in 1..<params.len: + let t = params[i].sym.typ + if isSinkTypeForParam(t) and hasDestructor(c, t.skipTypes({tySink})): + scope.final.add c.genDestroy(params[i]) + #if optNimV2 in c.graph.config.globalOptions: + # injectDefaultCalls(n, c) + result = optimize processScope(c, scope, body) + dbg: + echo ">---------transformed-to--------->" + echo renderTree(result, {renderIds}) + + if g.config.arcToExpand.hasKey(owner.name.s): + echo "--expandArc: ", owner.name.s + echo renderTree(result, {renderIr, renderNoComments}) + echo "-- end of expandArc ------------------------" diff --git a/compiler/installer.ini b/compiler/installer.ini index 2847e4e62..54a35dbee 100644 --- a/compiler/installer.ini +++ b/compiler/installer.ini @@ -6,15 +6,17 @@ Name: "Nim" Version: "$version" Platforms: """ windows: i386;amd64 - linux: i386;amd64;powerpc64;arm;sparc;mips;mipsel;mips64;mips64el;powerpc;powerpc64el;arm64;riscv64 - macosx: i386;amd64;powerpc64 + 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 - netbsd: i386;amd64 - openbsd: i386;amd64 + freebsd: i386;amd64;powerpc64;arm;arm64;riscv64;sparc64;mips;mipsel;mips64;mips64el;powerpc;powerpc64el + netbsd: i386;amd64;arm64 + openbsd: i386;amd64;arm;arm64 dragonfly: i386;amd64 + crossos: amd64 haiku: i386;amd64 android: i386;arm;arm64 + nintendoswitch: arm64 """ Authors: "Andreas Rumpf" @@ -34,9 +36,8 @@ App: Console License: "copying.txt" [Config] -Files: "config/nim.cfg" -Files: "config/nimdoc.cfg" -Files: "config/nimdoc.tex.cfg" +Files: "config/*.cfg" +Files: "config/config.nims" [Documentation] ; Files: "doc/*.html" @@ -48,11 +49,8 @@ Start: "doc/html/overview.html" [Other] -Files: "readme.txt;copying.txt;install.txt" -Files: "makefile" +Files: "copying.txt" Files: "koch.nim" -Files: "install_nimble.nims" -Files: "install_tools.nims" Files: "icons/nim.ico" Files: "icons/nim.rc" @@ -67,16 +65,13 @@ Files: "compiler" Files: "doc" Files: "doc/html" Files: "tools" +Files: "tools/debug/nim-gdb.py" +Files: "nimpretty" +Files: "testament" Files: "nimsuggest" Files: "nimsuggest/tests/*.nim" -Files: "web/website.ini" -Files: "web/ticker.html" -Files: "web/*.nim" -Files: "web/*.rst" -Files: "web/*.csv" -Files: "web/news/*.rst" -Files: "bin/nimblepkg/*.nim" -Files: "bin/nimblepkg/*.cfg" +Files: "changelogs/*.md" +Files: "ci/funs.sh" [Lib] Files: "lib" @@ -84,18 +79,21 @@ Files: "lib" [Other] Files: "examples" Files: "dist/nimble" -Files: "dist/nimsuggest" +Files: "dist/checksums" Files: "tests" [Windows] Files: "bin/nim.exe" -Files: "bin/c2nim.exe" Files: "bin/nimgrep.exe" Files: "bin/nimsuggest.exe" Files: "bin/nimble.exe" Files: "bin/vccexe.exe" 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" @@ -113,9 +111,10 @@ Download: r"Aporia Text Editor|dist|aporia.zip|97997|https://nim-lang.org/downlo ; for now only NSIS supports optional downloads [WinBin] -Files: "$NIMINSTDEPS/makelink.exe" -Files: "$NIMINSTDEPS/7zG.exe" -Files: "$NIMINSTDEPS/*.dll" +Files: "bin/makelink.exe" +Files: "bin/7zG.exe" +Files: "bin/*.dll" +Files: "bin/cacert.pem" [UnixBin] Files: "bin/nim" @@ -124,6 +123,8 @@ Files: "bin/nim" [Unix] InstallScript: "yes" UninstallScript: "yes" +Files: "bin/nim-gdb" +Files: "build_all.sh" [InnoSetup] @@ -145,5 +146,5 @@ shortDesc: "The Nim Compiler" licenses: "bin/nim,MIT;lib/*,MIT;" [nimble] -pkgName: "compiler" -pkgFiles: "compiler/*;doc/basicopt.txt;doc/advopt.txt" +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 new file mode 100644 index 000000000..74e581cd5 --- /dev/null +++ b/compiler/int128.nim @@ -0,0 +1,592 @@ +## This module is for compiler internal use only. For reliable error +## messages and range checks, the compiler needs a data type that can +## hold all from `low(BiggestInt)` to `high(BiggestUInt)`, This +## type is for that purpose. + +from std/math import trunc + +when defined(nimPreviewSlimSystem): + import std/assertions + +type + Int128* = object + udata: array[4, uint32] + +template sdata(arg: Int128, idx: int): int32 = + # udata and sdata was supposed to be in a union, but unions are + # handled incorrectly in the VM. + cast[ptr int32](arg.udata[idx].unsafeAddr)[] + +# encoding least significant int first (like LittleEndian) + +const + Zero* = Int128(udata: [0'u32, 0, 0, 0]) + One* = Int128(udata: [1'u32, 0, 0, 0]) + Ten* = Int128(udata: [10'u32, 0, 0, 0]) + Min = Int128(udata: [0'u32, 0, 0, 0x80000000'u32]) + Max = Int128(udata: [high(uint32), high(uint32), high(uint32), uint32(high(int32))]) + NegOne* = Int128(udata: [0xffffffff'u32, 0xffffffff'u32, 0xffffffff'u32, 0xffffffff'u32]) + +template low*(t: typedesc[Int128]): Int128 = Min +template high*(t: typedesc[Int128]): Int128 = Max + +proc `$`*(a: Int128): string + +proc toInt128*[T: SomeInteger | bool](arg: T): Int128 = + {.noSideEffect.}: + result = Zero + when T is bool: result.sdata(0) = int32(arg) + elif T is SomeUnsignedInt: + when sizeof(arg) <= 4: + 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: + 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 + +proc bitconcat(a, b: uint32): uint64 = + (uint64(a) shl 32) or uint64(b) + +proc toInt64*(arg: Int128): int64 = + if isNegative(arg): + assert(arg.sdata(3) == -1, "out of range") + assert(arg.sdata(2) == -1, "out of range") + else: + assert(arg.sdata(3) == 0, "out of range") + assert(arg.sdata(2) == 0, "out of range") + + cast[int64](bitconcat(arg.udata[1], arg.udata[0])) + +proc toInt64Checked*(arg: Int128; onError: int64): int64 = + if isNegative(arg): + if arg.sdata(3) != -1 or arg.sdata(2) != -1: + return onError + else: + if arg.sdata(3) != 0 or arg.sdata(2) != 0: + return onError + return cast[int64](bitconcat(arg.udata[1], arg.udata[0])) + +proc toInt32*(arg: Int128): int32 = + if isNegative(arg): + assert(arg.sdata(3) == -1, "out of range") + assert(arg.sdata(2) == -1, "out of range") + assert(arg.sdata(1) == -1, "out of range") + else: + assert(arg.sdata(3) == 0, "out of range") + assert(arg.sdata(2) == 0, "out of range") + assert(arg.sdata(1) == 0, "out of range") + + arg.sdata(0) + +proc toInt16*(arg: Int128): int16 = + if isNegative(arg): + assert(arg.sdata(3) == -1, "out of range") + assert(arg.sdata(2) == -1, "out of range") + assert(arg.sdata(1) == -1, "out of range") + else: + assert(arg.sdata(3) == 0, "out of range") + assert(arg.sdata(2) == 0, "out of range") + assert(arg.sdata(1) == 0, "out of range") + + int16(arg.sdata(0)) + +proc toInt8*(arg: Int128): int8 = + if isNegative(arg): + assert(arg.sdata(3) == -1, "out of range") + assert(arg.sdata(2) == -1, "out of range") + assert(arg.sdata(1) == -1, "out of range") + else: + assert(arg.sdata(3) == 0, "out of range") + assert(arg.sdata(2) == 0, "out of range") + assert(arg.sdata(1) == 0, "out of range") + + int8(arg.sdata(0)) + +proc toInt*(arg: Int128): int = + when sizeof(int) == 4: + cast[int](toInt32(arg)) + else: + cast[int](toInt64(arg)) + +proc toUInt64*(arg: Int128): uint64 = + assert(arg.udata[3] == 0) + assert(arg.udata[2] == 0) + bitconcat(arg.udata[1], arg.udata[0]) + +proc toUInt32*(arg: Int128): uint32 = + assert(arg.udata[3] == 0) + assert(arg.udata[2] == 0) + assert(arg.udata[1] == 0) + arg.udata[0] + +proc toUInt16*(arg: Int128): uint16 = + assert(arg.udata[3] == 0) + assert(arg.udata[2] == 0) + assert(arg.udata[1] == 0) + uint16(arg.udata[0]) + +proc toUInt8*(arg: Int128): uint8 = + assert(arg.udata[3] == 0) + assert(arg.udata[2] == 0) + assert(arg.udata[1] == 0) + uint8(arg.udata[0]) + +proc toUInt*(arg: Int128): uint = + when sizeof(int) == 4: + cast[uint](toInt32(arg)) + else: + cast[uint](toInt64(arg)) + +proc castToInt64*(arg: Int128): int64 = + ## Conversion to int64 without range check. + cast[int64](bitconcat(arg.udata[1], arg.udata[0])) + +proc castToUInt64*(arg: Int128): uint64 = + ## Conversion to uint64 without range check. + cast[uint64](bitconcat(arg.udata[1], arg.udata[0])) + +proc addToHex(result: var string; arg: uint32) = + for i in 0..<8: + let idx = (arg shr ((7-i) * 4)) and 0xf + result.add "0123456789abcdef"[idx] + +proc addToHex*(result: var string; arg: Int128) = + var i = 3 + while i >= 0: + result.addToHex(arg.udata[i]) + i -= 1 + +proc toHex*(arg: Int128): string = + result = "" + result.addToHex(arg) + +proc inc*(a: var Int128, y: uint32 = 1) = + a.udata[0] += y + if unlikely(a.udata[0] < y): + a.udata[1].inc + if unlikely(a.udata[1] == 0): + a.udata[2].inc + if unlikely(a.udata[2] == 0): + a.udata[3].inc + doAssert(a.sdata(3) != low(int32), "overflow") + +proc cmp*(a, b: Int128): int = + let tmp1 = cmp(a.sdata(3), b.sdata(3)) + if tmp1 != 0: return tmp1 + let tmp2 = cmp(a.udata[2], b.udata[2]) + if tmp2 != 0: return tmp2 + let tmp3 = cmp(a.udata[1], b.udata[1]) + if tmp3 != 0: return tmp3 + let tmp4 = cmp(a.udata[0], b.udata[0]) + return tmp4 + +proc `<`*(a, b: Int128): bool = + cmp(a, b) < 0 + +proc `<=`*(a, b: Int128): bool = + cmp(a, b) <= 0 + +proc `==`*(a, b: Int128): bool = + if a.udata[0] != b.udata[0]: return false + if a.udata[1] != b.udata[1]: return false + if a.udata[2] != b.udata[2]: return false + if a.udata[3] != b.udata[3]: return false + return true + +proc bitnot*(a: Int128): Int128 = + result = Zero + result.udata[0] = not a.udata[0] + result.udata[1] = not a.udata[1] + result.udata[2] = not a.udata[2] + result.udata[3] = not a.udata[3] + +proc bitand*(a, b: Int128): Int128 = + result = Zero + result.udata[0] = a.udata[0] and b.udata[0] + result.udata[1] = a.udata[1] and b.udata[1] + result.udata[2] = a.udata[2] and b.udata[2] + result.udata[3] = a.udata[3] and b.udata[3] + +proc bitor*(a, b: Int128): Int128 = + result = Zero + result.udata[0] = a.udata[0] or b.udata[0] + result.udata[1] = a.udata[1] or b.udata[1] + result.udata[2] = a.udata[2] or b.udata[2] + result.udata[3] = a.udata[3] or b.udata[3] + +proc bitxor*(a, b: Int128): Int128 = + result = Zero + result.udata[0] = a.udata[0] xor b.udata[0] + result.udata[1] = a.udata[1] xor b.udata[1] + result.udata[2] = a.udata[2] xor b.udata[2] + result.udata[3] = a.udata[3] xor b.udata[3] + +proc `shr`*(a: Int128, b: int): Int128 = + result = Zero + let b = b and 127 + if b < 32: + result.sdata(3) = a.sdata(3) shr b + result.udata[2] = cast[uint32](bitconcat(a.udata[3], a.udata[2]) shr b) + result.udata[1] = cast[uint32](bitconcat(a.udata[2], a.udata[1]) shr b) + result.udata[0] = cast[uint32](bitconcat(a.udata[1], a.udata[0]) shr b) + elif b < 64: + if isNegative(a): + result.sdata(3) = -1 + result.sdata(2) = a.sdata(3) shr (b and 31) + result.udata[1] = cast[uint32](bitconcat(a.udata[3], a.udata[2]) shr (b and 31)) + result.udata[0] = cast[uint32](bitconcat(a.udata[2], a.udata[1]) shr (b and 31)) + elif b < 96: + if isNegative(a): + result.sdata(3) = -1 + result.sdata(2) = -1 + result.sdata(1) = a.sdata(3) shr (b and 31) + result.udata[0] = cast[uint32](bitconcat(a.udata[3], a.udata[2]) shr (b and 31)) + else: # b < 128 + if isNegative(a): + result.sdata(3) = -1 + result.sdata(2) = -1 + result.sdata(1) = -1 + 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 + result.udata[1] = cast[uint32]((bitconcat(a.udata[1], a.udata[0]) shl b) shr 32) + result.udata[2] = cast[uint32]((bitconcat(a.udata[2], a.udata[1]) shl b) shr 32) + result.udata[3] = cast[uint32]((bitconcat(a.udata[3], a.udata[2]) shl b) shr 32) + elif b < 64: + result.udata[0] = 0 + result.udata[1] = a.udata[0] shl (b and 31) + result.udata[2] = cast[uint32]((bitconcat(a.udata[1], a.udata[0]) shl (b and 31)) shr 32) + result.udata[3] = cast[uint32]((bitconcat(a.udata[2], a.udata[1]) shl (b and 31)) shr 32) + elif b < 96: + result.udata[0] = 0 + result.udata[1] = 0 + result.udata[2] = a.udata[0] shl (b and 31) + result.udata[3] = cast[uint32]((bitconcat(a.udata[1], a.udata[0]) shl (b and 31)) shr 32) + else: + result.udata[0] = 0 + result.udata[1] = 0 + result.udata[2] = 0 + 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) + result.udata[1] = cast[uint32](tmp1) + let tmp2 = uint64(a.udata[2]) + uint64(b.udata[2]) + (tmp1 shr 32) + result.udata[2] = cast[uint32](tmp2) + let tmp3 = uint64(a.udata[3]) + uint64(b.udata[3]) + (tmp2 shr 32) + result.udata[3] = cast[uint32](tmp3) + +proc `+=`*(a: var Int128, b: Int128) = + a = a + b + +proc `-`*(a: Int128): Int128 = + result = bitnot(a) + result.inc + +proc `-`*(a, b: Int128): Int128 = + a + (-b) + +proc `-=`*(a: var Int128, b: Int128) = + a = a - b + +proc abs*(a: Int128): Int128 = + if isNegative(a): + -a + else: + a + +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) + let tmp3 = uint64(a.udata[3]) * uint64(b) + + if unlikely(tmp3 > uint64(high(int32))): + assert(false, "overflow") + + result.udata[0] = cast[uint32](tmp0) + result.udata[1] = cast[uint32](tmp1) + cast[uint32](tmp0 shr 32) + result.udata[2] = cast[uint32](tmp2) + cast[uint32](tmp1 shr 32) + result.udata[3] = cast[uint32](tmp3) + cast[uint32](tmp2 shr 32) + +proc `*`*(a: Int128, b: int32): Int128 = + result = a * cast[uint32](abs(b)) + if b < 0: + result = -result + +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) + result.udata[3] = cast[uint32](high shr 32) + +proc high64(a: Int128): uint64 = + bitconcat(a.udata[3], a.udata[2]) + +proc low64(a: Int128): uint64 = + bitconcat(a.udata[1], a.udata[0]) + +proc `*`*(lhs, rhs: Int128): Int128 = + 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 + +proc `*=`*(a: var Int128, b: Int128) = + a = a * b + +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: + return 64 + fastLog2(a.udata[2]) + if a.udata[1] != 0: + return 32 + fastLog2(a.udata[1]) + if a.udata[0] != 0: + return fastLog2(a.udata[0]) + +proc divMod*(dividend, divisor: Int128): tuple[quotient, remainder: Int128] = + assert(divisor != Zero) + result = (Zero, Zero) + + let isNegativeA = isNegative(dividend) + let isNegativeB = isNegative(divisor) + + var dividend = abs(dividend) + let divisor = abs(divisor) + + if divisor > dividend: + result.quotient = Zero + if isNegativeA: + result.remainder = -dividend + else: + result.remainder = dividend + return + + if divisor == dividend: + if isNegativeA xor isNegativeB: + result.quotient = NegOne + else: + result.quotient = One + result.remainder = Zero + return + + var denominator = divisor + var quotient = Zero + + # Left aligns the MSB of the denominator and the dividend. + let shift = fastLog2(dividend) - fastLog2(denominator) + denominator = denominator shl shift + + # Uses shift-subtract algorithm to divide dividend by denominator. The + # remainder will be left in dividend. + for i in 0..shift: + quotient = quotient shl 1 + if dividend >= denominator: + dividend -= denominator + quotient = bitor(quotient, One) + + denominator = denominator shr 1 + + if isNegativeA xor isNegativeB: + result.quotient = -quotient + else: + result.quotient = quotient + if isNegativeA: + result.remainder = -dividend + else: + result.remainder = dividend + +proc `div`*(a, b: Int128): Int128 = + let (a, _) = divMod(a, b) + return a + +proc `mod`*(a, b: Int128): Int128 = + let (_, b) = divMod(a, b) + return b + +proc addInt128*(result: var string; value: Int128) = + let initialSize = result.len + if value == Zero: + result.add '0' + elif value == low(Int128): + result.add "-170141183460469231731687303715884105728" + else: + let isNegative = isNegative(value) + var value = abs(value) + while value > Zero: + let (quot, rem) = divMod(value, Ten) + result.add "0123456789"[rem.toInt64] + value = quot + if isNegative: + result.add '-' + + var i = initialSize + var j = high(result) + while i < j: + swap(result[i], result[j]) + i += 1 + j -= 1 + +proc `$`*(a: Int128): string = + # "-170141183460469231731687303715884105728".len == 41 + result = newStringOfCap(41) + result.addInt128(a) + +proc parseDecimalInt128*(arg: string, pos: int = 0): Int128 = + assert(pos < arg.len) + assert(arg[pos] in {'-', '0'..'9'}) + + var isNegative = false + var pos = pos + if arg[pos] == '-': + isNegative = true + pos += 1 + + result = Zero + while pos < arg.len and arg[pos] in '0'..'9': + result = result * Ten + result.inc(uint32(arg[pos]) - uint32('0')) + pos += 1 + + if isNegative: + result = -result + +# fluff + +proc `<`*(a: Int128, b: BiggestInt): bool = + cmp(a, toInt128(b)) < 0 + +proc `<`*(a: BiggestInt, b: Int128): bool = + cmp(toInt128(a), b) < 0 + +proc `<=`*(a: Int128, b: BiggestInt): bool = + cmp(a, toInt128(b)) <= 0 + +proc `<=`*(a: BiggestInt, b: Int128): bool = + cmp(toInt128(a), b) <= 0 + +proc `==`*(a: Int128, b: BiggestInt): bool = + a == toInt128(b) + +proc `==`*(a: BiggestInt, b: Int128): bool = + toInt128(a) == b + +proc `-`*(a: BiggestInt, b: Int128): Int128 = + toInt128(a) - b + +proc `-`*(a: Int128, b: BiggestInt): Int128 = + a - toInt128(b) + +proc `+`*(a: BiggestInt, b: Int128): Int128 = + toInt128(a) + b + +proc `+`*(a: Int128, b: BiggestInt): Int128 = + a + toInt128(b) + +proc toFloat64*(arg: Int128): float64 = + let isNegative = isNegative(arg) + let arg = abs(arg) + + let a = float64(bitconcat(arg.udata[1], arg.udata[0])) + let b = float64(bitconcat(arg.udata[3], arg.udata[2])) + + result = a + 18446744073709551616'f64 * b # a + 2^64 * b + if isNegative: + result = -result + +proc ldexp(x: float64, exp: cint): float64 {.importc: "ldexp", header: "<math.h>".} + +template bitor(a, b, c: Int128): Int128 = bitor(bitor(a, b), c) + +proc toInt128*(arg: float64): Int128 = + let isNegative = arg < 0 + let v0 = ldexp(abs(arg), -100) + let w0 = uint64(trunc(v0)) + let v1 = ldexp(v0 - float64(w0), 50) + let w1 = uint64(trunc(v1)) + let v2 = ldexp(v1 - float64(w1), 50) + let w2 = uint64(trunc(v2)) + + let res = bitor(toInt128(w0) shl 100, toInt128(w1) shl 50, toInt128(w2)) + if isNegative: + return -res + else: + 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 + result.udata[3] = 0 + +proc maskBytes*(arg: Int128, numbytes: int): Int128 {.noinit.} = + case numbytes + of 1: + return maskUInt8(arg) + of 2: + return maskUInt16(arg) + of 4: + return maskUInt32(arg) + of 8: + return maskUInt64(arg) + else: + raiseAssert "masking only implemented for 1, 2, 4 and 8 bytes" diff --git a/compiler/isolation_check.nim b/compiler/isolation_check.nim new file mode 100644 index 000000000..17fbde29e --- /dev/null +++ b/compiler/isolation_check.nim @@ -0,0 +1,232 @@ +# +# +# The Nim Compiler +# (c) Copyright 2020 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Implementation of the check that `recover` needs, see +## https://github.com/nim-lang/RFCs/issues/244 for more details. + +import + 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 + of nkRecCase: + assert(n[0].kind == nkSym) + result = canAliasN(arg, n[0], marker) + if result: return + for i in 1..<n.len: + case n[i].kind + of nkOfBranch, nkElse: + result = canAliasN(arg, lastSon(n[i]), marker) + if result: return + else: discard + of nkSym: + result = canAlias(arg, n.sym.typ, marker) + else: result = false + +proc canAlias(arg, ret: PType; marker: var IntSet): bool = + if containsOrIncl(marker, ret.id): + return false + + if ret.kind in {tyPtr, tyPointer}: + # unsafe so we don't care: + return false + if compareTypes(arg, ret, dcEqIgnoreDistinct): + return true + case ret.kind + of tyObject: + if isFinal(ret): + result = canAliasN(arg, ret.n, marker) + if not result and ret.baseClass != nil: + result = canAlias(arg, ret.baseClass, marker) + else: + result = true + of tyTuple: + 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.skipModifier, marker) + of tyProc: + result = ret.callConv == ccClosure + else: + result = false + +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 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 + # worse than the already exisiting inheritance and closure restrictions. + case n.kind + of nkCharLit..nkNilLit: + result = true + of nkCallKinds: + # 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 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: + 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 + of nkHiddenStdConv, nkHiddenSubConv, nkCast, nkConv: + result = checkIsolate(n[1]) + of nkObjUpConv, nkObjDownConv, nkDotExpr: + result = checkIsolate(n[0]) + of nkStmtList, nkStmtListExpr: + if n.len > 0: + 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 ef54841ae..713944def 100644 --- a/compiler/jsgen.nim +++ b/compiler/jsgen.nim @@ -14,34 +14,45 @@ The JS code generator contains only 2 tricks: Trick 1 ------- -Some locations (for example 'var int') require "fat pointers" (``etyBaseIndex``) +Some locations (for example 'var int') require "fat pointers" (`etyBaseIndex`) which are pairs (array, index). The derefence operation is then 'array[index]'. -Check ``mapType`` for the details. +Check `mapType` for the details. Trick 2 ------- It is preferable to generate '||' and '&&' if possible since that is more idiomatic and hence should be friendlier for the JS JIT implementation. However -code like ``foo and (let bar = baz())`` cannot be translated this way. Instead -the expressions need to be transformed into statements. ``isSimpleExpr`` +code like `foo and (let bar = baz())` cannot be translated this way. Instead +the expressions need to be transformed into statements. `isSimpleExpr` implements the required case distinction. """ import - ast, astalgo, strutils, hashes, trees, platform, magicsys, extccomp, options, - nversion, nimsets, msgs, std / sha1, bitsets, idents, types, os, tables, - times, ropes, math, passes, ccgutils, wordrecg, renderer, - intsets, cgmeth, lowerings, sighashes, lineinfos, rodutils + ast, trees, magicsys, options, + nversion, msgs, idents, types, + ropes, wordrecg, renderer, + cgmeth, lowerings, sighashes, modulegraphs, lineinfos, + transf, injectdestructors, sourcemap, astmsgs, pushpoppragmas, + mangleutils -from modulegraphs import ModuleGraph +import pipelineutils + +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 TPassContext + TJSGen = object of PPassContext module: PSym graph: ModuleGraph config: ConfigRef sigConflicts: CountTable[SigHash] + initProc: PProc BModule = ref TJSGen TJSTypeKind = enum # necessary JS "types" @@ -66,6 +77,12 @@ type res: Rope # result part; index if this is an # (address, index)-tuple address: Rope # address of an (address, index)-tuple + tmpLoc: Rope # tmp var which stores the (address, index) + # pair to prevent multiple evals. + # the tmp is initialized upon evaling the + # address. + # might be nil. + # (see `maybeMakeTemp`) TBlock = object id: int # the ID of the label; positive means that it @@ -77,8 +94,8 @@ type forwarded: seq[PSym] generatedSyms: IntSet typeInfoGenerated: IntSet - classes: seq[(PType, Rope)] unique: int # for temp identifier generation + inSystem: bool PProc = ref TProc TProc = object @@ -86,35 +103,39 @@ type prc: PSym globals, locals, body: Rope options: TOptions + optionsStack: seq[(TOptions, TNoteKinds)] module: BModule g: PGlobals 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 countup(0, p.blocks.len - 1 + p.extraIndent): - prepend(result, "\t".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) = - add(p.body, indentLine(p, rope(added))) - -template line(p: PProc, added: Rope) = - add(p.body, indentLine(p, added)) + p.body.add(indentLine(p, rope(added))) template lineF(p: PProc, frmt: FormatStr, args: varargs[Rope]) = - add(p.body, indentLine(p, ropes.`%`(frmt, args))) + p.body.add(indentLine(p, ropes.`%`(frmt, args))) template nested(p, body) = inc p.extraIndent @@ -122,40 +143,42 @@ template nested(p, body) = dec p.extraIndent proc newGlobals(): PGlobals = - new(result) - result.forwarded = @[] - result.generatedSyms = initIntSet() - result.typeInfoGenerated = initIntSet() - result.classes = @[] - -proc initCompRes(r: var TCompRes) = - r.address = nil - r.res = 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.} = - result = a.res - when false: - if a.typ != etyBaseIndex: - result = a.res - else: - result = "$1[$2]" % [a.address, a.res] + if a.typ != etyBaseIndex: + result = a.res + else: + result = "$1[$2]" % [a.address, a.res] 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, g: globals, extraIndent: int(procDef != nil)) - if procDef != nil: result.prc = procDef.sons[namePos].sym + if procDef != nil: result.prc = procDef[namePos].sym -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]) +proc initProcOptions(module: BModule): TOptions = + result = module.config.options + if PGlobals(module.graph.backend).inSystem: + result.excl(optStackTrace) + +proc newInitProc(globals: PGlobals, module: BModule): PProc = + result = newProc(globals, module, nil, initProcOptions(module)) const MappedToObject = {tyObject, tyArray, tyTuple, tyOpenArray, @@ -164,38 +187,40 @@ 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.sons[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 of tySet: result = etyObject # map a set to a table - of tyString, tySequence, tyOpt: result = etySeq - of tyObject, tyArray, tyTuple, tyOpenArray, tyVarargs: + of tyString, tySequence: result = etySeq + of tyObject, tyArray, tyTuple, tyOpenArray, tyVarargs, tyUncheckedArray: result = etyObject of tyNil: result = etyNull of tyGenericParam, tyGenericBody, tyGenericInvocation, tyNone, tyFromExpr, tyForward, tyEmpty, - tyExpr, tyStmt, tyTypeDesc, tyBuiltInTypeClass, tyCompositeTypeClass, + tyUntyped, tyTyped, tyTypeDesc, tyBuiltInTypeClass, tyCompositeTypeClass, tyAnd, tyOr, tyNot, tyAnything, tyVoid: result = etyNone of tyGenericInst, tyInferred, tyAlias, tyUserTypeClass, tyUserTypeClassInst, - tySink: - result = mapType(typ.lastSon) + tySink, tyOwned: + 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 tyUnused, tyOptAsRef: doAssert(false, "mapType") + of tyCstring: result = etyString + of tyConcept, tyIterable: + raiseAssert "unreachable" proc mapType(p: PProc; typ: PType): TJSTypeKind = result = mapType(typ) @@ -221,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: @@ -233,25 +258,26 @@ proc mangleName(m: BModule, s: PSym): Rope = while i < s.name.s.len: let c = s.name.s[i] case c - of 'A'..'Z': - if i > 0 and s.name.s[i-1] in {'a'..'z'}: - x.add '_' - x.add(chr(c.ord - 'A'.ord + 'a'.ord)) - of 'a'..'z', '_', '0'..'9': + of 'A'..'Z', 'a'..'z', '_', '0'..'9': x.add c else: x.add("HEX" & toHex(ord(c), 2)) inc i result = rope(x) - if s.name.s != "this" and s.kind != skField: - if optHotCodeReloading in m.config.options: + # From ES5 on reserved words can be used as object field names + if s.kind != skField: + if m.config.hcrOn: # When hot reloading is enabled, we must ensure that the names # of functions and types will be preserved across rebuilds: - add(result, 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: - add(result, "_") - add(result, rope(s.id)) - s.loc.r = result + result.add("_") + result.add(rope(s.id)) + s.loc.snippet = result proc escapeJSString(s: string): string = result = newStringOfCap(s.len + s.len shr 2) @@ -267,17 +293,30 @@ proc escapeJSString(s: string): string = of '\v': result.add("\\v") of '\\': result.add("\\\\") of '\"': result.add("\\\"") - else: add(result, c) + else: result.add(c) result.add("\"") proc makeJSString(s: string, escapeNonAscii = true): Rope = - if s.isNil: - result = "null".rope - elif escapeNonAscii: + if escapeNonAscii: result = strutils.escape(s).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) @@ -292,7 +331,7 @@ proc useMagic(p: PProc, name: string) = internalAssert p.config, s.kind in {skProc, skFunc, skMethod, skConverter} if not p.g.generatedSyms.containsOrIncl(s.id): let code = genProc(p, s) - add(p.g.constants, code) + p.g.constants.add(code) else: if p.prc != nil: globalError(p.config, p.prc.info, "system module needs: " & name) @@ -301,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: - add(p.locals, p.indentLine("var $1;$n" % [result])) + 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) @@ -344,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) @@ -361,169 +407,458 @@ proc genOr(p: PProc, a, b: PNode, r: var TCompRes) = line(p, "}") type - TMagicFrmt = array[0..3, string] + TMagicFrmt = array[0..1, string] TMagicOps = array[mAddI..mStrToStr, TMagicFrmt] -const # magic checked op; magic unchecked op; checked op; unchecked op - jsOps: TMagicOps = [ - ["addInt", "", "addInt($1, $2)", "($1 + $2)"], # AddI - ["subInt", "", "subInt($1, $2)", "($1 - $2)"], # SubI - ["mulInt", "", "mulInt($1, $2)", "($1 * $2)"], # MulI - ["divInt", "", "divInt($1, $2)", "Math.trunc($1 / $2)"], # DivI - ["modInt", "", "modInt($1, $2)", "Math.trunc($1 % $2)"], # ModI - ["addInt", "", "addInt($1, $2)", "($1 + $2)"], # Succ - ["subInt", "", "subInt($1, $2)", "($1 - $2)"], # Pred - ["", "", "($1 + $2)", "($1 + $2)"], # AddF64 - ["", "", "($1 - $2)", "($1 - $2)"], # SubF64 - ["", "", "($1 * $2)", "($1 * $2)"], # MulF64 - ["", "", "($1 / $2)", "($1 / $2)"], # DivF64 - ["", "", "", ""], # ShrI - ["", "", "($1 << $2)", "($1 << $2)"], # ShlI - ["", "", "($1 & $2)", "($1 & $2)"], # BitandI - ["", "", "($1 | $2)", "($1 | $2)"], # BitorI - ["", "", "($1 ^ $2)", "($1 ^ $2)"], # BitxorI - ["nimMin", "nimMin", "nimMin($1, $2)", "nimMin($1, $2)"], # MinI - ["nimMax", "nimMax", "nimMax($1, $2)", "nimMax($1, $2)"], # MaxI - ["nimMin", "nimMin", "nimMin($1, $2)", "nimMin($1, $2)"], # MinF64 - ["nimMax", "nimMax", "nimMax($1, $2)", "nimMax($1, $2)"], # MaxF64 - ["", "", "", ""], # addU - ["", "", "", ""], # subU - ["", "", "", ""], # mulU - ["", "", "", ""], # divU - ["", "", "($1 % $2)", "($1 % $2)"], # modU - ["", "", "($1 == $2)", "($1 == $2)"], # EqI - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeI - ["", "", "($1 < $2)", "($1 < $2)"], # LtI - ["", "", "($1 == $2)", "($1 == $2)"], # EqF64 - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeF64 - ["", "", "($1 < $2)", "($1 < $2)"], # LtF64 - ["", "", "($1 <= $2)", "($1 <= $2)"], # leU - ["", "", "($1 < $2)", "($1 < $2)"], # ltU - ["", "", "($1 <= $2)", "($1 <= $2)"], # leU64 - ["", "", "($1 < $2)", "($1 < $2)"], # ltU64 - ["", "", "($1 == $2)", "($1 == $2)"], # EqEnum - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeEnum - ["", "", "($1 < $2)", "($1 < $2)"], # LtEnum - ["", "", "($1 == $2)", "($1 == $2)"], # EqCh - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeCh - ["", "", "($1 < $2)", "($1 < $2)"], # LtCh - ["", "", "($1 == $2)", "($1 == $2)"], # EqB - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeB - ["", "", "($1 < $2)", "($1 < $2)"], # LtB - ["", "", "($1 == $2)", "($1 == $2)"], # EqRef - ["", "", "($1 == $2)", "($1 == $2)"], # EqUntracedRef - ["", "", "($1 <= $2)", "($1 <= $2)"], # LePtr - ["", "", "($1 < $2)", "($1 < $2)"], # LtPtr - ["", "", "($1 != $2)", "($1 != $2)"], # Xor - ["", "", "($1 == $2)", "($1 == $2)"], # EqCString - ["", "", "($1 == $2)", "($1 == $2)"], # EqProc - ["negInt", "", "negInt($1)", "-($1)"], # UnaryMinusI - ["negInt64", "", "negInt64($1)", "-($1)"], # UnaryMinusI64 - ["absInt", "", "absInt($1)", "Math.abs($1)"], # AbsI - ["", "", "!($1)", "!($1)"], # Not - ["", "", "+($1)", "+($1)"], # UnaryPlusI - ["", "", "~($1)", "~($1)"], # BitnotI - ["", "", "+($1)", "+($1)"], # UnaryPlusF64 - ["", "", "-($1)", "-($1)"], # UnaryMinusF64 - ["", "", "Math.abs($1)", "Math.abs($1)"], # AbsF64 - ["Ze8ToI", "Ze8ToI", "Ze8ToI($1)", "Ze8ToI($1)"], # mZe8ToI - ["Ze8ToI64", "Ze8ToI64", "Ze8ToI64($1)", "Ze8ToI64($1)"], # mZe8ToI64 - ["Ze16ToI", "Ze16ToI", "Ze16ToI($1)", "Ze16ToI($1)"], # mZe16ToI - ["Ze16ToI64", "Ze16ToI64", "Ze16ToI64($1)", "Ze16ToI64($1)"], # mZe16ToI64 - ["Ze32ToI64", "Ze32ToI64", "Ze32ToI64($1)", "Ze32ToI64($1)"], # mZe32ToI64 - ["ZeIToI64", "ZeIToI64", "ZeIToI64($1)", "ZeIToI64($1)"], # mZeIToI64 - ["toU8", "toU8", "toU8($1)", "toU8($1)"], # toU8 - ["toU16", "toU16", "toU16($1)", "toU16($1)"], # toU16 - ["toU32", "toU32", "toU32($1)", "toU32($1)"], # toU32 - ["", "", "$1", "$1"], # ToFloat - ["", "", "$1", "$1"], # ToBiggestFloat - ["", "", "Math.trunc($1)", "Math.trunc($1)"], # ToInt - ["", "", "Math.trunc($1)", "Math.trunc($1)"], # ToBiggestInt - ["nimCharToStr", "nimCharToStr", "nimCharToStr($1)", "nimCharToStr($1)"], - ["nimBoolToStr", "nimBoolToStr", "nimBoolToStr($1)", "nimBoolToStr($1)"], - ["cstrToNimstr", "cstrToNimstr", "cstrToNimstr(($1)+\"\")", "cstrToNimstr(($1)+\"\")"], - ["cstrToNimstr", "cstrToNimstr", "cstrToNimstr(($1)+\"\")", "cstrToNimstr(($1)+\"\")"], - ["cstrToNimstr", "cstrToNimstr", "cstrToNimstr(($1)+\"\")", "cstrToNimstr(($1)+\"\")"], - ["cstrToNimstr", "cstrToNimstr", "cstrToNimstr($1)", "cstrToNimstr($1)"], - ["", "", "$1", "$1"]] - -proc binaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string) = - var x, y: TCompRes +const # magic checked op; magic unchecked op; + jsMagics: TMagicOps = [ + mAddI: ["addInt", ""], + mSubI: ["subInt", ""], + mMulI: ["mulInt", ""], + mDivI: ["divInt", ""], + mModI: ["modInt", ""], + mSucc: ["addInt", ""], + mPred: ["subInt", ""], + mAddF64: ["", ""], + mSubF64: ["", ""], + mMulF64: ["", ""], + mDivF64: ["", ""], + mShrI: ["", ""], + mShlI: ["", ""], + mAshrI: ["", ""], + mBitandI: ["", ""], + mBitorI: ["", ""], + mBitxorI: ["", ""], + mMinI: ["nimMin", "nimMin"], + mMaxI: ["nimMax", "nimMax"], + mAddU: ["", ""], + mSubU: ["", ""], + mMulU: ["", ""], + mDivU: ["", ""], + mModU: ["", ""], + mEqI: ["", ""], + mLeI: ["", ""], + mLtI: ["", ""], + mEqF64: ["", ""], + mLeF64: ["", ""], + mLtF64: ["", ""], + mLeU: ["", ""], + mLtU: ["", ""], + mEqEnum: ["", ""], + mLeEnum: ["", ""], + mLtEnum: ["", ""], + mEqCh: ["", ""], + mLeCh: ["", ""], + mLtCh: ["", ""], + mEqB: ["", ""], + mLeB: ["", ""], + mLtB: ["", ""], + mEqRef: ["", ""], + mLePtr: ["", ""], + mLtPtr: ["", ""], + mXor: ["", ""], + mEqCString: ["", ""], + mEqProc: ["", ""], + mUnaryMinusI: ["negInt", ""], + mUnaryMinusI64: ["negInt64", ""], + mAbsI: ["absInt", ""], + mNot: ["", ""], + mUnaryPlusI: ["", ""], + mBitnotI: ["", ""], + mUnaryPlusF64: ["", ""], + mUnaryMinusF64: ["", ""], + mCharToStr: ["nimCharToStr", "nimCharToStr"], + mBoolToStr: ["nimBoolToStr", "nimBoolToStr"], + 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: + if needsTemp(p, c): + return true + +proc maybeMakeTemp(p: PProc, n: PNode; x: TCompRes): tuple[a, tmp: Rope] = + var + a = x.rdLoc + b = a + if needsTemp(p, n): + # if we have tmp just use it + 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: + let tmp = p.getTemp + b = tmp + a = "($1 = $2, $1)" % [tmp, a] + (a: a, tmp: b) + else: + (a: a, tmp: b) + +proc maybeMakeTempAssignable(p: PProc, n: PNode; x: TCompRes): tuple[a, tmp: Rope] = + var + a = x.rdLoc + b = a + if needsTemp(p, n): + # if we have tmp just use it + 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 != "" and n.kind == nkBracketExpr: + # genArrayAddr + var + 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.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] + else: + 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)] + else: + discard # index.res = index.res + let (n1, tmp2) = maybeMakeTemp(p, n[1], index) + result = (a: "$1[$2]" % [m1, n1], tmp: "$1[$2]" % [tmp1, tmp2]) + # could also put here: nkDotExpr -> genFieldAccess, nkCheckedFieldExpr -> genCheckedFieldOp + # but the uses of maybeMakeTempAssignable don't need them + else: + result = (a: a, tmp: b) + else: + result = (a: a, tmp: b) + +template binaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string, + reassign = false) = + # $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 = default(TCompRes) useMagic(p, magic) - gen(p, n.sons[1], x) - gen(p, n.sons[2], y) - r.res = frmt % [x.rdLoc, y.rdLoc] + gen(p, n[1], x) + gen(p, n[2], y) + + var + a, tmp = x.rdLoc + b, tmp2 = y.rdLoc + when reassign: + (a, tmp) = maybeMakeTempAssignable(p, n[1], x) + else: + when "$3" in frmt: (a, tmp) = maybeMakeTemp(p, n[1], x) + when "$4" in frmt: (b, tmp2) = maybeMakeTemp(p, n[2], y) + + 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 = false) = - var x, y: TCompRes - gen(p, n.sons[1], x) - gen(p, n.sons[2], y) - let trimmer = unsignedTrimmer(n[1].typ.skipTypes(abstractRange).size) - if reassign: - r.res = "$1 = (($1 $2 $3) $4)" % [x.rdLoc, rope op, y.rdLoc, trimmer] + reassign: static[bool] = false) = + var x, y: TCompRes = default(TCompRes) + gen(p, n[1], x) + gen(p, n[2], y) + let size = n[1].typ.skipTypes(abstractRange).size + when reassign: + let (a, tmp) = maybeMakeTempAssignable(p, n[1], x) + 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 -proc ternaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string) = +template ternaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string) = var x, y, z: TCompRes useMagic(p, magic) - gen(p, n.sons[1], x) - gen(p, n.sons[2], y) - gen(p, n.sons[3], z) + gen(p, n[1], x) + gen(p, n[2], y) + gen(p, n[3], z) r.res = frmt % [x.rdLoc, y.rdLoc, z.rdLoc] r.kind = resExpr -proc unaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string) = +template unaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string) = + # $1 binds to n[1], if $2 is present it will be substituted to a tmp of $1 useMagic(p, magic) - gen(p, n.sons[1], r) - r.res = frmt % [r.rdLoc] + gen(p, n[1], r) + var a, tmp = r.rdLoc + if "$2" in frmt: (a, tmp) = maybeMakeTemp(p, n[1], r) + 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 + x, y: TCompRes = default(TCompRes) + xLoc, yLoc: Rope = "" let i = ord(optOverflowCheck notin p.options) - useMagic(p, jsOps[op][i]) - if sonsLen(n) > 2: - gen(p, n.sons[1], x) - gen(p, n.sons[2], y) - r.res = jsOps[op][i + 2] % [x.rdLoc, y.rdLoc] + useMagic(p, jsMagics[op][i]) + if n.len > 2: + gen(p, n[1], x) + gen(p, n[2], y) + xLoc = x.rdLoc + yLoc = y.rdLoc else: - gen(p, n.sons[1], r) - r.res = jsOps[op][i + 2] % [r.rdLoc] + gen(p, n[1], r) + xLoc = r.rdLoc + + template applyFormat(frmt) = + r.res = frmt % [xLoc, yLoc] + template applyFormat(frmtA, frmtB) = + if i == 0: applyFormat(frmtA) else: applyFormat(frmtB) + + 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: + 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: + 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: + 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: + 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: + 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("", "") + of mSubU: applyFormat("", "") + of mMulU: applyFormat("", "") + of mDivU: applyFormat("", "") + of mModU: applyFormat("($1 % $2)", "($1 % $2)") + of mEqI: applyFormat("($1 == $2)", "($1 == $2)") + of mLeI: applyFormat("($1 <= $2)", "($1 <= $2)") + of mLtI: applyFormat("($1 < $2)", "($1 < $2)") + of mEqF64: applyFormat("($1 == $2)", "($1 == $2)") + of mLeF64: applyFormat("($1 <= $2)", "($1 <= $2)") + of mLtF64: applyFormat("($1 < $2)", "($1 < $2)") + of mLeU: applyFormat("($1 <= $2)", "($1 <= $2)") + of mLtU: applyFormat("($1 < $2)", "($1 < $2)") + of mEqEnum: applyFormat("($1 == $2)", "($1 == $2)") + of mLeEnum: applyFormat("($1 <= $2)", "($1 <= $2)") + of mLtEnum: applyFormat("($1 < $2)", "($1 < $2)") + of mEqCh: applyFormat("($1 == $2)", "($1 == $2)") + of mLeCh: applyFormat("($1 <= $2)", "($1 <= $2)") + of mLtCh: applyFormat("($1 < $2)", "($1 < $2)") + of mEqB: applyFormat("($1 == $2)", "($1 == $2)") + of mLeB: applyFormat("($1 <= $2)", "($1 <= $2)") + of mLtB: applyFormat("($1 < $2)", "($1 < $2)") + of mEqRef: applyFormat("($1 == $2)", "($1 == $2)") + of mLePtr: applyFormat("($1 <= $2)", "($1 <= $2)") + of mLtPtr: applyFormat("($1 < $2)", "($1 < $2)") + of mXor: applyFormat("($1 != $2)", "($1 != $2)") + of mEqCString: applyFormat("($1 == $2)", "($1 == $2)") + of mEqProc: applyFormat("($1 == $2)", "($1 == $2)") + of mUnaryMinusI: applyFormat("negInt($1)", "-($1)") + of mUnaryMinusI64: applyFormat("negInt64($1)", "-($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: + 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 mCStrToStr: applyFormat("cstrToNimstr($1)", "cstrToNimstr($1)") + of mStrToStr, mUnown, mIsolate, mFinished: applyFormat("$1", "$1") + else: + assert false, $op proc arith(p: PProc, n: PNode, r: var TCompRes, op: TMagic) = case op of mAddU: binaryUintExpr(p, n, r, "+") of mSubU: binaryUintExpr(p, n, r, "-") of mMulU: binaryUintExpr(p, n, r, "*") - of mDivU: binaryUintExpr(p, n, r, "/") + of mDivU: + binaryUintExpr(p, n, r, "/") + 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.sons[1], x) - gen(p, n.sons[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 = 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 @@ -532,36 +867,42 @@ proc hasFrameInfo(p: PProc): bool = ({optLineTrace, optStackTrace} * p.options == {optLineTrace, optStackTrace}) and ((p.prc == nil) or not (sfPure in p.prc.flags)) +proc lineDir(config: ConfigRef, info: TLineInfo, line: int): Rope = + "/* 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 optLineDir in p.options: - lineF(p, "// line $2 \"$1\"$n", - [rope(toFilename(p.config, n.info)), rope(line)]) - if {optStackTrace, optEndb} * p.options == {optStackTrace, optEndb} and - ((p.prc == nil) or sfPure notin p.prc.flags): - useMagic(p, "endb") - lineF(p, "endb($1);$n", [rope(line)]) - elif hasFrameInfo(p): + 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) - var length = len(p.blocks) - setLen(p.blocks, length + 1) - p.blocks[length].id = -p.unique - p.blocks[length].isLoop = true + setLen(p.blocks, p.blocks.len + 1) + p.blocks[^1].id = -p.unique + p.blocks[^1].isLoop = true let labl = p.unique.rope - lineF(p, "L$1: while (true) {$n", [labl]) - p.nested: gen(p, n.sons[0], cond) - lineF(p, "if (!$1) break L$2;$n", + lineF(p, "Label$1: while (true) {$n", [labl]) + p.nested: gen(p, n[0], cond) + lineF(p, "if (!$1) break Label$2;$n", [cond.res, labl]) - p.nested: genStmt(p, n.sons[1]) + p.nested: genStmt(p, n[1]) lineF(p, "}$n", [labl]) - setLen(p.blocks, length) + setLen(p.blocks, p.blocks.len - 1) proc moveInto(p: PProc, src: var TCompRes, dest: TCompRes) = if src.kind != resNone: @@ -570,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: @@ -580,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) { @@ -602,45 +943,68 @@ proc genTry(p: PProc, n: PNode, r: var TCompRes) = r.res = getTemp(p) inc(p.unique) var i = 1 - var length = sonsLen(n) - var catchBranchesExist = length > 1 and n.sons[i].kind == nkExceptBranch + var catchBranchesExist = n.len > 1 and n[i].kind == nkExceptBranch if catchBranchesExist: - add(p.body, "++excHandler;\L") + 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 - gen(p, n.sons[0], a) + var a: TCompRes = default(TCompRes) + gen(p, n[0], a) moveInto(p, a, r) var generalCatchBranchExists = false - let dollar = rope("") if catchBranchesExist: - addf(p.body, "--excHandler;$n} catch (EXC) {$n var prevJSError = lastJSError;$n" & - " lastJSError = EXC;$n --excHandler;$n", []) - line(p, "framePtr = $1;$n" % [tmpFramePtr]) - while i < length and n.sons[i].kind == nkExceptBranch: - let blen = sonsLen(n.sons[i]) - if blen == 1: + 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: generalCatchBranchExists = true if i > 1: lineF(p, "else {$n", []) - gen(p, n.sons[i].sons[0], a) + gen(p, n[i][0], a) 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") - for j in countup(0, blen - 2): - if n.sons[i].sons[j].kind != nkType: + for j in 0..<n[i].len - 1: + var throwObj: PNode + let it = n[i][j] + + if it.isInfixAs(): + throwObj = it[1] + excAlias = it[2] + # If this is a ``except exc as sym`` branch there must be no following + # nodes + doAssert orExpr == "" + elif it.kind == nkType: + throwObj = it + else: + throwObj = nil internalError(p.config, n.info, "genTryStmt") - if orExpr != nil: add(orExpr, "||") - addf(orExpr, "isObj($2lastJSError.m_type, $1)", - [genTypeInfo(p, n.sons[i].sons[j].typ), dollar]) + + 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.snippet]) + else: + orExpr.addf("isObj(lastJSError.m_type, $1)", + [genTypeInfo(p, throwObj.typ)]) + if i > 1: line(p, "else ") - lineF(p, "if ($1lastJSError && ($2)) {$n", [dollar, orExpr]) - gen(p, n.sons[i].sons[blen - 1], a) + lineF(p, "if (lastJSError && ($1)) {$n", [orExpr]) + # If some branch requires a local alias introduce it here. This is needed + # since JS cannot do ``catch x as y``. + if excAlias != nil: + excAlias.sym.loc.snippet = mangleName(p.module, excAlias.sym) + lineF(p, "var $1 = lastJSError;$n", excAlias.sym.loc.snippet) + gen(p, n[i][^1], a) moveInto(p, a, r) lineF(p, "}$n", []) inc(i) @@ -650,113 +1014,163 @@ proc genTry(p: PProc, n: PNode, r: var TCompRes) = line(p, "else {\L") line(p, "\treraiseException();\L") line(p, "}\L") - addf(p.body, "$1lastJSError = $1prevJSError;$n", [dollar]) + lineF(p, "lastJSError = prevJSError;$n") line(p, "} finally {\L") - line(p, "framePtr = $1;$n" % [tmpFramePtr]) - if i < length and n.sons[i].kind == nkFinally: - genStmt(p, n.sons[i].sons[0]) + 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) = - genLineDir(p, n) - if n.sons[0].kind != nkEmpty: - var a: TCompRes - gen(p, n.sons[0], a) - let typ = skipTypes(n.sons[0].typ, abstractPtrs) + if n[0].kind != nkEmpty: + var a: TCompRes = default(TCompRes) + gen(p, n[0], a) + let typ = skipTypes(n[0].typ, abstractPtrs) + genLineDir(p, n) useMagic(p, "raiseException") lineF(p, "raiseException($1, $2);$n", [a.rdLoc, makeJSString(typ.sym.name.s)]) else: + genLineDir(p, n) useMagic(p, "reraiseException") line(p, "reraiseException();\L") proc genCaseJS(p: PProc, n: PNode, r: var TCompRes) = var - cond, stmt: TCompRes + a, b, cond, stmt: TCompRes = default(TCompRes) genLineDir(p, n) - gen(p, n.sons[0], cond) - let stringSwitch = skipTypes(n.sons[0].typ, abstractVar).kind == tyString - if stringSwitch: + gen(p, n[0], cond) + 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): r.kind = resVal r.res = getTemp(p) - for i in countup(1, sonsLen(n) - 1): - let it = n.sons[i] + for i in 1..<n.len: + let it = n[i] + let itLen = it.len case it.kind of nkOfBranch: - for j in countup(0, sonsLen(it) - 2): - let e = it.sons[j] + 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.sons[0]) - while v.intVal <= e.sons[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.sons[0], stmt) + 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) - let idx = len(p.blocks) - if n.sons[0].kind != nkEmpty: + let idx = p.blocks.len + if n[0].kind != nkEmpty: # named block? - if (n.sons[0].kind != nkSym): internalError(p.config, n.info, "genBlock") - var sym = n.sons[0].sym + if (n[0].kind != nkSym): internalError(p.config, n.info, "genBlock") + var sym = n[0].sym 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.sons[1], r) + 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 genLineDir(p, n) - if n.sons[0].kind != nkEmpty: + if n[0].kind != nkEmpty: # named break? - assert(n.sons[0].kind == nkSym) - let sym = n.sons[0].sym + assert(n[0].kind == nkSym) + let sym = n[0].sym assert(sym.loc.k == locOther) idx = sym.position-1 else: # an unnamed 'break' can only break a loop after 'transf' pass: - idx = len(p.blocks) - 1 + idx = p.blocks.len - 1 while idx >= 0 and not p.blocks[idx].isLoop: dec idx 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 countup(0, sonsLen(n) - 1): + 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: @@ -764,59 +1178,81 @@ proc genAsmOrEmitStmt(p: PProc, n: PNode) = of nkSym: let v = it.sym # for backwards compatibility we don't deref syms here :-( - if v.kind in {skVar, skLet, skTemp, skConst, skResult, skParam, skForVar}: - p.body.add mangleName(p.module, v) + 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 = "" + r.typ = etyNone + elif r.typ == etyBaseIndex: + # Deference first + r.res = "$1[$2]" % [r.address, r.res] + 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 r.res = getTemp(p) - for i in countup(0, sonsLen(n) - 1): - let it = n.sons[i] - if sonsLen(it) != 1: + for i in 0..<n.len: + let it = n[i] + if it.len != 1: if i > 0: lineF(p, "else {$n", []) inc(toClose) - p.nested: gen(p, it.sons[0], cond) + p.nested: gen(p, it[0], cond) lineF(p, "if ($1) {$n", [cond.rdLoc]) - gen(p, it.sons[1], stmt) + gen(p, it[1], stmt) else: # else part: lineF(p, "else {$n", []) - p.nested: gen(p, it.sons[0], stmt) + p.nested: gen(p, it[0], stmt) moveInto(p, stmt, r) lineF(p, "}$n", []) line(p, repeat('}', toClose) & "\L") -proc generateHeader(p: PProc, typ: PType): Rope = - result = nil - for i in countup(1, sonsLen(typ.n) - 1): - assert(typ.n.sons[i].kind == nkSym) - var param = typ.n.sons[i].sym +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: add(result, ", ") + if result != "": result.add(", ") var name = mangleName(p.module, param) - add(result, name) + result.add(name) if mapType(param.typ) == etyBaseIndex: - add(result, ", ") - add(result, name) - add(result, "_Idx") + result.add(", ") + result.add(name) + result.add("_Idx") proc countJsParams(typ: PType): int = - for i in countup(1, sonsLen(typ.n) - 1): - assert(typ.n.sons[i].kind == nkSym) - var param = typ.n.sons[i].sym + result = 0 + 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 mapType(param.typ) == etyBaseIndex: inc result, 2 @@ -825,67 +1261,87 @@ proc countJsParams(typ: PType): int = const nodeKindsNeedNoCopy = {nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, - nkFloatLit..nkFloat64Lit, nkCurly, nkPar, nkTupleConstr, nkObjConstr, nkStringToCString, + nkFloatLit..nkFloat64Lit, nkPar, nkStringToCString, + nkObjConstr, nkTupleConstr, nkBracket, nkCStringToString, nkCall, nkPrefix, nkPostfix, nkInfix, nkCommand, nkHiddenCallConv, nkCallStrLit} proc needsNoCopy(p: PProc; y: PNode): bool = - result = (y.kind in nodeKindsNeedNoCopy) or - (skipTypes(y.typ, abstractInst).kind in {tyRef, tyPtr, tyLent, tyVar}) + return y.kind in nodeKindsNeedNoCopy or + ((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, 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) - if x.kind == nkHiddenDeref and x.sons[0].kind == nkCall and xtyp != etyObject: - gen(p, x.sons[0], a) - let tmp = p.getTemp(false) - lineF(p, "var $1 = $2;$n", [tmp, a.rdLoc]) - a.res = "$1[0][$1[1]]" % [tmp] - else: - gen(p, x, a) + # disable `[]=` for cstring + if x.kind == nkBracketExpr and x.len >= 2 and x[0].typ.skipTypes(abstractInst).kind == tyCstring: + localError(p.config, x.info, "cstring doesn't support `[]=` operator") + gen(p, x, a) + genLineDir(p, y) gen(p, y, b) # we don't care if it's an etyBaseIndex (global) of a string, it's # still a string that needs to be copied properly: - if x.typ.skipTypes(abstractInst).kind in {tySequence, tyOpt, tyString}: + if x.typ.skipTypes(abstractInst).kind in {tySequence, tyString}: 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 (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") - lineF(p, "nimCopy($1, $2, $3);$n", - [a.res, b.res, genTypeInfo(p, y.typ)]) + # supports proc getF(): var T + if x.kind in {nkHiddenDeref, nkDerefExpr} and x[0].kind in nkCallKinds: + lineF(p, "nimCopy($1, $2, $3);$n", + [a.res, b.res, genTypeInfo(p, x.typ)]) + else: + lineF(p, "$1 = nimCopy($1, $2, $3);$n", + [a.res, b.res, genTypeInfo(p, x.typ)]) of etyBaseIndex: if a.typ != etyBaseIndex or b.typ != etyBaseIndex: if y.kind == nkCall: let tmp = p.getTemp(false) lineF(p, "var $1 = $4; $2 = $1[0]; $3 = $1[1];$n", [tmp, a.address, a.res, b.rdLoc]) elif b.typ == etyBaseIndex: - lineF(p, "$# = $#;$n", [a.res, b.rdLoc]) + lineF(p, "$# = [$#, $#];$n", [a.res, b.address, b.res]) + elif b.typ == etyNone: + 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") - else: + internalError(p.config, x.info, $("genAsgn", b.typ, a.typ)) + 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.res, b.res]) + lineF(p, "$1 = $2;$n", [a.rdLoc, b.rdLoc]) proc genAsgn(p: PProc, n: PNode) = - genLineDir(p, n) - genAsgnAux(p, n.sons[0], n.sons[1], noCopyNeeded=false) + genAsgnAux(p, n[0], n[1], noCopyNeeded=false) proc genFastAsgn(p: PProc, n: PNode) = - genLineDir(p, n) # 'shallowCopy' always produced 'noCopyNeeded = true' here but this is wrong # for code like # while j >= pos: @@ -893,184 +1349,270 @@ proc genFastAsgn(p: PProc, n: PNode) = # See bug #5933. So we try to be more compatible with the C backend semantics # here for 'shallowCopy'. This is an educated guess and might require further # changes later: - let noCopy = n[0].typ.skipTypes(abstractInst).kind in {tySequence, tyOpt, tyString} - genAsgnAux(p, n.sons[0], n.sons[1], noCopyNeeded=noCopy) + let noCopy = n[0].typ.skipTypes(abstractInst).kind in {tySequence, tyString} + genAsgnAux(p, n[0], n[1], noCopyNeeded=noCopy) proc genSwap(p: PProc, n: PNode) = - var a, b: TCompRes - gen(p, n.sons[1], a) - gen(p, n.sons[2], b) - var tmp = p.getTemp(false) - if mapType(p, skipTypes(n.sons[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.sons[0] else: n - gen(p, b.sons[0], a) - if skipTypes(b.sons[0].typ, abstractVarRange).kind == tyTuple: - r.res = makeJSString("Field" & $getFieldPosition(p, b.sons[1])) + let b = if n.kind == nkHiddenAddr: n[0] else: n + gen(p, b[0], a) + if skipTypes(b[0].typ, abstractVarRange).kind == tyTuple: + r.res = makeJSString("Field" & $getFieldPosition(p, b[1])) else: - if b.sons[1].kind != nkSym: internalError(p.config, b.sons[1].info, "genFieldAddr") - var f = b.sons[1].sym - if f.loc.r == nil: f.loc.r = mangleName(p.module, f) - r.res = makeJSString($f.loc.r) + if b[1].kind != nkSym: internalError(p.config, b[1].info, "genFieldAddr") + var f = b[1].sym + 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 proc genFieldAccess(p: PProc, n: PNode, r: var TCompRes) = - r.typ = etyNone - gen(p, n.sons[0], r) - let otyp = skipTypes(n.sons[0].typ, abstractVarRange) + gen(p, n[0], r) + r.typ = mapType(n.typ) + let otyp = skipTypes(n[0].typ, abstractVarRange) + + template mkTemp(i: int) = + if r.typ == etyBaseIndex: + if needsTemp(p, n[i]): + let tmp = p.getTemp + r.address = "($1 = $2, $1)[0]" % [tmp, r.res] + r.res = "$1[1]" % [tmp] + r.tmpLoc = tmp + else: + r.address = "$1[0]" % [r.res] + r.res = "$1[1]" % [r.res] if otyp.kind == tyTuple: r.res = ("$1.Field$2") % - [r.res, getFieldPosition(p, n.sons[1]).rope] + [r.res, getFieldPosition(p, n[1]).rope] + mkTemp(0) else: - if n.sons[1].kind != nkSym: internalError(p.config, n.sons[1].info, "genFieldAccess") - var f = n.sons[1].sym - if f.loc.r == nil: f.loc.r = mangleName(p.module, f) - r.res = "$1.$2" % [r.res, f.loc.r] + if n[1].kind != nkSym: internalError(p.config, n[1].info, "genFieldAccess") + var f = n[1].sym + 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 proc genAddr(p: PProc, n: PNode, r: var TCompRes) -proc genCheckedFieldAddr(p: PProc, n: PNode, r: var TCompRes) = - let m = if n.kind == nkHiddenAddr: n.sons[0] else: n - internalAssert p.config, m.kind == nkCheckedFieldExpr - genAddr(p, m, r) # XXX - -proc genCheckedFieldAccess(p: PProc, n: PNode, r: var TCompRes) = - genFieldAccess(p, n.sons[0], r) # XXX +proc genCheckedFieldOp(p: PProc, n: PNode, addrTyp: PType, r: var TCompRes) = + internalAssert p.config, n.kind == nkCheckedFieldExpr + # nkDotExpr to access the requested field + let accessExpr = n[0] + # nkCall to check if the discriminant is valid + var checkExpr = n[1] + + let negCheck = checkExpr[0].sym.magic == mNot + if negCheck: + checkExpr = checkExpr[^1] + + # Field symbol + var field = accessExpr[1].sym + internalAssert p.config, field.kind == skField + 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.snippet == "": disc.loc.snippet = mangleName(p.module, disc) + + var setx: TCompRes = default(TCompRes) + gen(p, checkExpr[1], setx) + + 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, "raiseFieldError2") + useMagic(p, "makeNimstrLit") + 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.snippet) + r.address = tmp + else: + r.typ = etyNone + 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: BiggestInt + a, b: TCompRes = default(TCompRes) + first: Int128 = Zero r.typ = etyBaseIndex - let m = if n.kind == nkHiddenAddr: n.sons[0] else: n - gen(p, m.sons[0], a) - gen(p, m.sons[1], b) - internalAssert p.config, a.typ != etyBaseIndex and b.typ != etyBaseIndex - r.address = a.res - var typ = skipTypes(m.sons[0].typ, abstractPtrs) - if typ.kind == tyArray: first = firstOrd(p.config, typ.sons[0]) - else: first = 0 + let m = if n.kind == nkHiddenAddr: n[0] else: n + gen(p, m[0], a) + gen(p, m[1], b) + #internalAssert p.config, a.typ != etyBaseIndex and b.typ != etyBaseIndex + let (x, tmp) = maybeMakeTemp(p, m[0], a) + r.address = x + var typ = skipTypes(m[0].typ, abstractPtrs) + if typ.kind == tyArray: + first = firstOrd(p.config, typ.indexType) if optBoundsCheck in p.options: useMagic(p, "chckIndx") - r.res = "chckIndx($1, $2, $3.length+$2-1)-$2" % [b.res, rope(first), a.res] + if first == 0: # save a couple chars + r.res = "chckIndx($1, 0, ($2).length - 1)" % [b.res, tmp] + else: + 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.sons[0].typ, abstractVarRange) - if ty.kind in {tyRef, tyPtr, tyLent}: 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 = etyNone - if r.res == nil: internalError(p.config, n.info, "genArrayAccess") - if ty.kind == tyCString: + r.typ = mapType(n.typ) + 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]): + let tmp = p.getTemp + r.address = "($1 = $2, $1)[0]" % [tmp, r.rdLoc] + r.res = "$1[1]" % [tmp] + r.tmpLoc = tmp + else: + let x = r.rdLoc + r.address = "$1[0]" % [x] + r.res = "$1[1]" % [x] else: r.res = "$1[$2]" % [r.address, r.res] - r.address = nil r.kind = resExpr template isIndirect(x: PSym): bool = let v = x ({sfAddrTaken, sfGlobal} * v.flags != {} and #(mapType(v.typ) != etyObject) and - {sfImportc, sfVolatile, sfExportc} * v.flags == {} and + {sfImportc, sfExportc} * v.flags == {} and v.kind notin {skProc, skFunc, skConverter, skMethod, skIterator, skConst, skTemp, skLet}) +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 + if isIndirect(s): + r.res = s.loc.snippet & "[0]" + else: + 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: + # 'var openArray' for instance produces an 'addr' but this is harmless: + 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) = - case n.sons[0].kind - of nkSym: - let s = n.sons[0].sym - if s.loc.r == nil: internalError(p.config, n.info, "genAddr: 3") - case s.kind - 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 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: - gen(p, n.sons[0], r) - #internalError(p.config, n.info, "genAddr: 4 " & renderTree(n)) - else: internalError(p.config, n.info, "genAddr: 2") - of nkCheckedFieldExpr: - genCheckedFieldAddr(p, n, r) - of nkDotExpr: - if mapType(p, n.typ) == etyBaseIndex: - genFieldAddr(p, n.sons[0], r) - else: - genFieldAccess(p, n.sons[0], r) - of nkBracketExpr: - var ty = skipTypes(n.sons[0].typ, abstractVarRange) - if ty.kind in MappedToObject: - gen(p, n.sons[0], r) - else: - let kindOfIndexedExpr = skipTypes(n.sons[0].sons[0].typ, abstractVarRange).kind - case kindOfIndexedExpr - of tyArray, tyOpenArray, tySequence, tyString, tyCString, tyVarargs: - genArrayAddr(p, n.sons[0], r) - of tyTuple: - genFieldAddr(p, n.sons[0], r) - else: internalError(p.config, n.sons[0].info, "expr(nkBracketExpr, " & $kindOfIndexedExpr & ')') - of nkObjDownConv: - gen(p, n.sons[0], r) - of nkHiddenDeref: - gen(p, n.sons[0].sons[0], r) - else: internalError(p.config, n.sons[0].info, "genAddr: " & $n.sons[0].kind) - -proc thisParam(p: PProc; typ: PType): PType = - discard + # 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) proc attachProc(p: PProc; content: Rope; s: PSym) = - let otyp = thisParam(p, s.typ) - if otyp != nil: - for i, cls in p.g.classes: - if sameType(cls[0], otyp): - add(p.g.classes[i][1], content) - return - p.g.classes.add((otyp, content)) - else: - add(p.g.code, content) + p.g.code.add(content) proc attachProc(p: PProc; s: PSym) = let newp = genProc(p, s) @@ -1078,44 +1620,75 @@ 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: add(owner.locals, 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 + if p.prc == s.owner or needsNoCopy(p, n): + return + var owner = p.up + while true: + if owner == nil: + 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.snippet, genTypeInfo(p, s.typ)] + owner.locals.add(owner.indentLine(copy)) + return + owner = owner.up + +proc genVarInit(p: PProc, v: PSym, n: PNode) 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.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 != {}: - r.address = "$1[0]" % [s.loc.r] - r.res = "$1[1]" % [s.loc.r] + if isIndirect(s): + r.address = "$1[0][0]" % [s.loc.snippet] + r.res = "$1[0][1]" % [s.loc.snippet] + else: + 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 != mNone 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 s.getBody.kind == nkEmpty: + elif s.kind == skMethod and getBody(p.module.graph, s).kind == nkEmpty: # we cannot produce code for the dispatcher yet: discard elif sfForward in s.flags: @@ -1123,84 +1696,92 @@ 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.sons[0] + 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 = resExpr - if a.typ == etyBaseIndex: - r.res = "$1[$2]" % [a.address, a.res] - elif it.kind == nkCall: + r.kind = a.kind + r.typ = mapType(p, n.typ) + if r.typ == etyBaseIndex: let tmp = p.getTemp - r.res = "($1 = $2, $1[0])[$1[1]]" % [tmp, a.res] - elif t == etyBaseIndex: - r.res = "$1[0]" % [a.res] + r.address = "($1 = $2, $1)[0]" % [tmp, a.rdLoc] + r.res = "$1[1]" % [tmp] + r.tmpLoc = tmp + elif a.typ == etyBaseIndex: + 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: - add(r.res, a.address) - add(r.res, ", ") - add(r.res, a.res) + r.res.add(a.address) + r.res.add(", ") + r.res.add(a.res) else: - add(r.res, a.res) + 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: - add(r.res, "$1[$2]" % [a.address, a.res]) + r.res.add("$1[$2]" % [a.address, a.res]) elif a.typ == etyBaseIndex: - add(r.res, a.address) - add(r.res, ", ") - add(r.res, a.res) + r.res.add(a.address) + r.res.add(", ") + r.res.add(a.res) if emitted != nil: inc emitted[] - elif n.typ.kind in {tyVar, tyLent} and n.kind in nkCallKinds and mapType(param.typ) == etyBaseIndex: + elif n.typ.kind in {tyVar, tyPtr, tyRef, tyLent, tyOwned} and + n.kind in nkCallKinds and mapType(param.typ) == etyBaseIndex: # this fixes bug #5608: let tmp = getTemp(p) - add(r.res, "($1 = $2, $1[0]), $1[1]" % [tmp, a.rdLoc]) + r.res.add("($1 = $2, $1[0]), $1[1]" % [tmp, a.rdLoc]) if emitted != nil: inc emitted[] else: - add(r.res, a.res) + r.res.add(a.res) proc genArgs(p: PProc, n: PNode, r: var TCompRes; start=1) = - add(r.res, "(") + r.res.add("(") var hasArgs = false - var typ = skipTypes(n.sons[0].typ, abstractInst) + var typ = skipTypes(n[0].typ, abstractInst) assert(typ.kind == tyProc) - assert(sonsLen(typ) == sonsLen(typ.n)) + assert(typ.len == typ.n.len) var emitted = start-1 - for i in countup(start, sonsLen(n) - 1): - let it = n.sons[i] + for i in start..<n.len: + let it = n[i] var paramType: PNode = nil - if i < sonsLen(typ): - assert(typ.n.sons[i].kind == nkSym) - paramType = typ.n.sons[i] + if i < typ.len: + assert(typ.n[i].kind == nkSym) + paramType = typ.n[i] if paramType.typ.isCompileTimeOnly: continue - if hasArgs: add(r.res, ", ") + if hasArgs: r.res.add(", ") if paramType.isNil: genArgNoParam(p, it, r) else: genArg(p, it, paramType.sym, r, addr emitted) inc emitted hasArgs = true - add(r.res, ")") + r.res.add(")") when false: # XXX look into this: let jsp = countJsParams(typ) @@ -1216,9 +1797,9 @@ proc genOtherArg(p: PProc; n: PNode; i: int; typ: PType; " but got only: " & $(n.len-1)) let it = n[i] var paramType: PNode = nil - if i < sonsLen(typ): - assert(typ.n.sons[i].kind == nkSym) - paramType = typ.n.sons[i] + if i < typ.len: + assert(typ.n[i].kind == nkSym) + paramType = typ.n[i] if paramType.typ.isCompileTimeOnly: return if paramType.isNil: genArgNoParam(p, it, r) @@ -1235,8 +1816,8 @@ proc genPatternCall(p: PProc; n: PNode; pat: string; typ: PType; case pat[i] of '@': var generated = 0 - for k in j ..< n.len: - if generated > 0: add(r.res, ", ") + for k in j..<n.len: + if generated > 0: r.res.add(", ") genOtherArg(p, n, k, typ, generated, r) inc i of '#': @@ -1246,11 +1827,11 @@ proc genPatternCall(p: PProc; n: PNode; pat: string; typ: PType; inc i of '\31': # unit separator - add(r.res, "#") + r.res.add("#") inc i of '\29': # group separator - add(r.res, "@") + r.res.add("@") inc i else: let start = i @@ -1258,53 +1839,58 @@ proc genPatternCall(p: PProc; n: PNode; pat: string; typ: PType; if pat[i] notin {'@', '#', '\31', '\29'}: inc(i) else: break if i - 1 >= start: - add(r.res, substr(pat, start, i - 1)) + r.res.add(substr(pat, start, i - 1)) 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.sons[0].sym.loc.r.data - internalAssert p.config, pat != nil + let pat = $n[0].sym.loc.snippet + internalAssert p.config, pat.len > 0 if pat.contains({'#', '(', '@'}): - var typ = skipTypes(n.sons[0].typ, abstractInst) + var typ = skipTypes(n[0].typ, abstractInst) assert(typ.kind == tyProc) genPatternCall(p, n, pat, typ, r) return if n.len != 1: - gen(p, n.sons[1], r) + 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 - add(r.res, ".") - var op: TCompRes - gen(p, n.sons[0], op) - add(r.res, op.res) + r.res.add(".") + var op: TCompRes = default(TCompRes) + gen(p, n[0], op) + r.res.add(op.res) genArgs(p, n, r, 2) proc genCall(p: PProc, n: PNode, r: var TCompRes) = - if n.sons[0].kind == nkSym and thisParam(p, n.sons[0].typ) != nil: - genInfixCall(p, n, r) - return - gen(p, n.sons[0], r) + gen(p, n[0], r) genArgs(p, n, r) + if n.typ != nil: + let t = mapType(n.typ) + if t == etyBaseIndex: + let tmp = p.getTemp + r.address = "($1 = $2, $1)[0]" % [tmp, r.rdLoc] + r.res = "$1[1]" % [tmp] + r.tmpLoc = tmp + r.typ = t proc genEcho(p: PProc, n: PNode, r: var TCompRes) = let n = n[1].skipConv internalAssert p.config, n.kind == nkBracket useMagic(p, "toJSStr") # Used in rawEcho useMagic(p, "rawEcho") - add(r.res, "rawEcho(") - for i in countup(0, sonsLen(n) - 1): - let it = n.sons[i] + r.res.add("rawEcho(") + for i in 0..<n.len: + let it = n[i] if it.typ.isCompileTimeOnly: continue - if i > 0: add(r.res, ", ") + if i > 0: r.res.add(", ") genArgNoParam(p, it, r) - add(r.res, ")") + r.res.add(")") r.kind = resExpr proc putToSeq(s: string, indirect: bool): Rope = @@ -1315,13 +1901,15 @@ proc createVar(p: PProc, typ: PType, indirect: bool): Rope proc createRecordVarAux(p: PProc, rec: PNode, excludedFieldIDs: IntSet, output: var Rope) = case rec.kind of nkRecList: - for i in countup(0, sonsLen(rec) - 1): - createRecordVarAux(p, rec.sons[i], excludedFieldIDs, output) + for i in 0..<rec.len: + createRecordVarAux(p, rec[i], excludedFieldIDs, output) of nkRecCase: - createRecordVarAux(p, rec.sons[0], excludedFieldIDs, output) - for i in countup(1, sonsLen(rec) - 1): - createRecordVarAux(p, lastSon(rec.sons[i]), excludedFieldIDs, output) + createRecordVarAux(p, rec[0], excludedFieldIDs, output) + for i in 1..<rec.len: + createRecordVarAux(p, lastSon(rec[i]), excludedFieldIDs, output) of nkSym: + # Do not produce code for void types + if isEmptyType(rec.sym.typ): return if rec.sym.id notin excludedFieldIDs: if output.len > 0: output.add(", ") output.addf("$#: ", [mangleName(p.module, rec.sym)]) @@ -1332,43 +1920,71 @@ proc createObjInitList(p: PProc, typ: PType, excludedFieldIDs: IntSet, output: v var t = typ if objHasTypeField(t): if output.len > 0: output.add(", ") - addf(output, "m_type: $1", [genTypeInfo(p, t)]) + output.addf("m_type: $1", [genTypeInfo(p, t)]) while t != nil: t = t.skipTypes(skipPtrs) createRecordVarAux(p, t.n, excludedFieldIDs, output) - t = t.sons[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 tyUint, tyUint32: "Uint32Array" - of tyUint16: "Uint16Array" - of tyUint8: "Uint8Array" + of tyInt64: + if optJsBigInt64 in conf.globalOptions: + "BigInt64Array" + else: + "" + of tyUInt, tyUInt32: "Uint32Array" + of tyUInt16: "Uint16Array" + of tyUInt8, tyChar, tyBool: "Uint8Array" + of tyUInt64: + if optJsBigInt64 in conf.globalOptions: + "BigUint64Array" + else: + "" of tyFloat32: "Float32Array" of tyFloat64, tyFloat: "Float64Array" - else: nil + 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: + 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: - 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: result = putToSeq("false", indirect) + of tyNil: + result = putToSeq("null", indirect) of tyArray: - let length = int(lengthOrd(p.config, t)) + let length = toInt(lengthOrd(p.config, t)) let e = elemType(t) - let jsTyp = arrayTypeForElemType(e) - if not jsTyp.isNil: + let jsTyp = arrayTypeForElemType(p.config, e) + if jsTyp.len > 0: result = "new $1($2)" % [rope(jsTyp), rope(length)] elif length > 32: useMagic(p, "arrayConstr") @@ -1380,72 +1996,84 @@ proc createVar(p: PProc, typ: PType, indirect: bool): Rope = result = rope("[") var i = 0 while i < length: - if i > 0: add(result, ", ") - add(result, createVar(p, e, false)) + if i > 0: result.add(", ") + result.add(createVar(p, e, false)) inc(i) - add(result, "]") + result.add("]") if indirect: result = "[$1]" % [result] of tyTuple: result = rope("{") - for i in 0..<t.sonsLen: - if i > 0: add(result, ", ") - addf(result, "Field$1: $2", [i.rope, - createVar(p, t.sons[i], false)]) - add(result, "}") + for i in 0..<t.len: + if i > 0: result.add(", ") + result.addf("Field$1: $2", [i.rope, + createVar(p, t[i], false)]) + result.add("}") if indirect: result = "[$1]" % [result] of tyObject: - var initList: Rope + var initList: Rope = "" createObjInitList(p, t, initIntSet(), initList) - result = ("{$1}") % [initList] + result = ("({$1})") % [initList] if indirect: result = "[$1]" % [result] - of tyVar, tyPtr, tyLent, tyRef: + of tyVar, tyPtr, tyRef, tyPointer: if mapType(p, t) == etyBaseIndex: result = putToSeq("[null, 0]", indirect) else: result = putToSeq("null", indirect) - of tySequence, tyOpt, tyString, tyCString, tyPointer, tyProc: + of tySequence, tyString: + result = putToSeq("[]", indirect) + 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) - useReloadingGuard = sfGlobal in v.flags and optHotCodeReloading in p.config.options + useReloadingGuard = sfGlobal in v.flags and p.config.hcrOn + useGlobalPragmas = sfGlobal in v.flags and ({sfPure, sfThread} * v.flags != {}) if v.constraint.isNil: if useReloadingGuard: lineF(p, "var $1;$n", varName) lineF(p, "if ($1 === undefined) {$n", varName) varCode = $varName + inc p.extraIndent + elif useGlobalPragmas: + lineF(p, "if (globalThis.$1 === undefined) {$n", varName) + varCode = "globalThis." & $varName + inc p.extraIndent else: varCode = "var $2" else: + # Is this really a thought through feature? this basically unused + # feature makes it impossible for almost all format strings in + # this function to be checked at compile time. varCode = v.constraint.strVal if n.kind == nkEmpty: - lineF(p, varCode & " = $3;$n", - [returnType, varName, createVar(p, v.typ, isIndirect(v))]) - if v.typ.kind in {tyVar, tyPtr, tyLent, tyRef} and mapType(p, v.typ) == etyBaseIndex: + if not isIndirect(v) and + v.typ.kind in {tyVar, tyPtr, tyLent, tyRef, tyOwned} and mapType(p, v.typ) == etyBaseIndex: + lineF(p, "var $1 = null;$n", [varName]) lineF(p, "var $1_Idx = 0;$n", [varName]) + else: + line(p, runtimeFormat(varCode & " = $3;$n", [returnType, varName, createVar(p, v.typ, isIndirect(v))])) else: 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") @@ -1454,141 +2082,151 @@ proc genVarInit(p: PProc, v: PSym, n: PNode) = let targetBaseIndex = {sfAddrTaken, sfGlobal} * v.flags == {} if a.typ == etyBaseIndex: if targetBaseIndex: - lineF(p, varCode & " = $3, $2_Idx = $4;$n", - [returnType, v.loc.r, a.address, a.res]) + line(p, runtimeFormat(varCode & " = $3, $2_Idx = $4;$n", + [returnType, v.loc.snippet, a.address, a.res])) else: - lineF(p, varCode & " = [$3, $4];$n", - [returnType, v.loc.r, a.address, a.res]) + if isIndirect(v): + line(p, runtimeFormat(varCode & " = [[$3, $4]];$n", + [returnType, v.loc.snippet, a.address, a.res])) + else: + line(p, runtimeFormat(varCode & " = [$3, $4];$n", + [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: - lineF(p, 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): - lineF(p, varCode & " = [$3];$n", [returnType, v.loc.r, s]) + line(p, runtimeFormat(varCode & " = [$3];$n", [returnType, v.loc.snippet, s])) else: - lineF(p, varCode & " = $3;$n", [returnType, v.loc.r, s]) + line(p, runtimeFormat(varCode & " = $3;$n", [returnType, v.loc.snippet, s])) - if useReloadingGuard: + 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 countup(0, sonsLen(n) - 1): - var a = n.sons[i] + for i in 0..<n.len: + var a = n[i] if a.kind != nkCommentStmt: if a.kind == nkVarTuple: - let unpacked = lowerTupleUnpacking(p.module.graph, a, p.prc) + let unpacked = lowerTupleUnpacking(p.module.graph, a, p.module.idgen, p.prc) genStmt(p, unpacked) else: assert(a.kind == nkIdentDefs) - assert(a.sons[0].kind == nkSym) - var v = a.sons[0].sym - if lfNoDecl notin v.loc.flags and sfImportc notin v.flags: - genLineDir(p, a) - genVarInit(p, v, a.sons[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) - add(p.g.constants, p.body) + 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 - gen(p, n.sons[1], a) - var t = skipTypes(n.sons[1].typ, abstractVar).sons[0] - lineF(p, "$1 = $2;$n", [a.res, createVar(p, t, false)]) + var a: TCompRes = default(TCompRes) + gen(p, n[1], a) + var t = skipTypes(n[1].typ, abstractVar)[0] + if mapType(t) == etyObject: + lineF(p, "$1 = $2;$n", [a.rdLoc, createVar(p, t, false)]) + elif a.typ == etyBaseIndex: + lineF(p, "$1 = [$3]; $2 = 0;$n", [a.address, a.res, createVar(p, t, false)]) + else: + lineF(p, "$1 = [[$2], 0];$n", [a.rdLoc, createVar(p, t, false)]) proc genNewSeq(p: PProc, n: PNode) = - var x, y: TCompRes - gen(p, n.sons[1], x) - gen(p, n.sons[2], y) - let t = skipTypes(n.sons[1].typ, abstractVar).sons[0] - lineF(p, "$1 = new Array($2); for (var i=0;i<$2;++i) {$1[i]=$3;}", [ + 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; }", [ x.rdLoc, y.rdLoc, createVar(p, t, false)]) proc genOrd(p: PProc, n: PNode, r: var TCompRes) = - case skipTypes(n.sons[1].typ, abstractVar).kind - of tyEnum, tyInt..tyUInt64, tyChar: gen(p, n.sons[1], r) - of tyBool: unaryExpr(p, n, r, "", "($1 ? 1:0)") + case skipTypes(n[1].typ, abstractVar + abstractRange).kind + 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.sons[1], a) + gen(p, n[1], a) r.kind = resExpr - if skipTypes(n.sons[1].typ, abstractVarRange).kind == tyChar: + if skipTypes(n[1].typ, abstractVarRange).kind == tyChar: r.res.add("[$1].concat(" % [a.res]) else: - r.res.add("($1.slice(0,-1)).concat(" % [a.res]) + r.res.add("($1).concat(" % [a.res]) - for i in countup(2, sonsLen(n) - 2): - gen(p, n.sons[i], a) - if skipTypes(n.sons[i].typ, abstractVarRange).kind == tyChar: + 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.slice(0,-1)," % [a.res]) + r.res.add("$1," % [a.res]) - gen(p, n.sons[sonsLen(n) - 1], a) - if skipTypes(n.sons[sonsLen(n) - 1].typ, abstractVarRange).kind == tyChar: - r.res.add("[$1, 0])" % [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]) -proc genToArray(p: PProc; n: PNode; r: var TCompRes) = - # we map mArray to PHP's array constructor, a mild hack: - var a, b: TCompRes - r.kind = resExpr - r.res = rope("array(") - let x = skipConv(n[1]) - if x.kind == nkBracket: - for i in countup(0, x.len - 1): - let it = x[i] - if it.kind in {nkPar, nkTupleConstr} and it.len == 2: - if i > 0: r.res.add(", ") - gen(p, it[0], a) - gen(p, it[1], b) - r.res.add("$# => $#" % [a.rdLoc, b.rdLoc]) - else: - localError(p.config, it.info, "'toArray' needs tuple constructors") - else: - localError(p.config, x.info, "'toArray' needs an array literal") - r.res.add(")") - -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) - add(r.res, magic & "(") - var a: TCompRes + r.res.add(magic & "(") + var a: TCompRes = default(TCompRes) - gen(p, n.sons[1], a) + 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: - add(r.res, a.res) - add(r.res, ", null") + if a.address.len == 0: + r.res.add(a.res) + r.res.add(", null") else: - add(r.res, "$1, $2" % [a.address, a.res]) + r.res.add("$1, $2" % [a.address, a.res]) else: - add(r.res, a.res) + r.res.add(a.res) - if not typ.isNil: - add(r.res, ", ") - add(r.res, typ) - add(r.res, ")") + 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.sons[1].typ, abstractVarRange) - case t.kind: + let t = skipTypes(n[1].typ, abstractVarRange) + case t.kind of tyInt..tyInt64, tyUInt..tyUInt64: genReprAux(p, n, r, "reprInt") of tyChar: @@ -1611,11 +2249,13 @@ proc genRepr(p: PProc, n: PNode, r: var TCompRes) = genReprAux(p, n, r, "reprJSONStringify") else: genReprAux(p, n, r, "reprAny", genTypeInfo(p, t)) + r.kind = resExpr proc genOf(p: PProc, n: PNode, r: var TCompRes) = - var x: TCompRes - let t = skipTypes(n.sons[2].typ, abstractVarRange+{tyRef, tyPtr, tyLent, tyTypeDesc}) - gen(p, n.sons[1], x) + var x: TCompRes = default(TCompRes) + let t = skipTypes(n[2].typ, + abstractVarRange+{tyRef, tyPtr, tyLent, tyTypeDesc, tyOwned}) + gen(p, n[1], x) if tfFinal in t.flags: r.res = "($1.m_type == $2)" % [x.res, genTypeInfo(p, t)] else: @@ -1623,50 +2263,97 @@ proc genOf(p: PProc, n: PNode, r: var TCompRes) = r.res = "isObj($1.m_type, $2)" % [x.res, genTypeInfo(p, t)] r.kind = resExpr -proc genReset(p: PProc, n: PNode) = - var x: TCompRes - useMagic(p, "genericReset") - gen(p, n.sons[1], x) - addf(p.body, "$1 = genericReset($1, $2);$n", [x.res, - genTypeInfo(p, n.sons[1].typ)]) +proc genDefault(p: PProc, n: PNode; r: var TCompRes) = + r.res = createVar(p, n.typ, indirect = false) + r.kind = resExpr + +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: + var y: TCompRes = default(TCompRes) + genDefault(p, n[1], y) + let (a, _) = maybeMakeTempAssignable(p, n[1], x) + lineF(p, "$1 = $2;$n", [a, y.rdLoc]) + +proc genMove(p: PProc; n: PNode; r: var TCompRes) = + var a: TCompRes = default(TCompRes) + r.kind = resVal + r.res = p.getTemp() + gen(p, n[1], a) + lineF(p, "$1 = $2;$n", [r.rdLoc, a.rdLoc]) + 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 = default(TCompRes) + r.res = rope("[") + r.kind = resExpr + for i in 0 ..< n.len: + if i > 0: r.res.add(", ") + gen(p, n[i], a) + if a.typ == etyBaseIndex: + r.res.addf("[$1, $2]", [a.address, a.res]) + else: + if not needsNoCopy(p, n[i]): + let typ = n[i].typ.skipTypes(abstractInst) + useMagic(p, "nimCopy") + a.res = "nimCopy(null, $1, $2)" % [a.rdLoc, genTypeInfo(p, typ)] + r.res.add(a.res) + r.res.add("]") proc genMagic(p: PProc, n: PNode, r: var TCompRes) = var a: TCompRes line, filen: Rope - var op = n.sons[0].sym.magic + var op = n[0].sym.magic case op - of mOr: genOr(p, n.sons[1], n.sons[2], r) - of mAnd: genAnd(p, n.sons[1], n.sons[2], r) + of mOr: genOr(p, n[1], n[2], r) + of mAnd: genAnd(p, n[1], n[2], r) of mAddI..mStrToStr: arith(p, n, r, op) of mRepr: genRepr(p, n, r) of mSwap: genSwap(p, n) - of mUnaryLt: - # XXX: range checking? - if not (optOverflowCheck in p.options): unaryExpr(p, n, r, "", "$1 - 1") - else: unaryExpr(p, n, r, "subInt", "subInt($1, 1)") of mAppendStrCh: binaryExpr(p, n, r, "addChar", - "if ($1 != null) { addChar($1, $2); } else { $1 = [$2, 0]; }") + "addChar($1, $2);") of mAppendStrStr: - if skipTypes(n.sons[1].typ, abstractVarRange).kind == tyCString: - binaryExpr(p, n, r, "", "if ($1 != null) { $1 += $2; } else { $1 = $2; }") + var lhs, rhs: TCompRes = default(TCompRes) + gen(p, n[1], lhs) + gen(p, n[2], rhs) + + 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] else: - binaryExpr(p, n, r, "", - "if ($1 != null) { $1 = ($1.slice(0, -1)).concat($2); } else { $1 = $2;}") - # XXX: make a copy of $2, because of Javascript's sucking semantics + let (a, tmp) = maybeMakeTemp(p, n[1], lhs) + r.res = "$1.push.apply($3, $2);" % [a, rhs.rdLoc, tmp] + r.kind = resExpr of mAppendSeqElem: - var x, y: TCompRes - gen(p, n.sons[1], x) - gen(p, n.sons[2], y) - if needsNoCopy(p, n[2]): - r.res = "if ($1 != null) { $1.push($2); } else { $1 = [$2]; }" % [x.rdLoc, y.rdLoc] + var x, y: TCompRes = default(TCompRes) + gen(p, n[1], x) + gen(p, n[2], y) + if mapType(n[2].typ) == etyBaseIndex: + let c = "[$1, $2]" % [y.address, y.res] + r.res = "$1.push($2);" % [x.rdLoc, c] + elif needsNoCopy(p, n[2]): + r.res = "$1.push($2);" % [x.rdLoc, y.rdLoc] else: useMagic(p, "nimCopy") let c = getTemp(p, defineInLocals=false) lineF(p, "var $1 = nimCopy(null, $2, $3);$n", [c, y.rdLoc, genTypeInfo(p, n[2].typ)]) - r.res = "if ($1 != null) { $1.push($2); } else { $1 = [$2]; }" % [x.rdLoc, c] + r.res = "$1.push($2);" % [x.rdLoc, c] r.kind = resExpr of mConStrStr: genConStrStr(p, n, r) @@ -1676,48 +2363,93 @@ proc genMagic(p: PProc, n: PNode, r: var TCompRes) = binaryExpr(p, n, r, "cmpStrings", "(cmpStrings($1, $2) <= 0)") of mLtStr: binaryExpr(p, n, r, "cmpStrings", "(cmpStrings($1, $2) < 0)") - of mIsNil: unaryExpr(p, n, r, "", "($1 === null)") + of mIsNil: + # we want to accept undefined, so we == + if mapType(n[1].typ) != etyBaseIndex: + unaryExpr(p, n, r, "", "($1 == null)") + else: + var x: TCompRes = default(TCompRes) + gen(p, n[1], x) + r.res = "($# == null && $# === 0)" % [x.address, x.res] of mEnumToStr: genRepr(p, n, r) of mNew, mNewFinalize: genNew(p, n) - of mSizeOf: r.res = rope(getSize(p.config, n.sons[1].typ)) - of mChr, mArrToSeq: gen(p, n.sons[1], r) # nothing to do + of mChr: gen(p, n[1], r) + of mArrToSeq: + # only array literals doesn't need copy + if n[1].kind == nkBracket: + genJSArrayConstr(p, n[1], r) + else: + 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 mOpenArrayToSeq: + genCall(p, n, r) + of mDestroy, mTrace: discard "ignore calls to the default destructor" of mOrd: genOrd(p, n, r) - of mLengthStr: - if n.sons[1].typ.skipTypes(abstractInst).kind == tyCString: - unaryExpr(p, n, r, "", "($1 != null ? $1.length : 0)") - else: - unaryExpr(p, n, r, "", "($1 != null ? $1.length-1 : 0)") - of mXLenStr: unaryExpr(p, n, r, "", "$1.length-1") - of mLengthSeq, mLengthOpenArray, mLengthArray: - unaryExpr(p, n, r, "", "($1 != null ? $1.length : 0)") - of mXLenSeq: - unaryExpr(p, n, r, "", "$1.length") + of mLengthStr, mLengthSeq, mLengthOpenArray, mLengthArray: + var x: TCompRes = default(TCompRes) + gen(p, n[1], x) + 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: - if skipTypes(n.sons[1].typ, abstractVar).kind == tyString: - unaryExpr(p, n, r, "", "($1 != null ? ($1.length-2) : -1)") + var x: TCompRes = default(TCompRes) + gen(p, n[1], x) + 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: - unaryExpr(p, n, r, "", "($1 != null ? ($1.length-1) : -1)") + 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($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($1, $2)") + else: binaryExpr(p, n, r, "subInt", "$1 = subInt($3, $2)", true) of mSetLengthStr: - binaryExpr(p, n, r, "", "$1.length = $2+1; $1[$1.length-1] = 0") + 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 - gen(p, n.sons[1], x) - gen(p, n.sons[2], y) - let t = skipTypes(n.sons[1].typ, abstractVar).sons[0] - r.res = """if ($1.length < $2) { for (var i=$1.length;i<$2;++i) $1.push($3); } - else { $1.length = $2; }""" % [x.rdLoc, y.rdLoc, createVar(p, t, false)] + 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); } + else { $4.length = $5; }""" % [a, b, createVar(p, t, false), tmp, tmp2] r.kind = resExpr of mCard: unaryExpr(p, n, r, "SetCard", "SetCard($1)") of mLtSet: binaryExpr(p, n, r, "SetLt", "SetLt($1, $2)") @@ -1733,128 +2465,209 @@ 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 mReset: 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.sons[0].sym.name.s) - of mCopyStr: - binaryExpr(p, n, r, "", "($1.slice($2))") - of mCopyStrLast: - ternaryExpr(p, n, r, "", "($1.slice($2, ($3)+1).concat(0))") + localError(p.config, n.info, errXMustBeCompileTime % n[0].sym.name.s) of mNewString: unaryExpr(p, n, r, "mnewString", "mnewString($1)") of mNewStringOfCap: unaryExpr(p, n, r, "mnewString", "mnewString(0)") of mDotDot: - genProcForSymIfNeeded(p, n.sons[0].sym) + genProcForSymIfNeeded(p, n[0].sym) genCall(p, n, r) of mParseBiggestFloat: useMagic(p, "nimParseBiggestFloat") genCall(p, n, r) - of mArray: - genCall(p, n, r) + of mSlice: + # arr.slice([begin[, end]]): 'end' is exclusive + 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.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 - for i in countup(0, sonsLen(n) - 1): - if i > 0: add(r.res, ", ") - var it = n.sons[i] + for i in 0..<n.len: + if i > 0: r.res.add(", ") + var it = n[i] if it.kind == nkRange: - gen(p, it.sons[0], a) - gen(p, it.sons[1], b) - addf(r.res, "[$1, $2]", [a.res, b.res]) + gen(p, it[0], a) + gen(p, it[1], b) + + if it[0].typ.kind == tyBool: + r.res.addf("$1, $2", [a.res, b.res]) + else: + r.res.addf("[$1, $2]", [a.res, b.res]) else: gen(p, it, a) - add(r.res, a.res) - add(r.res, ")") + r.res.add(a.res) + r.res.add(")") # emit better code for constant sets: if isDeepConstExpr(n): inc(p.g.unique) let tmp = rope("ConstSet") & rope(p.g.unique) - addf(p.g.constants, "var $1 = $2;$n", [tmp, r.res]) + p.g.constants.addf("var $1 = $2;$n", [tmp, r.res]) r.res = tmp proc genArrayConstr(p: PProc, n: PNode, r: var TCompRes) = - var a: TCompRes - r.res = rope("[") - r.kind = resExpr - for i in countup(0, sonsLen(n) - 1): - if i > 0: add(r.res, ", ") - gen(p, n.sons[i], a) - add(r.res, a.res) - add(r.res, "]") + ## Constructs array or sequence. + ## Nim array of uint8..uint32, int8..int32 maps to JS typed arrays. + ## Nim sequence maps to JS array. + var t = skipTypes(n.typ, abstractInst) + let e = elemType(t) + 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 = default(TCompRes) + r.res = "new $1([" % [rope(jsTyp)] + r.kind = resExpr + for i in 0 ..< n.len: + if i > 0: r.res.add(", ") + gen(p, n[i], a) + r.res.add(a.res) + r.res.add("])") + else: + 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 countup(0, sonsLen(n) - 1): - if i > 0: add(r.res, ", ") - var it = n.sons[i] - if it.kind == nkExprColonExpr: it = it.sons[1] + for i in 0..<n.len: + if i > 0: r.res.add(", ") + var it = n[i] + if it.kind == nkExprColonExpr: it = it[1] gen(p, it, a) - addf(r.res, "Field$#: $#", [i.rope, a.res]) + let typ = it.typ.skipTypes(abstractInst) + if a.typ == etyBaseIndex: + r.res.addf("Field$#: [$#, $#]", [i.rope, a.address, a.res]) + else: + if not needsNoCopy(p, it): + useMagic(p, "nimCopy") + a.res = "nimCopy(null, $1, $2)" % [a.rdLoc, genTypeInfo(p, typ)] + r.res.addf("Field$#: $#", [i.rope, a.res]) 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() - for i in countup(1, sonsLen(n) - 1): - if i > 1: add(initList, ", ") - var it = n.sons[i] + let nTyp = n.typ.skipTypes(abstractInst) + for i in 1..<n.len: + if i > 1: initList.add(", ") + var it = n[i] internalAssert p.config, it.kind == nkExprColonExpr - let val = it.sons[1] + let val = it[1] gen(p, val, a) - var f = it.sons[0].sym - if f.loc.r == nil: f.loc.r = mangleName(p.module, f) - fieldIDs.incl(f.id) + var f = it[0].sym + 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 (typ.kind in IntegralTypes+{tyCstring, tyRef, tyPtr} and - mapType(p, typ) != etyBaseIndex) or needsNoCopy(p, it.sons[1]): - discard + if a.typ == etyBaseIndex: + initList.addf("$#: [$#, $#]", [f.loc.snippet, a.address, a.res]) else: - useMagic(p, "nimCopy") - a.res = "nimCopy(null, $1, $2)" % [a.rdLoc, genTypeInfo(p, typ)] - addf(initList, "$#: $#", [f.loc.r, a.res]) + if not needsNoCopy(p, val): + useMagic(p, "nimCopy") + a.res = "nimCopy(null, $1, $2)" % [a.rdLoc, genTypeInfo(p, typ)] + initList.addf("$#: $#", [f.loc.snippet, a.res]) let t = skipTypes(n.typ, abstractInst + skipPtrs) createObjInitList(p, t, fieldIDs, initList) r.res = ("{$1}") % [initList] proc genConv(p: PProc, n: PNode, r: var TCompRes) = var dest = skipTypes(n.typ, abstractVarRange) - var src = skipTypes(n.sons[1].typ, abstractVarRange) - gen(p, n.sons[1], r) + var src = skipTypes(n[1].typ, abstractVarRange) + gen(p, n[1], r) if dest.kind == src.kind: # no-op conversion return - case dest.kind: - of tyBool: + let toInt = (dest.kind in tyInt..tyInt32) + let fromInt = (src.kind in tyInt..tyInt32) + let toUint = (dest.kind in tyUInt..tyUInt32) + 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] + elif dest.kind == tyBool: r.res = "(!!($1))" % [r.res] r.kind = resExpr - of tyInt: - r.res = "(($1)|0)" % [r.res] + elif toInt: + 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 proc upConv(p: PProc, n: PNode, r: var TCompRes) = - gen(p, n.sons[0], r) # XXX + gen(p, n[0], r) # XXX proc genRangeChck(p: PProc, n: PNode, r: var TCompRes, magic: string) = - var a, b: TCompRes - gen(p, n.sons[0], r) - if optRangeCheck in p.options: - gen(p, n.sons[1], a) - gen(p, n.sons[2], b) + var a, b: TCompRes = default(TCompRes) + gen(p, n[0], r) + 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") r.res = "chckRange($1, $2, $3)" % [r.res, a.res, b.res] r.kind = resExpr @@ -1862,11 +2675,11 @@ proc genRangeChck(p: PProc, n: PNode, r: var TCompRes, magic: string) = proc convStrToCStr(p: PProc, n: PNode, r: var TCompRes) = # we do an optimization here as this is likely to slow down # much of the code otherwise: - if n.sons[0].kind == nkCStringToString: - gen(p, n.sons[0].sons[0], r) + if n[0].kind == nkCStringToString: + gen(p, n[0][0], r) else: - gen(p, n.sons[0], r) - if r.res == nil: internalError(p.config, n.info, "convStrToCStr") + gen(p, n[0], r) + if r.res == "": internalError(p.config, n.info, "convStrToCStr") useMagic(p, "toJSStr") r.res = "toJSStr($1)" % [r.res] r.kind = resExpr @@ -1874,11 +2687,11 @@ proc convStrToCStr(p: PProc, n: PNode, r: var TCompRes) = proc convCStrToStr(p: PProc, n: PNode, r: var TCompRes) = # we do an optimization here as this is likely to slow down # much of the code otherwise: - if n.sons[0].kind == nkStringToCString: - gen(p, n.sons[0].sons[0], r) + if n[0].kind == nkStringToCString: + gen(p, n[0][0], r) else: - gen(p, n.sons[0], r) - if r.res == nil: internalError(p.config, n.info, "convCStrToStr") + gen(p, n[0], r) + if r.res == "": internalError(p.config, n.info, "convCStrToStr") useMagic(p, "cstrToNimstr") r.res = "cstrToNimstr($1)" % [r.res] r.kind = resExpr @@ -1886,15 +2699,15 @@ proc convCStrToStr(p: PProc, n: PNode, r: var TCompRes) = proc genReturnStmt(p: PProc, n: PNode) = if p.procDef == nil: internalError(p.config, n.info, "genReturnStmt") p.beforeRetNeeded = true - if n.sons[0].kind != nkEmpty: - genStmt(p, n.sons[0]) + if n[0].kind != nkEmpty: + genStmt(p, n[0]) else: genLineDir(p, n) lineF(p, "break BeforeRet;$n", []) proc frameCreate(p: PProc; procname, filename: Rope): Rope = - let frameFmt = - "var F={procname:$1,prev:framePtr,filename:$2,line:0};$n" + const frameFmt = + "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", [])) @@ -1906,110 +2719,131 @@ proc genProcBody(p: PProc, prc: PSym): Rope = if hasFrameInfo(p): result = frameCreate(p, makeJSString(prc.owner.name.s & '.' & prc.name.s), - makeJSString(toFilename(p.config, prc.info))) + 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: - add(result, p.body) + result.add(p.body) if prc.typ.callConv == ccSysCall: result = ("try {$n$1} catch (e) {$n" & " alert(\"Unhandled exception:\\n\" + e.message + \"\\n\"$n}") % [result] if hasFrameInfo(p): - add(result, frameDestroy(p)) + result.add(frameDestroy(p)) -proc optionaLine(p: Rope): Rope = - if p == nil: - return nil +proc optionalLine(p: Rope): Rope = + 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.sons[0] != nil and sfPure notin prc.flags: - resultSym = prc.ast.sons[resultPos].sym + 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) - let resVar = createVar(p, resultSym.typ, isIndirect(resultSym)) - resultAsgn = p.indentLine(("var $# = $#;$n") % [mname, resVar]) - if resultSym.typ.kind in {tyVar, tyPtr, tyLent, tyRef} and - mapType(p, resultSym.typ) == etyBaseIndex: + # 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 + if useRawPointer: + resultAsgn = p.indentLine(("var $# = null;$n") % [mname]) resultAsgn.add p.indentLine("var $#_Idx = 0;$n" % [mname]) - gen(p, prc.ast.sons[resultPos], a) + else: + let resVar = createVar(p, resultSym.typ, isIndirect(resultSym)) + resultAsgn = p.indentLine(("var $# = $#;$n") % [mname, resVar]) + gen(p, prc.ast[resultPos], a) if mapType(p, resultSym.typ) == etyBaseIndex: returnStmt = "return [$#, $#];$n" % [a.address, a.res] else: returnStmt = "return $#;$n" % [a.res] - p.nested: genStmt(p, prc.getBody) + 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) + + p.nested: genStmt(p, transformedBody) + + + if optLineDir in p.config.options: + result = lineDir(p.config, prc.info, toLinenumber(prc.info)) var def: Rope if not prc.constraint.isNil: - def = (prc.constraint.strVal & " {$n$#$#$#$#$#") % + def = runtimeFormat(prc.constraint.strVal & " {$n$#$#$#$#$#", [ returnType, name, header, - optionaLine(p.globals), - optionaLine(p.locals), - optionaLine(resultAsgn), - optionaLine(genProcBody(p, prc)), - optionaLine(p.indentLine(returnStmt))] + optionalLine(p.globals), + optionalLine(p.locals), + optionalLine(resultAsgn), + optionalLine(genProcBody(p, prc)), + optionalLine(p.indentLine(returnStmt))]) else: - result = ~"\L" + # if optLineDir in p.config.options: + # result.add("\L") - if optHotCodeReloading in p.config.options: + if p.config.hcrOn: # Here, we introduce thunks that create the equivalent of a jump table # for all global functions, because references to them may be stored # in JavaScript variables. The added indirection ensures that such # 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, - optionaLine(p.globals), - optionaLine(p.locals), - optionaLine(resultAsgn), - optionaLine(genProcBody(p, prc)), - optionaLine(p.indentLine(returnStmt))] + optionalLine(p.globals), + optionalLine(p.locals), + optionalLine(resultAsgn), + optionalLine(genProcBody(p, prc)), + optionalLine(p.indentLine(returnStmt))] 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.sons[1]) + 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) = var dest = skipTypes(n.typ, abstractVarRange) - var src = skipTypes(n.sons[1].typ, abstractVarRange) - gen(p, n.sons[1], r) + var src = skipTypes(n[1].typ, abstractVarRange) + gen(p, n[1], r) if dest.kind == src.kind: # no-op conversion return @@ -2018,39 +2852,72 @@ 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: - let trimmer = unsignedTrimmer(dest.size) - r.res = "($1 $2)" % [r.res, trimmer] - 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.typ = etyBaseIndex + elif (dest.kind == tyPtr and mapType(p, dest) == etyObject) and src.kind == tyPointer: + r.res = r.address + r.typ = etyObject 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): @@ -2065,16 +2932,22 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = r.kind = resExpr of nkStrLit..nkTripleStrLit: if skipTypes(n.typ, abstractVarRange).kind == tyString: - useMagic(p, "makeNimstrLit") - r.res = "makeNimstrLit($1)" % [makeJSString(n.strVal)] + if n.strVal.len <= 64: + r.res = makeJsNimStrLit(n.strVal) + else: + useMagic(p, "makeNimstrLit") + r.res = "makeNimstrLit($1)" % [makeJSString(n.strVal)] else: r.res = makeJSString(n.strVal, false) r.kind = resExpr of nkFloatLit..nkFloat64Lit: let f = n.floatVal case classify(f) - of fcNaN: - r.res = rope"NaN" + of fcNan: + if signbit(f): + r.res = rope"-NaN" + else: + r.res = rope"NaN" of fcNegZero: r.res = rope"-0.0" of fcZero: @@ -2083,30 +2956,53 @@ 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): genLineDir(p, n) - if (n.sons[0].kind == nkSym) and (n.sons[0].sym.magic != mNone): + if isEmptyType(n.typ): + genLineDir(p, n) + if (n[0].kind == nkSym) and (n[0].sym.magic != mNone): genMagic(p, n, r) - elif n.sons[0].kind == nkSym and sfInfixCall in n.sons[0].sym.flags and + elif n[0].kind == nkSym and sfInfixCall in n[0].sym.flags and n.len >= 1: 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: genCheckedFieldAccess(p, n, r) - of nkObjDownConv: gen(p, n.sons[0], r) + of nkCheckedFieldExpr: genCheckedFieldOp(p, n, nil, r) + of nkObjDownConv: gen(p, n[0], r) of nkObjUpConv: upConv(p, n, r) of nkCast: genCast(p, n, r) of nkChckRangeF: genRangeChck(p, n, r, "chckRangeF") @@ -2116,26 +3012,26 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = of nkCStringToString: convCStrToStr(p, n, r) of nkEmpty: discard of nkLambdaKinds: - let s = n.sons[namePos].sym + let s = n[namePos].sym discard mangleName(p.module, s) - r.res = s.loc.r - if lfNoDecl in s.loc.flags or s.magic != mNone: 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): - add(p.locals, genProc(p, s)) + p.locals.add(genProc(p, s)) of nkType: r.res = genTypeInfo(p, n.typ) of nkStmtList, nkStmtListExpr: # this shows the distinction is nice for backends and should be kept # in the frontend let isExpr = not isEmptyType(n.typ) - for i in countup(0, sonsLen(n) - 1 - isExpr.ord): - genStmt(p, n.sons[i]) + for i in 0..<n.len - isExpr.ord: + genStmt(p, n[i]) if isExpr: gen(p, lastSon(n), r) of nkBlockStmt, nkBlockExpr: genBlock(p, n, r) of nkIfStmt, nkIfExpr: genIf(p, n, r) of nkWhen: # This is "when nimvm" node - gen(p, n.sons[1].sons[0], r) + gen(p, n[1][0], r) of nkWhileStmt: genWhileStmt(p, n) of nkVarSection, nkLetSection: genVarStmt(p, n) of nkConstSection: discard @@ -2145,140 +3041,172 @@ 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.sons[0].kind != nkEmpty: + if n[0].kind != nkEmpty: genLineDir(p, n) - gen(p, n.sons[0], r) - of nkAsmStmt: genAsmOrEmitStmt(p, n) - of nkTryStmt: genTry(p, n, r) + gen(p, n[0], r) + 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, nkIteratorDef, nkIncludeStmt, + of nkTypeSection, nkCommentStmt, nkIncludeStmt, nkImportStmt, nkImportExceptStmt, nkExportStmt, nkExportExceptStmt, - nkFromStmt, nkTemplateDef, nkMacroDef, nkStaticStmt: discard + nkFromStmt, nkTemplateDef, nkMacroDef, nkIteratorDef, nkStaticStmt, + nkMixinStmt, nkBindStmt: discard of nkPragma: genPragma(p, n) of nkProcDef, nkFuncDef, nkMethodDef, nkConverterDef: - var s = n.sons[namePos].sym + var s = n[namePos].sym if {sfExportc, sfCompilerProc} * s.flags == {sfExportc}: - genSym(p, n.sons[namePos], r) - r.res = nil + genSym(p, n[namePos], r) + r.res = "" of nkGotoState, nkState: - internalError(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 = - result = ( - "/* Generated by the Nim Compiler v$1 */$n" & - "/* (c) " & copyrightYear & " Andreas Rumpf */$n$n" & - "var framePtr = null;$n" & - "var excHandler = 0;$n" & - "var lastJSError = null;$n" & - "if (typeof Int8Array === 'undefined') Int8Array = Array;$n" & - "if (typeof Int16Array === 'undefined') Int16Array = Array;$n" & - "if (typeof Int32Array === 'undefined') Int32Array = Array;$n" & - "if (typeof Uint8Array === 'undefined') Uint8Array = Array;$n" & - "if (typeof Uint16Array === 'undefined') Uint16Array = Array;$n" & - "if (typeof Uint32Array === 'undefined') Uint32Array = Array;$n" & - "if (typeof Float32Array === 'undefined') Float32Array = Array;$n" & - "if (typeof Float64Array === 'undefined') Float64Array = Array;$n") % - [rope(VersionAsString)] + ## Generate the JS header. + result = rope("""/* Generated by the Nim Compiler v$1 */ + var framePtr = null; + var excHandler = 0; + var lastJSError = null; + """.unindent.format(VersionAsString)) + +proc addHcrInitGuards(p: PProc, n: PNode, + moduleLoadedVar: Rope, inInitGuard: var bool) = + if n.kind == nkStmtList: + for child in n: + addHcrInitGuards(p, child, moduleLoadedVar, inInitGuard) + else: + let stmtShouldExecute = n.kind in { + nkProcDef, nkFuncDef, nkMethodDef,nkConverterDef, + nkVarSection, nkLetSection} or nfExecuteOnReload in n.flags + + if inInitGuard: + if stmtShouldExecute: + dec p.extraIndent + line(p, "}\L") + inInitGuard = false + else: + if not stmtShouldExecute: + lineF(p, "if ($1 == undefined) {$n", [moduleLoadedVar]) + inc p.extraIndent + inInitGuard = true + + 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: - add(p.body, frameCreate(p, + p.body.add(frameCreate(p, makeJSString("module " & p.module.module.name.s), - makeJSString(toFilename(p.config, p.module.module.info)))) - genStmt(p, n) + makeJSString(toFilenameOption(p.config, p.module.module.info.fileIndex, foStacktrace)))) + var transformedN = transformStmt(p.module.graph, p.module.idgen, p.module.module, n) + if sfInjectDestructors in p.module.module.flags: + transformedN = injectDestructorCalls(p.module.graph, p.module.idgen, p.module.module, transformedN) + 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, p.config) + lineF(p, "var $1;$n", [moduleLoadedVar]) + var inGuardedBlock = false + + addHcrInitGuards(p, transformedN, moduleLoadedVar, inGuardedBlock) + + if inGuardedBlock: + dec p.extraIndent + line(p, "}\L") + + lineF(p, "$1 = true;$n", [moduleLoadedVar]) + else: + genStmt(p, transformedN) + if optStackTrace in p.options: - add(p.body, frameDestroy(p)) + 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 = newProc(globals, m, nil, m.module.options) + var p = newInitProc(globals, m) + m.initProc = p p.unique = globals.unique genModule(p, n) - add(p.g.code, p.locals) - add(p.g.code, p.body) + 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 = newProc(globals, m, nil, m.module.options) + var p = newInitProc(globals, m) attachProc(p, prc) - var disp = generateMethodDispatchers(graph) - for i in 0..sonsLen(disp)-1: - let prc = disp.sons[i].sym + generateIfMethodDispatchers(graph, m.idgen) + for prc in getDispatchers(graph): if not globals.generatedSyms.containsOrIncl(prc.id): - var p = newProc(globals, m, nil, m.module.options) + 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 genClass(conf: ConfigRef; obj: PType; content: Rope; ext: string) = - let cls = getClassName(obj) - let t = skipTypes(obj, abstractPtrs) - let extends = if t.kind == tyObject and t.sons[0] != nil: - " extends " & getClassName(t.sons[0]) - else: nil - let result = ("<?php$n" & - "/* Generated by the Nim Compiler v$# */$n" & - "/* (c) " & copyrightYear & " Andreas Rumpf */$n$n" & - "require_once \"nimsystem.php\";$n" & - "class $#$# {$n$#$n}$n") % - [rope(VersionAsString), cls, extends, content] - - let outfile = changeFileExt(completeCFilePath(conf, $cls), ext) - discard writeRopeIfNotEqual(result, outfile) - -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 passes.skipCodegen(m.config, n): return n if sfMainModule in m.module.flags: - let globals = PGlobals(graph.backend) - let ext = "js" - let f = if globals.classes.len == 0: toFilename(m.config, FileIndex m.module.position) - else: "nimsystem" - let code = wholeCode(graph, m) - let outfile = - if m.config.outFile.len > 0: - if m.config.outFile.isAbsolute: m.config.outFile - else: getCurrentDir() / m.config.outFile - else: - changeFileExt(completeCFilePath(m.config, f), ext) - discard writeRopeIfNotEqual(genHeader() & code, outfile) - for obj, content in items(globals.classes): - genClass(m.config, obj, content, ext) - -proc myOpen(graph: ModuleGraph; s: PSym): PPassContext = + # 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 + # 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 + map = genSourceMap($code, outFile.string) + code &= "\n//# sourceMappingURL=$#.map" % [outFile.string] + writeFile(outFile.string & ".map", $(%map)) + # 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 setupJSgen*(graph: ModuleGraph; s: PSym; idgen: IdGenerator): PPassContext = result = newModule(graph, s) - -const JSgenPass* = makePass(myOpen, myProcess, myClose) - + result.idgen = idgen diff --git a/compiler/jstypes.nim b/compiler/jstypes.nim index d86b09a03..d980f9989 100644 --- a/compiler/jstypes.nim +++ b/compiler/jstypes.nim @@ -7,28 +7,30 @@ # distribution, for details about the copyright. # +# included from jsgen.nim + ## Type info generation for the JS backend. +proc rope(arg: Int128): Rope = rope($arg) + proc genTypeInfo(p: PProc, typ: PType): Rope proc genObjectFields(p: PProc, typ: PType, n: PNode): Rope = var s, u: Rope - length: int field: PSym b: PNode - result = nil + result = "" case n.kind of nkRecList: - length = sonsLen(n) - if length == 1: - result = genObjectFields(p, typ, n.sons[0]) + if n.len == 1: + result = genObjectFields(p, typ, n[0]) else: - s = nil - for i in countup(0, length - 1): - if i > 0: add(s, ", \L") - add(s, genObjectFields(p, typ, n.sons[i])) + s = "" + for i in 0..<n.len: + if i > 0: s.add(", \L") + s.add(genObjectFields(p, typ, n[i])) result = ("{kind: 2, len: $1, offset: 0, " & - "typ: null, name: null, sons: [$2]}") % [rope(length), s] + "typ: null, name: null, sons: [$2]}") % [rope(n.len), s] of nkSym: field = n.sym s = genTypeInfo(p, field.typ) @@ -37,29 +39,28 @@ proc genObjectFields(p: PProc, typ: PType, n: PNode): Rope = [mangleName(p.module, field), s, makeJSString(field.name.s)] of nkRecCase: - length = sonsLen(n) - if (n.sons[0].kind != nkSym): internalError(p.config, n.info, "genObjectFields") - field = n.sons[0].sym + if (n[0].kind != nkSym): internalError(p.config, n.info, "genObjectFields") + field = n[0].sym s = genTypeInfo(p, field.typ) - for i in countup(1, length - 1): - b = n.sons[i] # branch - u = nil + for i in 1..<n.len: + b = n[i] # branch + u = "" case b.kind of nkOfBranch: - if sonsLen(b) < 2: + if b.len < 2: internalError(p.config, b.info, "genObjectFields; nkOfBranch broken") - for j in countup(0, sonsLen(b) - 2): - if u != nil: add(u, ", ") - if b.sons[j].kind == nkRange: - addf(u, "[$1, $2]", [rope(getOrdValue(b.sons[j].sons[0])), - rope(getOrdValue(b.sons[j].sons[1]))]) + for j in 0..<b.len - 1: + if u != "": u.add(", ") + if b[j].kind == nkRange: + u.addf("[$1, $2]", [rope(getOrdValue(b[j][0])), + rope(getOrdValue(b[j][1]))]) else: - add(u, rope(getOrdValue(b.sons[j]))) + u.add(rope(getOrdValue(b[j]))) of nkElse: u = rope(lengthOrd(p.config, field.typ)) else: internalError(p.config, n.info, "genObjectFields(nkRecCase)") - if result != nil: add(result, ", \L") - addf(result, "[setConstr($1), $2]", + if result != "": result.add(", \L") + result.addf("[setConstr($1), $2]", [u, genObjectFields(p, typ, lastSon(b))]) result = ("{kind: 3, offset: \"$1\", len: $3, " & "typ: $2, name: $4, sons: [$5]}") % [ @@ -68,27 +69,27 @@ 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.sons[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 var s = ("var $1 = {size: 0, kind: $2, base: null, node: null, " & "finalizer: null};$n") % [name, rope(ord(kind))] prepend(p.g.typeInfo, s) - addf(p.g.typeInfo, "var NNI$1 = $2;$n", + p.g.typeInfo.addf("var NNI$1 = $2;$n", [rope(typ.id), genObjectFields(p, typ, typ.n)]) - addf(p.g.typeInfo, "$1.node = NNI$2;$n", [name, rope(typ.id)]) - if (typ.kind == tyObject) and (typ.sons[0] != nil): - addf(p.g.typeInfo, "$1.base = $2;$n", - [name, genTypeInfo(p, typ.sons[0].skipTypes(skipPtrs))]) + p.g.typeInfo.addf("$1.node = NNI$2;$n", [name, rope(typ.id)]) + if (typ.kind == tyObject) and (typ.baseClass != nil): + p.g.typeInfo.addf("$1.base = $2;$n", + [name, genTypeInfo(p, typ.baseClass.skipTypes(skipPtrs))]) proc genTupleFields(p: PProc, typ: PType): Rope = - var s: Rope = nil - for i in 0 ..< typ.len: - if i > 0: add(s, ", \L") + var s: Rope = "" + for i in 0..<typ.len: + if i > 0: s.add(", \L") s.addf("{kind: 1, offset: \"Field$1\", len: 0, " & "typ: $2, name: \"Field$1\", sons: null}", - [i.rope, genTypeInfo(p, typ.sons[i])]) + [i.rope, genTypeInfo(p, typ[i])]) result = ("{kind: 2, len: $1, offset: 0, " & "typ: null, name: null, sons: [$2]}") % [rope(typ.len), s] @@ -96,61 +97,60 @@ proc genTupleInfo(p: PProc, typ: PType, name: Rope) = var s = ("var $1 = {size: 0, kind: $2, base: null, node: null, " & "finalizer: null};$n") % [name, rope(ord(typ.kind))] prepend(p.g.typeInfo, s) - addf(p.g.typeInfo, "var NNI$1 = $2;$n", + p.g.typeInfo.addf("var NNI$1 = $2;$n", [rope(typ.id), genTupleFields(p, typ)]) - addf(p.g.typeInfo, "$1.node = NNI$2;$n", [name, rope(typ.id)]) + p.g.typeInfo.addf("$1.node = NNI$2;$n", [name, rope(typ.id)]) proc genEnumInfo(p: PProc, typ: PType, name: Rope) = - let length = sonsLen(typ.n) - var s: Rope = nil - for i in countup(0, length - 1): - if (typ.n.sons[i].kind != nkSym): internalError(p.config, typ.n.info, "genEnumInfo") - let field = typ.n.sons[i].sym - if i > 0: add(s, ", \L") + 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 + if i > 0: s.add(", \L") let extName = if field.ast == nil: field.name.s else: field.ast.strVal - addf(s, "\"$1\": {kind: 1, offset: $1, typ: $2, name: $3, len: 0, sons: null}", + s.addf("\"$1\": {kind: 1, offset: $1, typ: $2, name: $3, len: 0, sons: null}", [rope(field.position), name, makeJSString(extName)]) var n = ("var NNI$1 = {kind: 2, offset: 0, typ: null, " & - "name: null, len: $2, sons: {$3}};$n") % [rope(typ.id), rope(length), s] + "name: null, len: $2, sons: {$3}};$n") % [rope(typ.id), rope(typ.n.len), s] s = ("var $1 = {size: 0, kind: $2, base: null, node: null, " & "finalizer: null};$n") % [name, rope(ord(typ.kind))] prepend(p.g.typeInfo, s) - add(p.g.typeInfo, n) - addf(p.g.typeInfo, "$1.node = NNI$2;$n", [name, rope(typ.id)]) - if typ.sons[0] != nil: - addf(p.g.typeInfo, "$1.base = $2;$n", - [name, genTypeInfo(p, typ.sons[0])]) + p.g.typeInfo.add(n) + p.g.typeInfo.addf("$1.node = NNI$2;$n", [name, rope(typ.id)]) + if typ.baseClass != nil: + p.g.typeInfo.addf("$1.base = $2;$n", + [name, genTypeInfo(p, typ.baseClass)]) proc genTypeInfo(p: PProc, typ: PType): Rope = - let t = typ.skipTypes({tyGenericInst, tyDistinct, tyAlias, tySink}) + let t = typ.skipTypes({tyGenericInst, tyDistinct, tyAlias, tySink, tyOwned}) result = "NTI$1" % [rope(t.id)] if containsOrIncl(p.g.typeInfoGenerated, t.id): return case t.kind of tyDistinct: - result = genTypeInfo(p, t.sons[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) - addf(p.g.typeInfo, "$1.base = $2;$n", - [result, genTypeInfo(p, t.lastSon)]) + p.g.typeInfo.addf("$1.base = $2;$n", + [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) - addf(p.g.typeInfo, "$1.base = $2;$n", - [result, genTypeInfo(p, t.sons[1])]) + p.g.typeInfo.addf("$1.base = $2;$n", + [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 0a4801150..54cdfc5bc 100644 --- a/compiler/lambdalifting.nim +++ b/compiler/lambdalifting.nim @@ -10,8 +10,14 @@ # This file implements lambda lifting for the transformator. import - intsets, strutils, options, ast, astalgo, trees, treetab, msgs, - idents, renderer, types, magicsys, lowerings, tables, modulegraphs, lineinfos + 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 @@ -125,78 +131,78 @@ proc newCall(a: PSym, b: PNode): PNode = result.add newSymNode(a) result.add b -proc createClosureIterStateType*(g: ModuleGraph; iter: PSym): PType = +proc createClosureIterStateType*(g: ModuleGraph; iter: PSym; idgen: IdGenerator): PType = var n = newNodeI(nkRange, iter.info) - addSon(n, newIntNode(nkIntLit, -1)) - addSon(n, newIntNode(nkIntLit, 0)) - result = newType(tyRange, iter) + n.add newIntNode(nkIntLit, -1) + n.add newIntNode(nkIntLit, 0) + result = newType(tyRange, idgen, iter) result.n = n var intType = nilOrSysInt(g) - if intType.isNil: intType = newType(tyInt, iter) + if intType.isNil: intType = newType(tyInt, idgen, iter) rawAddSon(result, intType) -proc createStateField(g: ModuleGraph; iter: PSym): PSym = - result = newSym(skField, getIdent(g.cache, ":state"), iter, iter.info) - result.typ = createClosureIterStateType(g, iter) +proc createStateField(g: ModuleGraph; iter: PSym; idgen: IdGenerator): PSym = + result = newSym(skField, getIdent(g.cache, ":state"), idgen, iter, iter.info) + result.typ = createClosureIterStateType(g, iter, idgen) + +template isIterator*(owner: PSym): bool = + owner.kind == skIterator and owner.typ.callConv == ccClosure -proc createEnvObj(g: ModuleGraph; 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, owner, info, final=false) - rawAddField(result, createStateField(g, owner)) +proc createEnvObj(g: ModuleGraph; idgen: IdGenerator; owner: PSym; info: TLineInfo): PType = + result = createObj(g, idgen, owner, info, final=false) + if owner.isIterator or not isDefined(g.config, "nimOptIters"): + rawAddField(result, createStateField(g, owner, idgen)) -proc getClosureIterResult*(g: ModuleGraph; iter: PSym): PSym = +proc getClosureIterResult*(g: ModuleGraph; iter: PSym; idgen: IdGenerator): PSym = if resultPos < iter.ast.len: - result = iter.ast.sons[resultPos].sym + result = iter.ast[resultPos].sym else: # XXX a bit hacky: - result = newSym(skResult, getIdent(g.cache, ":result"), iter, iter.info, {}) - result.typ = iter.typ.sons[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) proc addHiddenParam(routine: PSym, param: PSym) = assert param.kind == skParam - var params = routine.ast.sons[paramsPos] + var params = routine.ast[paramsPos] # -1 is correct here as param.position is 0 based but we have at position 0 # some nkEffect node: param.position = routine.typ.n.len-1 - addSon(params, newSymNode(param)) + params.add newSymNode(param) #incl(routine.typ.flags, tfCapturesEnv) assert sfFromGeneric in param.flags #echo "produced environment: ", param.id, " for ", routine.id -proc getHiddenParam(g: ModuleGraph; routine: PSym): PSym = - let params = routine.ast.sons[paramsPos] +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.sons[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 @@ -205,10 +211,10 @@ proc newAsgnStmt(le, ri: PNode, info: TLineInfo): PNode = # which is however the only case when we generate an assignment in the first # place. result = newNodeI(nkAsgn, info, 2) - result.sons[0] = le - result.sons[1] = ri + result[0] = le + result[1] = ri -proc makeClosure*(g: ModuleGraph; prc: PSym; env: PNode; info: TLineInfo): PNode = +proc makeClosure*(g: ModuleGraph; idgen: IdGenerator; prc: PSym; env: PNode; info: TLineInfo): PNode = result = newNodeIT(nkClosure, info, prc.typ) result.add(newSymNode(prc)) if env == nil: @@ -217,37 +223,52 @@ proc makeClosure*(g: ModuleGraph; prc: PSym; env: PNode; info: TLineInfo): PNode if env.skipConv.kind == nkClosure: localError(g.config, info, "internal error: taking closure of closure") result.add(env) + #if isClosureIterator(result.typ): + createTypeBoundOps(g, nil, result.typ, info, idgen) + if tfHasAsgn in result.typ.flags or optSeqDestructors in g.config.globalOptions: + prc.flags.incl sfInjectDestructors 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 {skVar, skLet, skTemp, skForVar} and sfGlobal notin s.flags + 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.cmd == cmdCompileToJS and not isCompileTime - -proc liftIterSym*(g: ModuleGraph; n: PNode; owner: PSym): PNode = + 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.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: let it = getHiddenParam(g, owner) - addUniqueField(it.typ.sons[0], hp, g.cache) + addUniqueField(it.typ.skipTypes({tyOwned})[0], hp, g.cache, idgen) env = indirectAccess(newSymNode(it), hp, hp.info) else: - let e = newSym(skLet, iter.name, owner, n.info) + let e = newSym(skLet, iter.name, idgen, owner, n.info) e.typ = hp.typ e.flags = hp.flags env = newSymNode(e) @@ -255,49 +276,53 @@ proc liftIterSym*(g: ModuleGraph; n: PNode; owner: PSym): PNode = addVar(v, env) result.add(v) # add 'new' statement: - result.add newCall(getSysSym(g, n.info, "internalNew"), env) - result.add makeClosure(g, iter, env, n.info) + #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, owner: PSym): PNode = +proc freshVarForClosureIter*(g: ModuleGraph; s: PSym; idgen: IdGenerator; owner: PSym): PNode = + # unused with -d:nimOptIters let envParam = getHiddenParam(g, owner) - let obj = envParam.typ.lastSon - addField(obj, s, g.cache) + let obj = envParam.typ.skipTypes({tyOwned, tyRef, tyPtr}) + 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, "illegal capture '$1' of type <$2> which is declared here: $3" % - [s.name.s, typeToString(s.typ), g.config$s.info]) - elif owner.typ.callConv notin {ccClosure, ccDefault}: + localError(g.config, n.info, + ("'$1' is of type <$2> which cannot be captured as it would violate memory" & + " safety, declared here: $3; using '-d:nimNoLentIterators' helps in some cases." & + " Consider using a <ref 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, CallingConvToStr[owner.typ.callConv]]) + [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): DetectionPass = - result.processed = initIntSet() - result.capturedVars = initIntSet() - result.ownerToType = initTable[int, PType]() - result.processed.incl(fn.id) - result.graph = g +proc initDetectionPass(g: ModuleGraph; fn: PSym; idgen: IdGenerator): DetectionPass = + result = DetectionPass(processed: toIntSet([fn.id]), + capturedVars: initIntSet(), ownerToType: initTable[int, PType](), + graph: g, idgen: idgen + ) discard """ proc outer = @@ -313,26 +338,60 @@ proc getEnvTypeForOwner(c: var DetectionPass; owner: PSym; info: TLineInfo): PType = result = c.ownerToType.getOrDefault(owner.id) if result.isNil: - result = newType(tyRef, owner) - let obj = createEnvObj(c.graph, 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, c.idgen, t.owner) + result.flags.incl tfHasOwned + result.rawAddSon t + else: + result = t + +proc getEnvTypeForOwnerUp(c: var DetectionPass; owner: PSym; + info: TLineInfo): PType = + var r = c.getEnvTypeForOwner(owner, info) + result = newType(tyPtr, c.idgen, owner) + rawAddSon(result, r.skipTypes({tyOwned, tyRef, tyPtr})) + proc createUpField(c: var DetectionPass; dest, dep: PSym; info: TLineInfo) = let refObj = c.getEnvTypeForOwner(dest, info) # getHiddenParam(dest).typ - let obj = refObj.lastSon - let fieldType = c.getEnvTypeForOwner(dep, info) #getHiddenParam(dep).typ + let obj = refObj.skipTypes({tyOwned, tyRef, tyPtr}) + # The assumption here is that gcDestructors means we cannot deal + # with cycles properly, so it's better to produce a weak ref (=ptr) here. + # This seems to be generally correct but since it's a bit risky it's disabled + # for now. + # XXX This is wrong for the 'hamming' test, so remove this logic again. + let fieldType = if isDefined(c.graph.config, "nimCycleBreaker"): + c.getEnvTypeForOwnerUp(dep, info) #getHiddenParam(dep).typ + else: + c.getEnvTypeForOwner(dep, info) if refObj == fieldType: localError(c.graph.config, dep.info, "internal error: invalid up reference computed") let upIdent = getIdent(c.graph.cache, upName) let upField = lookupInRecord(obj.n, upIdent) if upField != nil: - if upField.typ != fieldType: + if upField.typ.skipTypes({tyOwned, tyRef, tyPtr}) != fieldType.skipTypes({tyOwned, tyRef, tyPtr}): localError(c.graph.config, dep.info, "internal error: up references do not agree") + + when false: + if c.graph.config.selectedGC == gcDestructors and sfCursor notin upField.flags: + localError(c.graph.config, dep.info, "internal error: up reference is not a .cursor") else: - let result = newSym(skField, upIdent, 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: + result.flags.incl sfCursor rawAddField(obj, result) discard """ @@ -361,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), 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) @@ -389,26 +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): - detectCapturedVars(s.getBody, s, c) + 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): - let obj = getHiddenParam(c.graph, owner).typ.lastSon - #let obj = c.getEnvTypeForOwner(s.owner).lastSon + 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.id = -s.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) - # but always return because the rest of the proc is only relevant when - # ow != owner: - return + discard addField(obj, s, c.graph.cache, c.idgen) # direct or indirect dependency: - if (innerProc and s.typ.callConv == ccClosure) or interestingVar(s): + elif innerClosure or interested: discard """ proc outer() = var x: int @@ -425,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).lastSon - #getHiddenParam(owner).typ.lastSon - addField(obj, s, c.graph.cache) + 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: @@ -451,27 +517,34 @@ proc detectCapturedVars(n: PNode; owner: PSym; c: var DetectionPass) = createUpField(c, w, up, n.info) w = up of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit, - nkTemplateDef, nkTypeSection: - discard - of nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef: + nkTemplateDef, nkTypeSection, nkProcDef, nkMethodDef, + nkConverterDef, nkMacroDef, nkFuncDef, nkCommentStmt, + nkTypeOfExpr, nkMixinStmt, nkBindStmt: discard - of nkLambdaKinds, nkIteratorDef, nkFuncDef: + of nkLambdaKinds, nkIteratorDef: if n.typ != nil: 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 processed: IntSet envVars: Table[int, PNode] inContainer: int + 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 @@ -479,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.sons[0] assert obj.kind == tyObject let field = getFieldFromObj(obj, s) if field != nil: @@ -488,59 +561,79 @@ 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): PNode = - var v = newSym(skVar, getIdent(cache, envName), owner, owner.info) - incl(v.flags, sfShadowed) +proc newEnvVar(cache: IdentCache; owner: PSym; typ: PType; info: TLineInfo; idgen: IdGenerator): PNode = + 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.sons[0], v) + addUniqueField(it.typ.elementType, v) result = indirectAccess(newSymNode(it), v, v.info) else: result = newSymNode(v) -proc setupEnvVar(owner: PSym; d: DetectionPass; - c: var LiftingPass): PNode = +proc setupEnvVar(owner: PSym; d: var DetectionPass; + c: var LiftingPass; info: TLineInfo): PNode = if owner.isIterator: return getHiddenParam(d.graph, owner).newSymNode - result = c.envvars.getOrDefault(owner.id) + result = c.envVars.getOrDefault(owner.id) if result.isNil: let envVarType = d.ownerToType.getOrDefault(owner.id) if envVarType.isNil: localError d.graph.config, owner.info, "internal error: could not determine closure type" - result = newEnvVar(d.graph.cache, owner, envVarType) + 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"), d.idgen, owner, info) + v.flags = {sfShadowed, sfGeneratedOp} + v.typ = envVarType + c.unownedEnvVars[owner.id] = newSymNode(v) proc getUpViaParam(g: ModuleGraph; owner: PSym): PNode = let p = getHiddenParam(g, owner) result = p.newSymNode if owner.isIterator: - let upField = lookupInRecord(p.typ.lastSon.n, getIdent(g.cache, upName)) + let upField = lookupInRecord(p.typ.skipTypes({tyOwned, tyRef, tyPtr}).n, getIdent(g.cache, upName)) if upField == nil: localError(g.config, owner.info, "could not find up reference for closure iter") else: result = rawIndirectAccess(result, upField, p.info) proc rawClosureCreation(owner: PSym; - d: DetectionPass; c: var LiftingPass): PNode = + d: var DetectionPass; c: var LiftingPass; + info: TLineInfo): PNode = result = newNodeI(nkStmtList, owner.info) var env: PNode if owner.isIterator: env = getHiddenParam(d.graph, owner).newSymNode else: - env = setupEnvVar(owner, d, c) + env = setupEnvVar(owner, d, c, info) if env.kind == nkSym: var v = newNodeI(nkVarSection, env.info) addVar(v, env) result.add(v) + if optOwnedRefs in d.graph.config.globalOptions: + let unowned = c.unownedEnvVars[owner.id] + assert unowned != nil + 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 + let env2 = copyTree(env) + env2.typ = unowned.typ + result.add newAsgnStmt(unowned, env2, env.info) + createTypeBoundOpsLL(d.graph, unowned.typ, env.info, d.idgen, owner) + # add assignment statements for captured parameters: for i in 1..<owner.typ.n.len: let local = owner.typ.n[i].sym @@ -548,11 +641,15 @@ proc rawClosureCreation(owner: PSym; let fieldAccess = indirectAccess(env, local, env.info) # add ``env.param = param`` result.add(newAsgnStmt(fieldAccess, newSymNode(local), env.info)) + if owner.kind != skMacro: + createTypeBoundOps(d.graph, nil, fieldAccess.typ, env.info, d.idgen) + if tfHasAsgn in fieldAccess.typ.flags or optSeqDestructors in d.graph.config.globalOptions: + owner.flags.incl sfInjectDestructors - let upField = lookupInRecord(env.typ.lastSon.n, getIdent(d.graph.cache, upName)) + let upField = lookupInRecord(env.typ.skipTypes({tyOwned, tyRef, tyPtr}).n, getIdent(d.graph.cache, upName)) if upField != nil: let up = getUpViaParam(d.graph, owner) - if up != nil and upField.typ == up.typ: + if up != nil and upField.typ.skipTypes({tyOwned, tyRef, tyPtr}) == up.typ.skipTypes({tyOwned, tyRef, tyPtr}): result.add(newAsgnStmt(rawIndirectAccess(env, upField, env.info), up, env.info)) #elif oldenv != nil and oldenv.typ == upField.typ: @@ -560,40 +657,55 @@ proc rawClosureCreation(owner: PSym; # oldenv, env.info)) else: localError(d.graph.config, env.info, "internal error: cannot create up reference") + # we are not in the sem'check phase anymore! so pass 'nil' for the PContext + # and hope for the best: + createTypeBoundOpsLL(d.graph, env.typ, owner.info, d.idgen, owner) + +proc finishClosureCreation(owner: PSym; d: var DetectionPass; c: LiftingPass; + info: TLineInfo; res: PNode) = + if optOwnedRefs in d.graph.config.globalOptions: + let unowned = c.unownedEnvVars[owner.id] + assert unowned != nil + let nilLit = newNodeIT(nkNilLit, info, unowned.typ) + res.add newAsgnStmt(unowned, nilLit, info) + createTypeBoundOpsLL(d.graph, unowned.typ, info, d.idgen, owner) proc closureCreationForIter(iter: PNode; - d: DetectionPass; c: var LiftingPass): 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), owner, iter.info) + var v = newSym(skVar, getIdent(d.graph.cache, envName), d.idgen, owner, iter.info) incl(v.flags, sfShadowed) - v.typ = getHiddenParam(d.graph, iter.sym).typ + v.typ = asOwnedRef(d, getHiddenParam(d.graph, iter.sym).typ) var vnode: PNode if owner.isIterator: let it = getHiddenParam(d.graph, owner) - addUniqueField(it.typ.sons[0], v, d.graph.cache) + addUniqueField(it.typ.skipTypes({tyOwned, tyRef, tyPtr}), v, d.graph.cache, d.idgen) vnode = indirectAccess(newSymNode(it), v, v.info) else: vnode = v.newSymNode 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.lastSon.n, getIdent(d.graph.cache, upName)) + let upField = lookupInRecord(v.typ.skipTypes({tyOwned, tyRef, tyPtr}).n, getIdent(d.graph.cache, upName)) if upField != nil: - let u = setupEnvVar(owner, d, c) - if u.typ == upField.typ: + let u = setupEnvVar(owner, d, c, iter.info) + if u.typ.skipTypes({tyOwned, tyRef, tyPtr}) == upField.typ.skipTypes({tyOwned, tyRef, tyPtr}): result.add(newAsgnStmt(rawIndirectAccess(vnode, upField, iter.info), u, iter.info)) else: localError(d.graph.config, iter.info, "internal error: cannot create up reference for iter") - result.add makeClosure(d.graph, iter.sym, vnode, iter.info) + result.add makeClosure(d.graph, d.idgen, iter.sym, vnode, iter.info) -proc accessViaEnvVar(n: PNode; owner: PSym; d: DetectionPass; +proc accessViaEnvVar(n: PNode; owner: PSym; d: var DetectionPass; c: var LiftingPass): PNode = - let access = setupEnvVar(owner, d, c) - let obj = access.typ.sons[0] + var access = setupEnvVar(owner, d, c, n.info) + if optOwnedRefs in d.graph.config.globalOptions: + access = c.unownedEnvVars[owner.id] + let obj = access.typ.skipTypes({tyOwned, tyRef, tyPtr}) let field = getFieldFromObj(obj, n.sym) if field != nil: result = rawIndirectAccess(access, field, n.info) @@ -602,39 +714,40 @@ proc accessViaEnvVar(n: PNode; owner: PSym; d: DetectionPass; result = n proc getStateField*(g: ModuleGraph; owner: PSym): PSym = - getHiddenParam(g, owner).typ.sons[0].n.sons[0].sym + getHiddenParam(g, owner).typ.skipTypes({tyOwned, tyRef, tyPtr}).n[0].sym -proc liftCapturedVars(n: PNode; owner: PSym; d: DetectionPass; +proc liftCapturedVars(n: PNode; owner: PSym; d: var DetectionPass; c: var LiftingPass): PNode -proc symToClosure(n: PNode; owner: PSym; d: DetectionPass; +proc symToClosure(n: PNode; owner: PSym; d: var DetectionPass; c: var LiftingPass): PNode = let s = n.sym if s == owner: # recursive calls go through (lambda, hiddenParam): let available = getHiddenParam(d.graph, owner) - result = makeClosure(d.graph, s, available.newSymNode, n.info) + result = makeClosure(d.graph, d.idgen, s, available.newSymNode, n.info) elif s.isIterator: result = closureCreationForIter(n, d, c) elif s.skipGenericOwner == owner: # direct dependency, so use the outer's env variable: - result = makeClosure(d.graph, s, setupEnvVar(owner, d, c), n.info) + 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; var access = newSymNode(available) while true: if access.typ == wanted: - return makeClosure(d.graph, s, access, n.info) - let obj = access.typ.sons[0] + return makeClosure(d.graph, d.idgen, s, access, n.info) + let obj = access.typ.skipTypes({tyOwned, tyRef, tyPtr}) let upField = lookupInRecord(obj.n, getIdent(d.graph.cache, upName)) if upField == nil: localError(d.graph.config, n.info, "internal error: no environment found") return n access = rawIndirectAccess(access, upField, n.info) -proc liftCapturedVars(n: PNode; owner: PSym; d: DetectionPass; +proc liftCapturedVars(n: PNode; owner: PSym; d: var DetectionPass; c: var LiftingPass): PNode = result = n case n.kind @@ -646,36 +759,39 @@ proc liftCapturedVars(n: PNode; owner: PSym; d: DetectionPass; # echo renderTree(s.getBody, {renderIds}) let oldInContainer = c.inContainer c.inContainer = 0 - var body = liftCapturedVars(s.getBody, s, d, c) - if c.envvars.getOrDefault(s.id).isNil: - s.ast.sons[bodyPos] = body + var body = transformBody(d.graph, d.idgen, s, {}) + body = liftCapturedVars(body, s, d, c) + if c.envVars.getOrDefault(s.id).isNil: + s.transformedBody = body else: - s.ast.sons[bodyPos] = newTree(nkStmtList, rawClosureCreation(s, d, c), body) + s.transformedBody = newTree(nkStmtList, rawClosureCreation(s, d, c, n.info), body) + finishClosureCreation(s, d, c, n.info, s.transformedBody) c.inContainer = oldInContainer + if s.typ.callConv == ccClosure: result = symToClosure(n, owner, d, c) + 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) of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit, nkComesFrom, - nkTemplateDef, nkTypeSection: - discard - of nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef: + nkTemplateDef, nkTypeSection, nkProcDef, nkMethodDef, nkConverterDef, + nkMacroDef, nkFuncDef, nkMixinStmt, nkBindStmt: discard of nkClosure: if n[1].kind == nkNilLit: - n.sons[0] = liftCapturedVars(n[0], owner, d, c) - let x = n.sons[0].skipConv + n[0] = liftCapturedVars(n[0], owner, d, c) + let x = n[0].skipConv if x.kind == nkClosure: #localError(n.info, "internal error: closure to closure created") # now we know better, so patch it: - n.sons[0] = x.sons[0] - n.sons[1] = x.sons[1] - of nkLambdaKinds, nkIteratorDef, nkFuncDef: + n[0] = x[0] + n[1] = x[1] + of nkLambdaKinds, nkIteratorDef: if n.typ != nil and n[namePos].kind == nkSym: let oldInContainer = c.inContainer c.inContainer = 0 @@ -685,71 +801,103 @@ proc liftCapturedVars(n: PNode; owner: PSym; d: DetectionPass; c.inContainer = oldInContainer of nkHiddenStdConv: if n.len == 2: - n.sons[1] = liftCapturedVars(n[1], owner, d, c) + 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, 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] = liftCapturedVars(n[0][1], owner, d, c) + else: + n[0] = liftCapturedVars(n[0], owner, d, c) + 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: - n.sons[1] = liftCapturedVars(n[1], owner, d, c) + n[1] = liftCapturedVars(n[1], owner, d, c) return let inContainer = n.kind in {nkObjConstr, nkBracket} if inContainer: inc c.inContainer for i in 0..<n.len: - n.sons[i] = liftCapturedVars(n[i], owner, d, c) + n[i] = liftCapturedVars(n[i], owner, d, c) if inContainer: dec c.inContainer # ------------------ old stuff ------------------------------------------- proc semCaptureSym*(s, owner: PSym) = + discard """ + proc outer() = + var x: int + proc inner() = + proc innerInner() = + echo x + innerInner() + inner() + # inner() takes a closure too! + """ + proc propagateClosure(start, last: PSym) = + var o = start + while o != nil and o.kind != skModule: + if o == last: break + o.typ.callConv = ccClosure + o = o.skipGenericOwner + if interestingVar(s) and s.kind != skResult: if owner.typ != nil and not isGenericRoutine(owner): # XXX: is this really safe? # if we capture a var from another generic routine, # it won't be consider captured. var o = owner.skipGenericOwner - while o.kind != skModule and o != nil: + while o != nil and o.kind != skModule: if s.owner == o: - if owner.typ.callConv in {ccClosure, ccDefault} or owner.kind == skIterator: + if owner.typ.callConv == ccClosure or owner.kind == skIterator or + owner.typ.callConv == ccNimCall and tfExplicitCallConv notin owner.typ.flags: owner.typ.callConv = ccClosure + propagateClosure(owner.skipGenericOwner, s.owner) else: discard "do not produce an error here, but later" - #echo "computing .closure for ", owner.name.s, " ", owner.info, " because of ", s.name.s + #echo "computing .closure for ", owner.name.s, " because of ", s.name.s o = o.skipGenericOwner # since the analysis is not entirely correct, we don't set 'tfCapturesEnv' # here -proc liftIterToProc*(g: ModuleGraph; fn: PSym; body: PNode; ptrType: PType): PNode = - var d = initDetectionPass(g, fn) +proc liftIterToProc*(g: ModuleGraph; fn: PSym; body: PNode; ptrType: PType; + idgen: IdGenerator): PNode = + var d = initDetectionPass(g, fn, idgen) var c = initLiftingPass(fn) # pretend 'fn' is a closure iterator for the analysis: let oldKind = fn.kind let oldCC = fn.typ.callConv - fn.kind = skIterator + fn.transitionRoutineSymKind(skIterator) fn.typ.callConv = ccClosure d.ownerToType[fn.id] = ptrType detectCapturedVars(body, fn, d) result = liftCapturedVars(body, fn, d, c) - fn.kind = oldKind + fn.transitionRoutineSymKind(oldKind) fn.typ.callConv = oldCC -proc liftLambdas*(g: ModuleGraph; fn: PSym, body: PNode; tooEarly: var bool): PNode = - # XXX gCmd == cmdCompileToJS 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. +proc liftLambdas*(g: ModuleGraph; fn: PSym, body: PNode; tooEarly: var bool; + idgen: IdGenerator; flags: TransformFlags): PNode = let isCompileTime = sfCompileTime in fn.flags or fn.kind == skMacro - if body.kind == nkEmpty or ( - g.config.cmd == cmdCompileToJS and not isCompileTime) or - fn.skipGenericOwner.kind != skModule: + if body.kind == nkEmpty or (jsNoLambdaLifting in g.config.legacyFeatures and + g.config.backend == backendJs and not isCompileTime) or + (fn.skipGenericOwner.kind != skModule and force notin flags): # ignore forward declaration: result = body tooEarly = true + if fn.isIterator and isDefined(g.config, "nimOptIters"): + var d = initDetectionPass(g, fn, idgen) + addClosureParam(d, fn, body.info) else: - var d = initDetectionPass(g, fn) + var d = initDetectionPass(g, fn, idgen) detectCapturedVars(body, fn, d) if not d.somethingToDo and fn.isIterator: addClosureParam(d, fn, body.info) @@ -757,8 +905,10 @@ proc liftLambdas*(g: ModuleGraph; fn: PSym, body: PNode; tooEarly: var bool): PN if d.somethingToDo: var c = initLiftingPass(fn) result = liftCapturedVars(body, fn, d, c) - if c.envvars.getOrDefault(fn.id) != nil: - result = newTree(nkStmtList, rawClosureCreation(fn, d, c), result) + # echo renderTree(result, {renderIds}) + if c.envVars.getOrDefault(fn.id) != nil: + result = newTree(nkStmtList, rawClosureCreation(fn, d, c, body.info), result) + finishClosureCreation(fn, d, c, body.info, result) else: result = body #if fn.name.s == "get2": @@ -771,7 +921,7 @@ proc liftLambdasForTopLevel*(module: PSym, body: PNode): PNode = # ------------------- iterator transformation -------------------------------- -proc liftForLoop*(g: ModuleGraph; body: PNode; owner: PSym): PNode = +proc liftForLoop*(g: ModuleGraph; body: PNode; idgen: IdGenerator; owner: PSym): PNode = # problem ahead: the iterator could be invoked indirectly, but then # we don't know what environment to create here: # @@ -801,23 +951,22 @@ proc liftForLoop*(g: ModuleGraph; body: PNode; owner: PSym): PNode = ... """ if liftingHarmful(g.config, owner): return body - var L = body.len - if not (body.kind == nkForStmt and body[L-2].kind in nkCallKinds): + if not (body.kind == nkForStmt and body[^2].kind in nkCallKinds): localError(g.config, body.info, "ignored invalid for loop") return body - var call = body[L-2] + var call = body[^2] 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, owner, body.info) + env = newSym(skLet, iter.name, idgen, owner, body.info) env.typ = hp.typ env.flags = hp.flags @@ -825,38 +974,43 @@ proc liftForLoop*(g: ModuleGraph; body: PNode; owner: PSym): PNode = 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: let closure = op.lastSon if closure.kind == nkClosure: - call.sons[0] = closure - for i in 0 .. op.len-2: + call[0] = closure + for i in 0..<op.len-1: result.add op[i] var loopBody = newNodeI(nkStmtList, body.info, 3) var whileLoop = newNodeI(nkWhileStmt, body.info, 2) - whileLoop.sons[0] = newIntTypeNode(nkIntLit, 1, getSysType(g, body.info, tyBool)) - whileLoop.sons[1] = loopBody + whileLoop[0] = newIntTypeNode(1, getSysType(g, body.info, tyBool)) + whileLoop[1] = loopBody result.add whileLoop # setup loopBody: # gather vars in a tuple: var v2 = newNodeI(nkLetSection, body.info) - var vpart = newNodeI(if L == 3: nkIdentDefs else: nkVarTuple, body.info) - for i in 0 .. L-3: - if body[i].kind == nkSym: - body[i].sym.kind = skLet - addSon(vpart, body[i]) + var vpart = newNodeI(if body.len == 3: nkIdentDefs else: nkVarTuple, body.info) + 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] - addSon(vpart, newNodeI(nkEmpty, body.info)) # no explicit type + vpart.add newNodeI(nkEmpty, body.info) # no explicit type if not env.isNil: - call.sons[0] = makeClosure(g, call.sons[0].sym, env.newSymNode, body.info) - addSon(vpart, call) - addSon(v2, vpart) + call[0] = makeClosure(g, idgen, call[0].sym, env.newSymNode, body.info) + vpart.add call + v2.add vpart - loopBody.sons[0] = v2 + loopBody[0] = v2 var bs = newNodeI(nkBreakState, body.info) - bs.addSon(call.sons[0]) + bs.add call[0] let ibs = newNodeI(nkIfStmt, body.info) let elifBranch = newNodeI(nkElifBranch, body.info) @@ -868,5 +1022,5 @@ proc liftForLoop*(g: ModuleGraph; body: PNode; owner: PSym): PNode = elifBranch.add(br) ibs.add(elifBranch) - loopBody.sons[1] = ibs - loopBody.sons[2] = body[L-1] + loopBody[1] = ibs + loopBody[2] = body[^1] diff --git a/compiler/layouter.nim b/compiler/layouter.nim index 62844db4b..0121b1185 100644 --- a/compiler/layouter.nim +++ b/compiler/layouter.nim @@ -9,51 +9,98 @@ ## Layouter for nimpretty. -import idents, lexer, lineinfos, llstream, options, msgs, strutils -from os import changeFileExt +import idents, lexer, ast, lineinfos, llstream, options, msgs, strutils, pathutils const - MaxLineLen = 80 - LineCommentColumn = 30 + MinLineLen = 15 type SplitKind = enum splitComma, splitParLe, splitAnd, splitOr, splitIn, splitBinary + SemicolonKind = enum + detectSemicolonKind, useSemicolon, dontTouch + + LayoutToken* = enum + ltSpaces, + ltCrucialNewline, ## a semantically crucial newline (indentation!) + ltSplittingNewline, ## newline used for splitting up long + ## expressions (like after a comma or a binary operator) + ltTab, + ltOptionalNewline, ## optional newline introduced by nimpretty + ltComment, ltLit, ltKeyword, ltExportMarker, ltIdent, + ltOther, ltOpr, ltSomeParLe, ltSomeParRi, + ltBeginSection, ltEndSection + Emitter* = object config: ConfigRef fid: FileIndex - lastTok: TTokType - inquote: bool - col, lastLineNumber, lineSpan, indentLevel, indWidth: int - nested: int + lastTok: TokType + inquote, lastTokWasTerse: bool + semicolons: SemicolonKind + col, lastLineNumber, lineSpan, indentLevel, indWidth*, inSection: int + keepIndents*: int doIndentMore*: int - content: string + kinds*: seq[LayoutToken] + tokens*: seq[string] indentStack: seq[int] fixedUntil: int # marks where we must not go in the content altSplitPos: array[SplitKind, int] # alternative split positions + maxLineLen*: int proc openEmitter*(em: var Emitter, cache: IdentCache; config: ConfigRef, fileIdx: FileIndex) = - let fullPath = config.toFullPath(fileIdx) - em.indWidth = getIndentWidth(fileIdx, llStreamOpen(fullPath, fmRead), - cache, config) - if em.indWidth == 0: em.indWidth = 2 + let fullPath = AbsoluteFile config.toFullPath(fileIdx) + if em.indWidth == 0: + em.indWidth = getIndentWidth(fileIdx, llStreamOpen(fullPath, fmRead), + cache, config) + if em.indWidth == 0: em.indWidth = 2 em.config = config em.fid = fileIdx em.lastTok = tkInvalid em.inquote = false em.col = 0 - em.content = newStringOfCap(16_000) em.indentStack = newSeqOfCap[int](30) em.indentStack.add 0 + em.lastLineNumber = 1 + +proc computeMax(em: Emitter; pos: int): int = + var p = pos + var extraSpace = 0 + result = 0 + while p < em.tokens.len and em.kinds[p] != ltEndSection: + var lhs = 0 + var lineLen = 0 + var foundTab = false + while p < em.tokens.len and em.kinds[p] != ltEndSection: + if em.kinds[p] in {ltCrucialNewline, ltSplittingNewline}: + if foundTab and lineLen <= em.maxLineLen: + result = max(result, lhs + extraSpace) + inc p + break + if em.kinds[p] == ltTab: + extraSpace = if em.kinds[p-1] == ltSpaces: 0 else: 1 + foundTab = true + else: + if not foundTab: + inc lhs, em.tokens[p].len + inc lineLen, em.tokens[p].len + inc p + +proc computeRhs(em: Emitter; pos: int): int = + var p = pos + result = 0 + while p < em.tokens.len and em.kinds[p] notin {ltCrucialNewline, ltSplittingNewline}: + inc result, em.tokens[p].len + inc p + +proc isLongEnough(lineLen, startPos, endPos: int): bool = + result = lineLen > MinLineLen and endPos > startPos + 4 -proc closeEmitter*(em: var Emitter) = - var f = llStreamOpen(em.config.outFile, fmWrite) - if f == nil: - rawMessage(em.config, errGenerated, "cannot open file: " & em.config.outFile) - f.llStreamWrite em.content - llStreamClose(f) +proc findNewline(em: Emitter; p, lineLen: var int) = + while p < em.tokens.len and em.kinds[p] notin {ltCrucialNewline, ltSplittingNewline}: + inc lineLen, em.tokens[p].len + inc p proc countNewlines(s: string): int = result = 0 @@ -67,78 +114,356 @@ proc calcCol(em: var Emitter; s: string) = dec i inc em.col -template wr(x) = - em.content.add x +proc optionalIsGood(em: var Emitter; pos, currentLen: int): bool = + let ourIndent = em.tokens[pos].len + var p = pos+1 + var lineLen = 0 + em.findNewline(p, lineLen) + if p == pos+1: # optionalNewline followed by another newline + result = false + elif em.kinds[p-1] == ltComment and currentLen+lineLen < em.maxLineLen+MinLineLen: + result = false + elif p+1 < em.tokens.len and em.kinds[p+1] == ltSpaces and + em.kinds[p-1] == ltOptionalNewline: + if em.tokens[p+1].len == ourIndent: + # concatenate lines with the same indententation + var nlPos = p + var lineLenTotal = lineLen + inc p + em.findNewline(p, lineLenTotal) + if isLongEnough(lineLenTotal, nlPos, p): + em.kinds[nlPos] = ltOptionalNewline + if em.kinds[nlPos+1] == ltSpaces: + # inhibit extra spaces when concatenating two lines + em.tokens[nlPos+1] = if em.tokens[nlPos-2] == ",": " " else: "" + result = true + elif em.tokens[p+1].len < ourIndent: + result = isLongEnough(lineLen, pos, p) + elif em.kinds[pos+1] in {ltOther, ltSomeParLe, ltSomeParRi}: # note: pos+1, not p+1 + result = false + else: + result = isLongEnough(lineLen, pos, p) + +proc lenOfNextTokens(em: Emitter; pos: int): int = + result = 0 + for i in 1..<em.tokens.len-pos: + if em.kinds[pos+i] in {ltCrucialNewline, ltSplittingNewline, ltOptionalNewline}: break + inc result, em.tokens[pos+i].len + +proc guidingInd(em: Emitter; pos: int): int = + var i = pos - 1 + while i >= 0 and em.kinds[i] != ltSomeParLe: + dec i + while i+1 <= em.kinds.high and em.kinds[i] != ltSomeParRi: + if em.kinds[i] == ltSplittingNewline and em.kinds[i+1] == ltSpaces: + return em.tokens[i+1].len + inc i + result = -1 + +proc renderTokens*(em: var Emitter): string = + ## Render Emitter tokens to a string of code + template defaultCase() = + content.add em.tokens[i] + inc lineLen, em.tokens[i].len + var content = newStringOfCap(16_000) + var maxLhs = 0 + var lineLen = 0 + var lineBegin = 0 + var openPars = 0 + var i = 0 + while i <= em.tokens.high: + when defined(debug): + echo (token: em.tokens[i], kind: em.kinds[i]) + case em.kinds[i] + of ltBeginSection: + maxLhs = computeMax(em, lineBegin) + of ltEndSection: + maxLhs = 0 + lineBegin = i+1 + of ltTab: + if i >= 2 and em.kinds[i-2] in {ltCrucialNewline, ltSplittingNewline} and + em.kinds[i-1] in {ltCrucialNewline, ltSplittingNewline, ltSpaces}: + # a previous section has ended + maxLhs = 0 + + if maxLhs == 0: + if em.kinds[i-1] != ltSpaces: + content.add em.tokens[i] + inc lineLen, em.tokens[i].len + else: + # pick the shorter indentation token: + var spaces = maxLhs - lineLen + if spaces < em.tokens[i].len or computeRhs(em, i+1)+maxLhs <= em.maxLineLen+MinLineLen: + if spaces <= 0 and content[^1] notin {' ', '\L'}: spaces = 1 + for j in 1..spaces: content.add ' ' + inc lineLen, spaces + else: + content.add em.tokens[i] + inc lineLen, em.tokens[i].len + of ltCrucialNewline, ltSplittingNewline: + content.add em.tokens[i] + lineLen = 0 + lineBegin = i+1 + of ltOptionalNewline: + let totalLineLen = lineLen + lenOfNextTokens(em, i) + if totalLineLen > em.maxLineLen and optionalIsGood(em, i, lineLen): + if i-1 >= 0 and em.kinds[i-1] == ltSpaces: + let spaces = em.tokens[i-1].len + content.setLen(content.len - spaces) + content.add "\L" + let guide = if openPars > 0: guidingInd(em, i) else: -1 + if guide >= 0: + content.add repeat(' ', guide) + lineLen = guide + else: + content.add em.tokens[i] + lineLen = em.tokens[i].len + lineBegin = i+1 + if i+1 < em.kinds.len and em.kinds[i+1] == ltSpaces: + # inhibit extra spaces at the start of a new line + inc i + of ltLit: + let lineSpan = countNewlines(em.tokens[i]) + if lineSpan > 0: + em.calcCol(em.tokens[i]) + lineLen = em.col + else: + inc lineLen, em.tokens[i].len + content.add em.tokens[i] + of ltSomeParLe: + inc openPars + defaultCase() + of ltSomeParRi: + doAssert openPars > 0 + dec openPars + defaultCase() + else: + defaultCase() + inc i + + return content + +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 + + 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, origAst, check) + +proc wr(em: var Emitter; x: string; lt: LayoutToken) = + em.tokens.add x + em.kinds.add lt inc em.col, x.len + assert em.tokens.len == em.kinds.len + +proc wrNewline(em: var Emitter; kind = ltCrucialNewline) = + em.tokens.add "\L" + em.kinds.add kind + em.col = 0 + +proc newlineWasSplitting*(em: var Emitter) = + if em.kinds.len >= 3 and em.kinds[^3] == ltCrucialNewline: + em.kinds[^3] = ltSplittingNewline + +#[ +Splitting newlines can occur: +- after commas, semicolon, '[', '('. +- after binary operators, '='. +- after ':' type + +We only need parser support for the "after type" case. +]# + +proc wrSpaces(em: var Emitter; spaces: int) = + if spaces > 0: + wr(em, strutils.repeat(' ', spaces), ltSpaces) + +proc wrSpace(em: var Emitter) = + wr(em, " ", ltSpaces) + +proc wrTab(em: var Emitter) = + wr(em, " ", ltTab) + +proc beginSection*(em: var Emitter) = + let pos = max(0, em.tokens.len-2) + em.tokens.insert "", pos + em.kinds.insert ltBeginSection, pos + inc em.inSection + +#wr(em, "", ltBeginSection) +proc endSection*(em: var Emitter) = + em.tokens.insert "", em.tokens.len-2 + em.kinds.insert ltEndSection, em.kinds.len-2 + dec em.inSection + +#wr(em, "", ltEndSection) + +proc removeSpaces(em: var Emitter) = + while em.kinds.len > 0 and em.kinds[^1] == ltSpaces: + let tokenLen = em.tokens[^1].len + setLen(em.tokens, em.tokens.len-1) + setLen(em.kinds, em.kinds.len-1) + dec em.col, tokenLen -template goodCol(col): bool = col in 40..MaxLineLen const openPars = {tkParLe, tkParDotLe, - tkBracketLe, tkBracketLeColon, tkCurlyDotLe, - tkCurlyLe} - splitters = openPars + {tkComma, tkSemicolon} + tkBracketLe, tkBracketDotLe, tkBracketLeColon, + tkCurlyDotLe, tkCurlyLe} + closedPars = {tkParRi, tkParDotRi, + tkBracketRi, tkBracketDotRi, + tkCurlyDotRi, tkCurlyRi} + + splitters = openPars + {tkComma, tkSemiColon} # do not add 'tkColon' here! oprSet = {tkOpr, tkDiv, tkMod, tkShl, tkShr, tkIn, tkNotin, tkIs, - tkIsnot, tkNot, tkOf, tkAs, tkDotDot, tkAnd, tkOr, tkXor} + tkIsnot, tkNot, tkOf, tkAs, tkFrom, tkDotDot, tkAnd, tkOr, tkXor} -template rememberSplit(kind) = - if goodCol(em.col): - em.altSplitPos[kind] = em.content.len +template goodCol(col): bool = col >= em.maxLineLen div 2 template moreIndent(em): int = - (if em.doIndentMore > 0: em.indWidth*2 else: em.indWidth) - -proc softLinebreak(em: var Emitter, lit: string) = - # XXX Use an algorithm that is outlined here: - # https://llvm.org/devmtg/2013-04/jasper-slides.pdf - # +2 because we blindly assume a comma or ' &' might follow - if not em.inquote and em.col+lit.len+2 >= MaxLineLen: - if em.lastTok in splitters: - while em.content.len > 0 and em.content[em.content.high] == ' ': - setLen(em.content, em.content.len-1) - wr("\L") - em.col = 0 - for i in 1..em.indentLevel+moreIndent(em): wr(" ") + if em.doIndentMore > 0: em.indWidth*2 else: em.indWidth + +template rememberSplit(kind) = + if goodCol(em.col) and not em.inquote: + let spaces = em.indentLevel+moreIndent(em) + if spaces < em.col and spaces > 0: + wr(em, strutils.repeat(' ', spaces), ltOptionalNewline) + #em.altSplitPos[kind] = em.tokens.len + +proc emitMultilineComment(em: var Emitter, lit: string, col: int; dontIndent: bool) = + # re-align every line in the multi-line comment: + var i = 0 + var lastIndent = if em.keepIndents > 0: em.indentLevel else: em.indentStack[^1] + var b = 0 + var dontIndent = dontIndent + var hasEmptyLine = false + for commentLine in splitLines(lit): + if i == 0 and (commentLine.endsWith("\\") or commentLine.endsWith("[")): + dontIndent = true + wr em, commentLine, ltComment + elif dontIndent: + if i > 0: wrNewline em + wr em, commentLine, ltComment else: - # search backwards for a good split position: - for a in em.altSplitPos: - if a > em.fixedUntil: - var spaces = 0 - while a+spaces < em.content.len and em.content[a+spaces] == ' ': - inc spaces - if spaces > 0: delete(em.content, a, a+spaces-1) - let ws = "\L" & repeat(' ',em.indentLevel+moreIndent(em)) - em.col = em.content.len - a - em.content.insert(ws, a) - break - -proc emitTok*(em: var Emitter; L: TLexer; tok: TToken) = - - template endsInWhite(em): bool = - em.content.len == 0 or em.content[em.content.high] in {' ', '\L'} - template endsInAlpha(em): bool = - em.content.len > 0 and em.content[em.content.high] in SymChars+{'_'} - - proc emitComment(em: var Emitter; tok: TToken) = - let lit = strip fileSection(em.config, em.fid, tok.commentOffsetA, tok.commentOffsetB) - em.lineSpan = countNewlines(lit) - if em.lineSpan > 0: calcCol(em, lit) + let stripped = commentLine.strip() + if i == 0: + if em.kinds.len > 0 and em.kinds[^1] != ltTab: + wr(em, "", ltTab) + elif stripped.len == 0: + wrNewline em + hasEmptyLine = true + else: + var a = 0 + while a < commentLine.len and commentLine[a] == ' ': inc a + + if a > lastIndent: + b += em.indWidth + lastIndent = a + elif a < lastIndent: + b -= em.indWidth + lastIndent = a + wrNewline em + if not hasEmptyLine or col + b < 15: + if col + b > 0: + wr(em, repeat(' ', col+b), ltTab) + else: + wr(em, "", ltTab) + else: + wr(em, repeat(' ', a), ltSpaces) + wr em, stripped, ltComment + inc i + +proc lastChar(s: string): char = + result = if s.len > 0: s[s.high] else: '\0' + +proc endsInWhite(em: Emitter): bool = + var i = em.tokens.len-1 + while i >= 0 and em.kinds[i] in {ltBeginSection, ltEndSection}: dec(i) + result = if i >= 0: em.kinds[i] in {ltSpaces, ltCrucialNewline, ltSplittingNewline, ltTab} else: true + +proc endsInNewline(em: Emitter): bool = + var i = em.tokens.len-1 + while i >= 0 and em.kinds[i] in {ltBeginSection, ltEndSection, ltSpaces}: dec(i) + result = if i >= 0: em.kinds[i] in {ltCrucialNewline, ltSplittingNewline, ltTab} else: true + +proc endsInAlpha(em: Emitter): bool = + var i = em.tokens.len-1 + while i >= 0 and em.kinds[i] in {ltBeginSection, ltEndSection}: dec(i) + result = if i >= 0: em.tokens[i].lastChar in SymChars+{'_'} else: false + +proc emitComment(em: var Emitter; tok: Token; dontIndent: bool) = + var col = em.col + let lit = strip fileSection(em.config, em.fid, tok.commentOffsetA, tok.commentOffsetB) + em.lineSpan = countNewlines(lit) + if em.lineSpan > 0: calcCol(em, lit) + if em.lineSpan == 0: + if not endsInNewline(em): + wrTab em + wr em, lit, ltComment + else: if not endsInWhite(em): - wr(" ") - if em.lineSpan == 0 and max(em.col, LineCommentColumn) + lit.len <= MaxLineLen: - for i in 1 .. LineCommentColumn - em.col: wr(" ") - wr lit + wrTab em + inc col + emitMultilineComment(em, lit, col, dontIndent) + +proc emitTok*(em: var Emitter; L: Lexer; tok: Token) = + template wasExportMarker(em): bool = + em.kinds.len > 0 and em.kinds[^1] == ltExportMarker + + if tok.tokType == tkComment and tok.literal.startsWith("#!nimpretty"): + case tok.literal + of "#!nimpretty off": + inc em.keepIndents + wrNewline em + em.lastLineNumber = tok.line + 1 + of "#!nimpretty on": + dec em.keepIndents + em.lastLineNumber = tok.line + wrNewline em + wr em, tok.literal, ltComment + em.col = 0 + em.lineSpan = 0 + return var preventComment = false - if tok.tokType == tkComment and tok.line == em.lastLineNumber and tok.indent >= 0: + if tok.tokType == tkComment and tok.line == em.lastLineNumber: # we have an inline comment so handle it before the indentation token: - emitComment(em, tok) + emitComment(em, tok, dontIndent = (em.inSection == 0)) preventComment = true - em.fixedUntil = em.content.high + em.fixedUntil = em.tokens.high elif tok.indent >= 0: - if em.lastTok in (splitters + oprSet): + var newlineKind = ltCrucialNewline + if em.keepIndents > 0: em.indentLevel = tok.indent + elif (em.lastTok in (splitters + oprSet) and + tok.tokType notin (closedPars - {tkBracketDotRi})): + if tok.tokType in openPars and tok.indent > em.indentStack[^1]: + while em.indentStack[^1] < tok.indent: + em.indentStack.add(em.indentStack[^1] + em.indWidth) + while em.indentStack[^1] > tok.indent: + discard em.indentStack.pop() + + # aka: we are in an expression context: + let alignment = max(tok.indent - em.indentStack[^1], 0) + em.indentLevel = alignment + em.indentStack.high * em.indWidth + newlineKind = ltSplittingNewline else: if tok.indent > em.indentStack[^1]: em.indentStack.add tok.indent @@ -157,112 +482,128 @@ proc emitTok*(em: var Emitter; L: TLexer; tok: TToken) = is not touched. ]# # remove trailing whitespace: - while em.content.len > 0 and em.content[em.content.high] == ' ': - setLen(em.content, em.content.len-1) - wr("\L") - for i in 2..tok.line - em.lastLineNumber: wr("\L") - em.col = 0 - for i in 1..em.indentLevel: - wr(" ") - em.fixedUntil = em.content.high + removeSpaces em + wrNewline em, newlineKind + for i in 2..tok.line - em.lastLineNumber: wrNewline(em) + wrSpaces em, em.indentLevel + em.fixedUntil = em.tokens.high + var lastTokWasTerse = false case tok.tokType of tokKeywordLow..tokKeywordHigh: if endsInAlpha(em): - wr(" ") + wrSpace em elif not em.inquote and not endsInWhite(em) and - em.lastTok notin openPars: + em.lastTok notin (openPars+{tkOpr, tkDotDot}) and not em.lastTokWasTerse: #and tok.tokType in oprSet - wr(" ") + wrSpace em if not em.inquote: - wr(TokTypeToStr[tok.tokType]) - - case tok.tokType - of tkAnd: rememberSplit(splitAnd) - of tkOr: rememberSplit(splitOr) - of tkIn, tkNotin: + wr(em, $tok.tokType, ltKeyword) + if tok.tokType in {tkAnd, tkOr, tkIn, tkNotin}: rememberSplit(splitIn) - wr(" ") - else: discard + wrSpace em else: # keywords in backticks are not normalized: - wr(tok.ident.s) + wr(em, tok.ident.s, ltIdent) of tkColon: - wr(TokTypeToStr[tok.tokType]) - wr(" ") - of tkSemicolon, tkComma: - wr(TokTypeToStr[tok.tokType]) + wr(em, $tok.tokType, ltOther) + wrSpace em + of tkSemiColon, tkComma: + wr(em, $tok.tokType, ltOther) rememberSplit(splitComma) - wr(" ") - of tkParDotLe, tkParLe, tkBracketDotLe, tkBracketLe, - tkCurlyLe, tkCurlyDotLe, tkBracketLeColon: - if tok.strongSpaceA > 0 and not em.endsInWhite: - wr(" ") - wr(TokTypeToStr[tok.tokType]) - rememberSplit(splitParLe) - of tkParRi, - tkBracketRi, tkCurlyRi, - tkBracketDotRi, - tkCurlyDotRi, - tkParDotRi, - tkColonColon, tkDot: - wr(TokTypeToStr[tok.tokType]) + wrSpace em + of openPars: + if tsLeading in tok.spacing and not em.endsInWhite and + (not em.wasExportMarker or tok.tokType == tkCurlyDotLe): + wrSpace em + wr(em, $tok.tokType, ltSomeParLe) + if tok.tokType != tkCurlyDotLe: + rememberSplit(splitParLe) + of closedPars: + wr(em, $tok.tokType, ltSomeParRi) + of tkColonColon: + wr(em, $tok.tokType, ltOther) + of tkDot: + lastTokWasTerse = true + wr(em, $tok.tokType, ltOther) of tkEquals: - if not em.inquote and not em.endsInWhite: wr(" ") - wr(TokTypeToStr[tok.tokType]) - if not em.inquote: wr(" ") + if not em.inquote and not em.endsInWhite: wrSpace(em) + wr(em, $tok.tokType, ltOther) + if not em.inquote: wrSpace(em) of tkOpr, tkDotDot: - if tok.strongSpaceA == 0 and tok.strongSpaceB == 0: + if em.inquote or (tok.spacing == {} and + tok.ident.s notin ["<", ">", "<=", ">=", "==", "!="]): + # bug #9504: remember to not spacify a keyword: + lastTokWasTerse = true # if not surrounded by whitespace, don't produce any whitespace either: - wr(tok.ident.s) + wr(em, tok.ident.s, ltOpr) else: - if not em.endsInWhite: wr(" ") - wr(tok.ident.s) + 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): - wr(" ") rememberSplit(splitBinary) + wrSpace(em) of tkAccent: - if not em.inquote and endsInAlpha(em): wr(" ") - wr(TokTypeToStr[tok.tokType]) + if not em.inquote and endsInAlpha(em): wrSpace(em) + wr(em, $tok.tokType, ltOther) em.inquote = not em.inquote of tkComment: if not preventComment: - emitComment(em, tok) + emitComment(em, tok, dontIndent = false) of tkIntLit..tkStrLit, tkRStrLit, tkTripleStrLit, tkGStrLit, tkGTripleStrLit, tkCharLit: - let lit = fileSection(em.config, em.fid, tok.offsetA, tok.offsetB) - softLinebreak(em, lit) - if endsInAlpha(em) and tok.tokType notin {tkGStrLit, tkGTripleStrLit}: wr(" ") - em.lineSpan = countNewlines(lit) - if em.lineSpan > 0: calcCol(em, lit) - wr lit + 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 - softLinebreak(em, lit) - if endsInAlpha(em): wr(" ") - wr lit + if endsInAlpha(em): wrSpace(em) + wr em, lit, ltIdent em.lastTok = tok.tokType + em.lastTokWasTerse = lastTokWasTerse em.lastLineNumber = tok.line + em.lineSpan em.lineSpan = 0 +proc endsWith(em: Emitter; k: varargs[string]): bool = + if em.tokens.len < k.len: return false + for i in 0..high(k): + if em.tokens[em.tokens.len - k.len + i] != k[i]: return false + return true + +proc rfind(em: Emitter, t: string): int = + for i in 1..5: + if em.tokens[^i] == t: + return i + proc starWasExportMarker*(em: var Emitter) = - if em.content.endsWith(" * "): - setLen(em.content, em.content.len-3) - em.content.add("*") + if em.endsWith(" ", "*", " "): + setLen(em.tokens, em.tokens.len-3) + setLen(em.kinds, em.kinds.len-3) + em.tokens.add("*") + em.kinds.add ltExportMarker dec em.col, 2 proc commaWasSemicolon*(em: var Emitter) = - if em.content.endsWith(", "): - setLen(em.content, em.content.len-2) - em.content.add("; ") + if em.semicolons == detectSemicolonKind: + em.semicolons = if em.rfind(";") > 0: useSemicolon else: dontTouch + if em.semicolons == useSemicolon: + let commaPos = em.rfind(",") + if commaPos > 0: + em.tokens[^commaPos] = ";" proc curlyRiWasPragma*(em: var Emitter) = - if em.content.endsWith("}"): - setLen(em.content, em.content.len-1) - em.content.add(".}") + if em.endsWith("}"): + em.tokens[^1] = ".}" + inc em.col diff --git a/compiler/lexer.nim b/compiler/lexer.nim index c5afa6e97..ad5dd560c 100644 --- a/compiler/lexer.nim +++ b/compiler/lexer.nim @@ -7,64 +7,78 @@ # 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 wether we need to read in the next +# 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 + 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 type - TTokType* = enum - tkInvalid, tkEof, # order is important here! - tkSymbol, # keywords: - tkAddr, tkAnd, tkAs, tkAsm, - tkBind, tkBlock, tkBreak, tkCase, tkCast, - tkConcept, tkConst, tkContinue, tkConverter, - tkDefer, tkDiscard, tkDistinct, tkDiv, tkDo, - tkElif, tkElse, tkEnd, tkEnum, tkExcept, tkExport, - tkFinally, tkFor, tkFrom, tkFunc, - tkIf, tkImport, tkIn, tkInclude, tkInterface, - tkIs, tkIsnot, tkIterator, - tkLet, - tkMacro, tkMethod, tkMixin, tkMod, tkNil, tkNot, tkNotin, - tkObject, tkOf, tkOr, tkOut, - tkProc, tkPtr, tkRaise, tkRef, tkReturn, - tkShl, tkShr, tkStatic, - tkTemplate, - tkTry, tkTuple, tkType, tkUsing, - tkVar, tkWhen, tkWhile, tkXor, - tkYield, # end of keywords - tkIntLit, tkInt8Lit, tkInt16Lit, tkInt32Lit, tkInt64Lit, - tkUIntLit, tkUInt8Lit, tkUInt16Lit, tkUInt32Lit, tkUInt64Lit, - tkFloatLit, tkFloat32Lit, tkFloat64Lit, tkFloat128Lit, - tkStrLit, tkRStrLit, tkTripleStrLit, - tkGStrLit, tkGTripleStrLit, tkCharLit, tkParLe, tkParRi, tkBracketLe, - tkBracketRi, tkCurlyLe, tkCurlyRi, - tkBracketDotLe, tkBracketDotRi, # [. and .] - tkCurlyDotLe, tkCurlyDotRi, # {. and .} - tkParDotLe, tkParDotRi, # (. and .) - tkComma, tkSemiColon, - tkColon, tkColonColon, tkEquals, tkDot, tkDotDot, tkBracketLeColon, - tkOpr, tkComment, tkAccent, - tkSpaces, tkInfixOpr, tkPrefixOpr, tkPostfixOpr - - TTokTypes* = set[TTokType] + TokType* = enum + tkInvalid = "tkInvalid", tkEof = "[EOF]", # order is important here! + tkSymbol = "tkSymbol", # keywords: + tkAddr = "addr", tkAnd = "and", tkAs = "as", tkAsm = "asm", + tkBind = "bind", tkBlock = "block", tkBreak = "break", tkCase = "case", tkCast = "cast", + tkConcept = "concept", tkConst = "const", tkContinue = "continue", tkConverter = "converter", + tkDefer = "defer", tkDiscard = "discard", tkDistinct = "distinct", tkDiv = "div", tkDo = "do", + tkElif = "elif", tkElse = "else", tkEnd = "end", tkEnum = "enum", tkExcept = "except", tkExport = "export", + tkFinally = "finally", tkFor = "for", tkFrom = "from", tkFunc = "func", + tkIf = "if", tkImport = "import", tkIn = "in", tkInclude = "include", tkInterface = "interface", + tkIs = "is", tkIsnot = "isnot", tkIterator = "iterator", + tkLet = "let", + tkMacro = "macro", tkMethod = "method", tkMixin = "mixin", tkMod = "mod", tkNil = "nil", tkNot = "not", tkNotin = "notin", + tkObject = "object", tkOf = "of", tkOr = "or", tkOut = "out", + tkProc = "proc", tkPtr = "ptr", tkRaise = "raise", tkRef = "ref", tkReturn = "return", + tkShl = "shl", tkShr = "shr", tkStatic = "static", + tkTemplate = "template", + tkTry = "try", tkTuple = "tuple", tkType = "type", tkUsing = "using", + tkVar = "var", tkWhen = "when", tkWhile = "while", tkXor = "xor", + tkYield = "yield", # end of keywords + + tkIntLit = "tkIntLit", tkInt8Lit = "tkInt8Lit", tkInt16Lit = "tkInt16Lit", + tkInt32Lit = "tkInt32Lit", tkInt64Lit = "tkInt64Lit", + 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", + tkCustomLit = "tkCustomLit", + + tkParLe = "(", tkParRi = ")", tkBracketLe = "[", + tkBracketRi = "]", tkCurlyLe = "{", tkCurlyRi = "}", + tkBracketDotLe = "[.", tkBracketDotRi = ".]", + tkCurlyDotLe = "{.", tkCurlyDotRi = ".}", + tkParDotLe = "(.", tkParDotRi = ".)", + tkComma = ",", tkSemiColon = ";", + tkColon = ":", tkColonColon = "::", tkEquals = "=", + tkDot = ".", tkDotDot = "..", tkBracketLeColon = "[:", + tkOpr, tkComment, tkAccent = "`", + # these are fake tokens used by renderer.nim + tkSpaces, tkInfixOpr, tkPrefixOpr, tkPostfixOpr, tkHideableStart, tkHideableEnd + + TokTypes* = set[TokType] const weakTokens = {tkComma, tkSemiColon, tkColon, @@ -73,84 +87,50 @@ const # tokens that should not be considered for previousToken tokKeywordLow* = succ(tkSymbol) tokKeywordHigh* = pred(tkIntLit) - TokTypeToStr*: array[TTokType, string] = ["tkInvalid", "[EOF]", - "tkSymbol", - "addr", "and", "as", "asm", - "bind", "block", "break", "case", "cast", - "concept", "const", "continue", "converter", - "defer", "discard", "distinct", "div", "do", - "elif", "else", "end", "enum", "except", "export", - "finally", "for", "from", "func", "if", - "import", "in", "include", "interface", "is", "isnot", "iterator", - "let", - "macro", "method", "mixin", "mod", - "nil", "not", "notin", "object", "of", "or", - "out", "proc", "ptr", "raise", "ref", "return", - "shl", "shr", "static", - "template", - "try", "tuple", "type", "using", - "var", "when", "while", "xor", - "yield", - "tkIntLit", "tkInt8Lit", "tkInt16Lit", "tkInt32Lit", "tkInt64Lit", - "tkUIntLit", "tkUInt8Lit", "tkUInt16Lit", "tkUInt32Lit", "tkUInt64Lit", - "tkFloatLit", "tkFloat32Lit", "tkFloat64Lit", "tkFloat128Lit", - "tkStrLit", "tkRStrLit", - "tkTripleStrLit", "tkGStrLit", "tkGTripleStrLit", "tkCharLit", "(", - ")", "[", "]", "{", "}", "[.", ".]", "{.", ".}", "(.", ".)", - ",", ";", - ":", "::", "=", ".", "..", "[:", - "tkOpr", "tkComment", "`", - "tkSpaces", "tkInfixOpr", - "tkPrefixOpr", "tkPostfixOpr"] type - TNumericalBase* = enum + NumericalBase* = enum base10, # base10 is listed as the first element, # so that it is the correct default value base2, base8, base16 - CursorPosition* {.pure.} = enum ## XXX remove this again - None, InToken, BeforeToken, AfterToken - - TToken* = object # a Nim token - tokType*: TTokType # 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*: TNumericalBase # 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 - # like 0b01 or r"\L" are unaffected + offsetA*, offsetB*: int # used for pretty printing so that literals + # like 0b01 or r"\L" are unaffected commentOffsetA*, commentOffsetB*: int - TErrorHandler* = proc (conf: ConfigRef; info: TLineInfo; msg: TMsgKind; arg: string) - TLexer* = object of TBaseLexer + ErrorHandler* = proc (conf: ConfigRef; info: TLineInfo; msg: TMsgKind; arg: string) + Lexer* = object of TBaseLexer fileIdx*: FileIndex - indentAhead*: int # if > 0 an indendation has already been read + indentAhead*: int # if > 0 an indentation has already been read # this is needed because scanning comments # needs so much look-ahead currLineIndent*: int - strongSpaces*, allowTabs*: bool - cursor*: CursorPosition - errorHandler*: TErrorHandler + errorHandler*: ErrorHandler cache*: IdentCache when defined(nimsuggest): previousToken: TLineInfo + tokenEnd*: TLineInfo + previousTokenEnd*: TLineInfo config*: ConfigRef -when defined(nimpretty): - var - gIndentationWidth*: int - -proc getLineInfo*(L: TLexer, tok: TToken): TLineInfo {.inline.} = +proc getLineInfo*(L: Lexer, tok: Token): TLineInfo {.inline.} = result = newLineInfo(L.fileIdx, tok.line, tok.col) when defined(nimpretty): result.offsetA = tok.offsetA @@ -158,8 +138,8 @@ proc getLineInfo*(L: TLexer, tok: TToken): TLineInfo {.inline.} = result.commentOffsetA = tok.commentOffsetA result.commentOffsetB = tok.commentOffsetB -proc isKeyword*(kind: TTokType): bool = - result = (kind >= tokKeywordLow) and (kind <= tokKeywordHigh) +proc isKeyword*(kind: TokType): bool = + (kind >= tokKeywordLow) and (kind <= tokKeywordHigh) template ones(n): untyped = ((1 shl n)-1) # for utf-8 conversion @@ -169,62 +149,37 @@ 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 tokToStr*(tok: TToken): string = +proc `$`*(tok: Token): string = case tok.tokType - of tkIntLit..tkInt64Lit: result = $tok.iNumber - of tkFloatLit..tkFloat64Lit: result = $tok.fNumber - of tkInvalid, tkStrLit..tkCharLit, tkComment: result = tok.literal - of tkParLe..tkColon, tkEof, tkAccent: - result = TokTypeToStr[tok.tokType] + of tkIntLit..tkInt64Lit: $tok.iNumber + of tkFloatLit..tkFloat64Lit: $tok.fNumber + of tkInvalid, tkStrLit..tkCharLit, tkComment: tok.literal + of tkParLe..tkColon, tkEof, tkAccent: $tok.tokType else: if tok.ident != nil: - result = tok.ident.s + tok.ident.s else: - result = "" - -proc prettyTok*(tok: TToken): string = - if isKeyword(tok.tokType): result = "keyword " & tok.ident.s - else: result = tokToStr(tok) - -proc printTok*(conf: ConfigRef; tok: TToken) = - msgWriteln(conf, $tok.line & ":" & $tok.col & "\t" & - TokTypeToStr[tok.tokType] & " " & tokToStr(tok)) - -proc initToken*(L: var TToken) = - 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 TToken) = - 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 prettyTok*(tok: Token): string = + if isKeyword(tok.tokType): "keyword " & tok.ident.s + else: $tok -proc openLexer*(lex: var TLexer, fileIdx: FileIndex, inputstream: PLLStream; +proc printTok*(conf: ConfigRef; tok: Token) = + # xxx factor with toLocation + msgWriteln(conf, $tok.line & ":" & $tok.col & "\t" & $tok.tokType & " " & $tok) + +proc openLexer*(lex: var Lexer, fileIdx: FileIndex, inputstream: PLLStream; cache: IdentCache; config: ConfigRef) = openBaseLexer(lex, inputstream) - lex.fileIdx = fileidx - lex.indentAhead = - 1 + lex.fileIdx = fileIdx + lex.indentAhead = -1 lex.currLineIndent = 0 inc(lex.lineNumber, inputstream.lineOffset) lex.cache = cache @@ -232,36 +187,36 @@ proc openLexer*(lex: var TLexer, fileIdx: FileIndex, inputstream: PLLStream; lex.previousToken.fileIndex = fileIdx lex.config = config -proc openLexer*(lex: var TLexer, filename: string, inputstream: PLLStream; +proc openLexer*(lex: var Lexer, filename: AbsoluteFile, inputstream: PLLStream; cache: IdentCache; config: ConfigRef) = openLexer(lex, fileInfoIdx(config, filename), inputstream, cache, config) -proc closeLexer*(lex: var TLexer) = +proc closeLexer*(lex: var Lexer) = if lex.config != nil: inc(lex.config.linesCompiled, lex.lineNumber) closeBaseLexer(lex) -proc getLineInfo(L: TLexer): TLineInfo = +proc getLineInfo(L: Lexer): TLineInfo = result = newLineInfo(L.fileIdx, L.lineNumber, getColNumber(L, L.bufpos)) -proc dispMessage(L: TLexer; info: TLineInfo; msg: TMsgKind; arg: string) = +proc dispMessage(L: Lexer; info: TLineInfo; msg: TMsgKind; arg: string) = if L.errorHandler.isNil: msgs.message(L.config, info, msg, arg) else: L.errorHandler(L.config, info, msg, arg) -proc lexMessage*(L: TLexer, msg: TMsgKind, arg = "") = +proc lexMessage*(L: Lexer, msg: TMsgKind, arg = "") = L.dispMessage(getLineInfo(L), msg, arg) -proc lexMessageTok*(L: TLexer, msg: TMsgKind, tok: TToken, arg = "") = +proc lexMessageTok*(L: Lexer, msg: TMsgKind, tok: Token, arg = "") = var info = newLineInfo(L.fileIdx, tok.line, tok.col) L.dispMessage(info, msg, arg) -proc lexMessagePos(L: var TLexer, msg: TMsgKind, pos: int, arg = "") = +proc lexMessagePos(L: var Lexer, msg: TMsgKind, pos: int, arg = "") = var info = newLineInfo(L.fileIdx, L.lineNumber, pos - L.lineStart) L.dispMessage(info, msg, arg) -proc matchTwoChars(L: TLexer, first: char, second: set[char]): bool = +proc matchTwoChars(L: Lexer, first: char, second: set[char]): bool = result = (L.buf[L.bufpos] == first) and (L.buf[L.bufpos + 1] in second) template tokenBegin(tok, pos) {.dirty.} = @@ -275,7 +230,6 @@ template tokenEnd(tok, pos) {.dirty.} = let colB = getColNumber(L, pos)+1 if L.fileIdx == L.config.m.trackPos.fileIndex and L.config.m.trackPos.col in colA..colB and L.lineNumber == L.config.m.trackPos.line.int and L.config.ideCmd in {ideSug, ideCon}: - L.cursor = CursorPosition.InToken L.config.m.trackPos.col = colA.int16 colA = 0 when defined(nimpretty): @@ -300,312 +254,317 @@ template tokenEndPrevious(tok, pos) = let colB = getColNumber(L, pos) if L.fileIdx == L.config.m.trackPos.fileIndex and L.config.m.trackPos.col in colA..colB and L.lineNumber == L.config.m.trackPos.line.int and L.config.ideCmd in {ideSug, ideCon}: - L.cursor = CursorPosition.BeforeToken L.config.m.trackPos = L.previousToken L.config.m.trackPosAttached = true colA = 0 when defined(nimpretty): tok.offsetB = L.offsetBase + pos -{.push overflowChecks: off.} -# We need to parse the largest uint literal without overflow checks -proc unsafeParseUInt(s: string, b: var BiggestInt, start = 0): int = - var i = start - if i < s.len and s[i] in {'0'..'9'}: - b = 0 - while i < s.len and s[i] in {'0'..'9'}: - b = b * 10 + (ord(s[i]) - ord('0')) - inc(i) - while i < s.len and s[i] == '_': inc(i) # underscores are allowed and ignored - result = i - start -{.pop.} # overflowChecks - - -template eatChar(L: var TLexer, t: var TToken, replacementChar: char) = - add(t.literal, replacementChar) +template eatChar(L: var Lexer, t: var Token, replacementChar: char) = + t.literal.add(replacementChar) inc(L.bufpos) -template eatChar(L: var TLexer, t: var TToken) = - add(t.literal, L.buf[L.bufpos]) +template eatChar(L: var Lexer, t: var Token) = + t.literal.add(L.buf[L.bufpos]) inc(L.bufpos) -proc getNumber(L: var TLexer, result: var TToken) = - proc matchUnderscoreChars(L: var TLexer, tok: var TToken, chars: set[char]) = +proc getNumber(L: var Lexer, result: var Token) = + proc matchUnderscoreChars(L: var Lexer, tok: var Token, chars: set[char]): Natural = var pos = L.bufpos # use registers for pos, buf - var buf = L.buf + result = 0 while true: - if buf[pos] in chars: - add(tok.literal, buf[pos]) + if L.buf[pos] in chars: + tok.literal.add(L.buf[pos]) inc(pos) + inc(result) else: break - if buf[pos] == '_': - if buf[pos+1] notin chars: + if L.buf[pos] == '_': + if L.buf[pos+1] notin chars: lexMessage(L, errGenerated, - "only single underscores may occur in a token: '__' is invalid") + "only single underscores may occur in a token and token may not " & + "end with an underscore: e.g. '1__1' and '1_' are invalid") break - add(tok.literal, '_') + tok.literal.add('_') inc(pos) L.bufpos = pos - proc matchChars(L: var TLexer, tok: var TToken, chars: set[char]) = + proc matchChars(L: var Lexer, tok: var Token, chars: set[char]) = var pos = L.bufpos # use registers for pos, buf - var buf = L.buf - while buf[pos] in chars: - add(tok.literal, buf[pos]) + while L.buf[pos] in chars: + tok.literal.add(L.buf[pos]) inc(pos) L.bufpos = pos - proc lexMessageLitNum(L: var TLexer, msg: string, startpos: int) = + proc lexMessageLitNum(L: var Lexer, msg: string, startpos: int, msgKind = errGenerated) = # Used to get slightly human friendlier err messages. - # Note: the erroneous 'O' char in the character set is intentional - 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: TToken - 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 if L.buf[L.bufpos] in {'+', '-'} and L.buf[L.bufpos - 1] in {'e', 'E'}: - add(t.literal, L.buf[L.bufpos]) + 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'}: + if L.buf[L.bufpos] in literalishChars: + t.literal.add(L.buf[L.bufpos]) inc(L.bufpos) - add(t.literal, L.buf[L.bufpos]) matchChars(L, t, {'0'..'9'}) L.bufpos = msgPos - lexMessage(L, errGenerated, msg % t.literal) + lexMessage(L, msgKind, msg % t.literal) var - startpos, endpos: int xi: BiggestInt isBase10 = true + numDigits = 0 const - baseCodeChars = {'X', 'x', 'o', 'c', 'C', 'b', 'B'} + # 'c', 'C' is deprecated + baseCodeChars = {'X', 'x', 'o', 'b', 'B', 'c', 'C'} literalishChars = baseCodeChars + {'A'..'F', 'a'..'f', '0'..'9', '_', '\''} floatTypes = {tkFloatLit, tkFloat32Lit, tkFloat64Lit, tkFloat128Lit} 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 - if L.buf[L.bufpos] == '0' and L.buf[L.bufpos + 1] in baseCodeChars + {'O'}: + # {'c', 'C'} is added for deprecation reasons to provide a clear error message + if L.buf[L.bufpos] == '0' and L.buf[L.bufpos + 1] in baseCodeChars + {'c', 'C', 'O'}: isBase10 = false eatChar(L, result, '0') case L.buf[L.bufpos] + of 'c', 'C': + lexMessageLitNum(L, + "$1 will soon be invalid for oct literals; Use '0o' " & + "for octals. 'c', 'C' prefix", + startpos, + warnDeprecated) + eatChar(L, result, 'c') + numDigits = matchUnderscoreChars(L, result, {'0'..'7'}) of 'O': - lexMessageLitNum(L, "$1 is not a valid number; did you mean octal? Then use one of '0o', '0c' or '0C'.", startpos) + lexMessageLitNum(L, "$1 is an invalid int literal; For octal literals " & + "use the '0o' prefix.", startpos) of 'x', 'X': eatChar(L, result, 'x') - matchUnderscoreChars(L, result, {'0'..'9', 'a'..'f', 'A'..'F'}) - of 'o', 'c', 'C': - eatChar(L, result, 'c') - matchUnderscoreChars(L, result, {'0'..'7'}) + numDigits = matchUnderscoreChars(L, result, {'0'..'9', 'a'..'f', 'A'..'F'}) + of 'o': + eatChar(L, result, 'o') + numDigits = matchUnderscoreChars(L, result, {'0'..'7'}) of 'b', 'B': eatChar(L, result, 'b') - matchUnderscoreChars(L, result, {'0'..'1'}) + numDigits = matchUnderscoreChars(L, result, {'0'..'1'}) else: internalError(L.config, getLineInfo(L), "getNumber") + if numDigits == 0: + lexMessageLitNum(L, "invalid number: '$1'", startpos) else: - matchUnderscoreChars(L, result, {'0'..'9'}) + discard matchUnderscoreChars(L, result, {'0'..'9'}) if (L.buf[L.bufpos] == '.') and (L.buf[L.bufpos + 1] in {'0'..'9'}): result.tokType = tkFloatLit eatChar(L, result, '.') - matchUnderscoreChars(L, result, {'0'..'9'}) + 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) - matchUnderscoreChars(L, result, {'0'..'9'}) - endpos = L.bufpos + discard matchUnderscoreChars(L, result, {'0'..'9'}) + 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) - 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')) + 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) - of 'A'..'F': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('A') + 10) - 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 = BiggestInt(int8(toU8(int(xi)))) - of tkInt16Lit: result.iNumber = BiggestInt(int16(toU16(int(xi)))) - of tkInt32Lit: result.iNumber = BiggestInt(int32(toU32(int64(xi)))) - of tkUIntLit, tkUInt64Lit: result.iNumber = xi - of tkUInt8Lit: result.iNumber = BiggestInt(uint8(toU8(int(xi)))) - of tkUInt16Lit: result.iNumber = BiggestInt(uint16(toU16(int(xi)))) - of tkUInt32Lit: result.iNumber = BiggestInt(uint32(toU32(int64(xi)))) - 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: - xi = 0 - let len = unsafeParseUInt(result.literal, xi) - if len != result.literal.len or len == 0: - raise newException(ValueError, "invalid integer: " & $xi) - result.iNumber = xi - else: - result.iNumber = parseBiggestInt(result.literal) + # 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 - # Explicit bounds checks - let outOfRange = - case result.tokType - of tkInt8Lit: (result.iNumber < int8.low or result.iNumber > int8.high) - of tkUInt8Lit: (result.iNumber < BiggestInt(uint8.low) or - result.iNumber > BiggestInt(uint8.high)) - of tkInt16Lit: (result.iNumber < int16.low or result.iNumber > int16.high) - of tkUInt16Lit: (result.iNumber < BiggestInt(uint16.low) or - result.iNumber > BiggestInt(uint16.high)) - of tkInt32Lit: (result.iNumber < int32.low or result.iNumber > int32.high) - of tkUInt32Lit: (result.iNumber < BiggestInt(uint32.low) or - 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 < low(int32)) or (result.iNumber > high(int32)): - result.tokType = tkInt64Lit - - except ValueError: - lexMessageLitNum(L, "invalid number: '$1'", startpos) - except OverflowError, RangeError: - lexMessageLitNum(L, "number out of range: '$1'", startpos) + 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 -proc handleHexChar(L: var TLexer, xi: var int) = +proc handleHexChar(L: var Lexer, xi: var int; position: range[0..4]) = + template invalid() = + lexMessage(L, errGenerated, + "expected a hex digit, but found: " & L.buf[L.bufpos] & + "; maybe prepend with 0") + case L.buf[L.bufpos] of '0'..'9': xi = (xi shl 4) or (ord(L.buf[L.bufpos]) - ord('0')) @@ -616,104 +575,142 @@ proc handleHexChar(L: var TLexer, xi: var int) = of 'A'..'F': xi = (xi shl 4) or (ord(L.buf[L.bufpos]) - ord('A') + 10) inc(L.bufpos) - else: discard + of '"', '\'': + if position <= 1: invalid() + # do not progress the bufpos here. + if position == 0: inc(L.bufpos) + else: + invalid() + # Need to progress for `nim check` + inc(L.bufpos) -proc handleDecChars(L: var TLexer, xi: var int) = +proc handleDecChars(L: var Lexer, xi: var int) = while L.buf[L.bufpos] in {'0'..'9'}: xi = (xi * 10) + (ord(L.buf[L.bufpos]) - ord('0')) inc(L.bufpos) -proc getEscapedChar(L: var TLexer, tok: var TToken) = +proc addUnicodeCodePoint(s: var string, i: int) = + let i = cast[uint](i) + # inlined toUTF-8 to avoid unicode and strutils dependencies. + let pos = s.len + if i <= 127: + s.setLen(pos+1) + s[pos+0] = chr(i) + elif i <= 0x07FF: + s.setLen(pos+2) + s[pos+0] = chr((i shr 6) or 0b110_00000) + s[pos+1] = chr((i and ones(6)) or 0b10_0000_00) + elif i <= 0xFFFF: + s.setLen(pos+3) + s[pos+0] = chr(i shr 12 or 0b1110_0000) + s[pos+1] = chr(i shr 6 and ones(6) or 0b10_0000_00) + s[pos+2] = chr(i and ones(6) or 0b10_0000_00) + elif i <= 0x001FFFFF: + s.setLen(pos+4) + s[pos+0] = chr(i shr 18 or 0b1111_0000) + s[pos+1] = chr(i shr 12 and ones(6) or 0b10_0000_00) + s[pos+2] = chr(i shr 6 and ones(6) or 0b10_0000_00) + s[pos+3] = chr(i and ones(6) or 0b10_0000_00) + elif i <= 0x03FFFFFF: + s.setLen(pos+5) + s[pos+0] = chr(i shr 24 or 0b111110_00) + s[pos+1] = chr(i shr 18 and ones(6) or 0b10_0000_00) + s[pos+2] = chr(i shr 12 and ones(6) or 0b10_0000_00) + s[pos+3] = chr(i shr 6 and ones(6) or 0b10_0000_00) + s[pos+4] = chr(i and ones(6) or 0b10_0000_00) + elif i <= 0x7FFFFFFF: + s.setLen(pos+6) + s[pos+0] = chr(i shr 30 or 0b1111110_0) + s[pos+1] = chr(i shr 24 and ones(6) or 0b10_0000_00) + s[pos+2] = chr(i shr 18 and ones(6) or 0b10_0000_00) + s[pos+3] = chr(i shr 12 and ones(6) or 0b10_0000_00) + s[pos+4] = chr(i shr 6 and ones(6) or 0b10_0000_00) + s[pos+5] = chr(i and ones(6) or 0b10_0000_00) + +proc getEscapedChar(L: var Lexer, tok: var Token) = inc(L.bufpos) # skip '\' case L.buf[L.bufpos] of 'n', 'N': - if L.config.oldNewlines: - if tok.tokType == tkCharLit: - lexMessage(L, errGenerated, "\\n not allowed in character literal") - add(tok.literal, L.config.target.tnl) - else: - add(tok.literal, '\L') + tok.literal.add('\L') inc(L.bufpos) of 'p', 'P': if tok.tokType == tkCharLit: lexMessage(L, errGenerated, "\\p not allowed in character literal") - add(tok.literal, L.config.target.tnl) + tok.literal.add(L.config.target.tnl) inc(L.bufpos) of 'r', 'R', 'c', 'C': - add(tok.literal, CR) + tok.literal.add(CR) inc(L.bufpos) of 'l', 'L': - add(tok.literal, LF) + tok.literal.add(LF) inc(L.bufpos) of 'f', 'F': - add(tok.literal, FF) + tok.literal.add(FF) inc(L.bufpos) of 'e', 'E': - add(tok.literal, ESC) + tok.literal.add(ESC) inc(L.bufpos) of 'a', 'A': - add(tok.literal, BEL) + tok.literal.add(BEL) inc(L.bufpos) of 'b', 'B': - add(tok.literal, BACKSPACE) + tok.literal.add(BACKSPACE) inc(L.bufpos) of 'v', 'V': - add(tok.literal, VT) + tok.literal.add(VT) inc(L.bufpos) of 't', 'T': - add(tok.literal, '\t') + tok.literal.add('\t') inc(L.bufpos) of '\'', '\"': - add(tok.literal, L.buf[L.bufpos]) + tok.literal.add(L.buf[L.bufpos]) inc(L.bufpos) of '\\': - add(tok.literal, '\\') + tok.literal.add('\\') inc(L.bufpos) - of 'x', 'X', 'u', 'U': - var tp = L.buf[L.bufpos] + of 'x', 'X': inc(L.bufpos) var xi = 0 - handleHexChar(L, xi) - handleHexChar(L, xi) - if tp in {'u', 'U'}: - handleHexChar(L, xi) - handleHexChar(L, xi) - # inlined toUTF-8 to avoid unicode and strutils dependencies. - if xi <=% 127: - add(tok.literal, xi.char ) - elif xi <=% 0x07FF: - add(tok.literal, ((xi shr 6) or 0b110_00000).char ) - add(tok.literal, ((xi and ones(6)) or 0b10_0000_00).char ) - elif xi <=% 0xFFFF: - add(tok.literal, (xi shr 12 or 0b1110_0000).char ) - add(tok.literal, (xi shr 6 and ones(6) or 0b10_0000_00).char ) - add(tok.literal, (xi and ones(6) or 0b10_0000_00).char ) - else: # value is 0xFFFF - add(tok.literal, "\xef\xbf\xbf" ) + handleHexChar(L, xi, 1) + handleHexChar(L, xi, 2) + tok.literal.add(chr(xi)) + of 'u', 'U': + if tok.tokType == tkCharLit: + lexMessage(L, errGenerated, "\\u not allowed in character literal") + inc(L.bufpos) + var xi = 0 + if L.buf[L.bufpos] == '{': + inc(L.bufpos) + var start = L.bufpos + while L.buf[L.bufpos] != '}': + handleHexChar(L, xi, 0) + if start == L.bufpos: + lexMessage(L, errGenerated, + "Unicode codepoint cannot be empty") + inc(L.bufpos) + if xi > 0x10FFFF: + let hex = ($L.buf)[start..L.bufpos-2] + lexMessage(L, errGenerated, + "Unicode codepoint must be lower than 0x10FFFF, but was: " & hex) else: - add(tok.literal, chr(xi)) + handleHexChar(L, xi, 1) + handleHexChar(L, xi, 2) + handleHexChar(L, xi, 3) + handleHexChar(L, xi, 4) + addUnicodeCodePoint(tok.literal, xi) of '0'..'9': if matchTwoChars(L, '0', {'0'..'9'}): lexMessage(L, warnOctalEscape) var xi = 0 handleDecChars(L, xi) - if (xi <= 255): add(tok.literal, chr(xi)) + if (xi <= 255): tok.literal.add(chr(xi)) else: lexMessage(L, errGenerated, "invalid character constant") else: lexMessage(L, errGenerated, "invalid character constant") -proc newString(s: cstring, len: int): string = - ## XXX, how come there is no support for this? - result = newString(len) - for i in 0 ..< len: - result[i] = s[i] - -proc handleCRLF(L: var TLexer, pos: int): int = +proc handleCRLF(L: var Lexer, pos: int): int = template registerLine = let col = L.getColNumber(pos) - if col > MaxLineLength: - lexMessagePos(L, hintLineTooLong, pos) - case L.buf[pos] of CR: registerLine() @@ -723,37 +720,40 @@ proc handleCRLF(L: var TLexer, pos: int): int = result = nimlexbase.handleLF(L, pos) else: result = pos -proc getString(L: var TLexer, tok: var TToken, rawMode: bool) = +type + StringMode = enum + normal, + raw, + generalized + +proc getString(L: var Lexer, tok: var Token, mode: StringMode) = var pos = L.bufpos - var buf = L.buf # put `buf` in a register var line = L.lineNumber # save linenumber for better error message - tokenBegin(tok, pos) + tokenBegin(tok, pos - ord(mode == raw)) inc pos # skip " - if buf[pos] == '\"' and buf[pos+1] == '\"': + if L.buf[pos] == '\"' and L.buf[pos+1] == '\"': tok.tokType = tkTripleStrLit # long string literal: inc(pos, 2) # skip "" # skip leading newline: - if buf[pos] in {' ', '\t'}: + if L.buf[pos] in {' ', '\t'}: var newpos = pos+1 - while buf[newpos] in {' ', '\t'}: inc newpos - if buf[newpos] in {CR, LF}: pos = newpos + while L.buf[newpos] in {' ', '\t'}: inc newpos + if L.buf[newpos] in {CR, LF}: pos = newpos pos = handleCRLF(L, pos) - buf = L.buf while true: - case buf[pos] + case L.buf[pos] of '\"': - if buf[pos+1] == '\"' and buf[pos+2] == '\"' and - buf[pos+3] != '\"': + if L.buf[pos+1] == '\"' and L.buf[pos+2] == '\"' and + L.buf[pos+3] != '\"': tokenEndIgnore(tok, pos+2) L.bufpos = pos + 3 # skip the three """ break - add(tok.literal, '\"') + tok.literal.add('\"') inc(pos) of CR, LF: tokenEndIgnore(tok, pos) pos = handleCRLF(L, pos) - buf = L.buf - add(tok.literal, "\n") + tok.literal.add("\n") of nimlexbase.EndOfFile: tokenEndIgnore(tok, pos) var line2 = L.lineNumber @@ -763,18 +763,18 @@ proc getString(L: var TLexer, tok: var TToken, rawMode: bool) = L.bufpos = pos break else: - add(tok.literal, buf[pos]) + tok.literal.add(L.buf[pos]) inc(pos) else: # ordinary string literal - if rawMode: tok.tokType = tkRStrLit + if mode != normal: tok.tokType = tkRStrLit else: tok.tokType = tkStrLit while true: - var c = buf[pos] + let c = L.buf[pos] if c == '\"': - if rawMode and buf[pos+1] == '\"': + if mode != normal and L.buf[pos+1] == '\"': inc(pos, 2) - add(tok.literal, '"') + tok.literal.add('"') else: tokenEndIgnore(tok, pos) inc(pos) # skip '"' @@ -783,145 +783,243 @@ proc getString(L: var TLexer, tok: var TToken, rawMode: bool) = tokenEndIgnore(tok, pos) lexMessage(L, errGenerated, "closing \" expected") break - elif (c == '\\') and not rawMode: + elif (c == '\\') and mode == normal: L.bufpos = pos getEscapedChar(L, tok) pos = L.bufpos else: - add(tok.literal, c) + tok.literal.add(c) inc(pos) L.bufpos = pos -proc getCharacter(L: var TLexer, tok: var TToken) = +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") + of '\0'..pred(' '), '\'': + lexMessage(L, errGenerated, "invalid character literal") + tok.literal = $c of '\\': getEscapedChar(L, tok) 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 TLexer, tok: var TToken) = +proc getSymbol(L: var Lexer, tok: var Token) = var h: Hash = 0 var pos = L.bufpos - var buf = L.buf tokenBegin(tok, pos) + var suspicious = false while true: - var c = buf[pos] + 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': c = chr(ord(c) + (ord('a') - ord('A'))) # toLower() h = h !& ord(c) inc(pos) + suspicious = true of '_': - if buf[pos+1] notin SymChars: + if L.buf[pos+1] notin SymChars: lexMessage(L, errGenerated, "invalid token: trailing underscore") 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) - L.bufpos = pos + 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 else: - tok.tokType = TTokType(tok.ident.id + ord(tkSymbol)) + tok.tokType = TokType(tok.ident.id + ord(tkSymbol)) + if suspicious and {optStyleHint, optStyleError} * L.config.globalOptions != {}: + lintReport(L.config, getLineInfo(L), tok.ident.s.normalize, tok.ident.s) + L.bufpos = pos + -proc endOperator(L: var TLexer, tok: var TToken, pos: int, +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 = TTokType(tok.ident.id - oprLow + ord(tkColon)) + else: tok.tokType = TokType(tok.ident.id - oprLow + ord(tkColon)) L.bufpos = pos -proc getOperator(L: var TLexer, tok: var TToken) = +proc getOperator(L: var Lexer, tok: var Token) = var pos = L.bufpos - var buf = L.buf tokenBegin(tok, pos) var h: Hash = 0 while true: - var c = 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 - while buf[pos] == ' ': + tok.spacing = tok.spacing - {tsTrailing, tsEof} + var trailing = false + while L.buf[pos] == ' ': inc pos - inc tok.strongSpaceB - if buf[pos] in {CR, LF, nimlexbase.EndOfFile}: - tok.strongSpaceB = -1 - -proc newlineFollows*(L: TLexer): bool = - var pos = L.bufpos - var buf = L.buf - while true: - case buf[pos] - of ' ', '\t': - inc(pos) - of CR, LF: - result = true - break - of '#': - inc(pos) - if buf[pos] == '#': inc(pos) - if buf[pos] != '[': return true - else: - break - -proc skipMultiLineComment(L: var TLexer; tok: var TToken; start: int; + trailing = true + if L.buf[pos] in {CR, LF, nimlexbase.EndOfFile}: + 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 0 + + template considerAsgn(value: untyped) = + result = if tok.ident.s[^1] == '=': 1 else: value + + case relevantChar + of '$', '^': considerAsgn(10) + of '*', '%', '/', '\\': considerAsgn(MulPred) + of '~': result = 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 + of tkIn, tkNotin, tkIs, tkIsnot, tkOf, tkAs, tkFrom: result = 5 + of tkAnd: result = 4 + of tkOr, tkXor, tkPtr, tkRef: result = 3 + else: return -10 + +proc skipMultiLineComment(L: var Lexer; tok: var Token; start: int; isDoc: bool) = var pos = start - var buf = L.buf var toStrip = 0 tokenBegin(tok, pos) # detect the amount of indentation: if isDoc: toStrip = getColNumber(L, pos) - while buf[pos] == ' ': inc pos - if buf[pos] in {CR, LF}: + while L.buf[pos] == ' ': + inc pos + inc toStrip + while L.buf[pos] in {CR, LF}: # skip blank lines pos = handleCRLF(L, pos) - buf = L.buf toStrip = 0 - while buf[pos] == ' ': + while L.buf[pos] == ' ': inc pos inc toStrip var nesting = 0 while true: - case buf[pos] + case L.buf[pos] of '#': if isDoc: - if buf[pos+1] == '#' and buf[pos+2] == '[': + if L.buf[pos+1] == '#' and L.buf[pos+2] == '[': inc nesting tok.literal.add '#' - elif buf[pos+1] == '[': + elif L.buf[pos+1] == '[': inc nesting inc pos of ']': if isDoc: - if buf[pos+1] == '#' and buf[pos+2] == '#': + if L.buf[pos+1] == '#' and L.buf[pos+2] == '#': if nesting == 0: tokenEndIgnore(tok, pos+2) inc(pos, 3) break dec nesting tok.literal.add ']' - elif buf[pos+1] == '#': + elif L.buf[pos+1] == '#': if nesting == 0: tokenEndIgnore(tok, pos+1) inc(pos, 2) @@ -931,14 +1029,12 @@ proc skipMultiLineComment(L: var TLexer; tok: var TToken; start: int; of CR, LF: tokenEndIgnore(tok, pos) pos = handleCRLF(L, pos) - buf = L.buf # strip leading whitespace: when defined(nimpretty): tok.literal.add "\L" if isDoc: when not defined(nimpretty): tok.literal.add "\n" - inc tok.iNumber var c = toStrip - while buf[pos] == ' ' and c > 0: + while L.buf[pos] == ' ' and c > 0: inc pos dec c of nimlexbase.EndOfFile: @@ -946,57 +1042,57 @@ proc skipMultiLineComment(L: var TLexer; tok: var TToken; start: int; lexMessagePos(L, errGenerated, pos, "end of multiline comment expected") break else: - if isDoc or defined(nimpretty): tok.literal.add buf[pos] + if isDoc or defined(nimpretty): tok.literal.add L.buf[pos] inc(pos) L.bufpos = pos when defined(nimpretty): tok.commentOffsetB = L.offsetBase + pos - 1 -proc scanComment(L: var TLexer, tok: var TToken) = +proc scanComment(L: var Lexer, tok: var Token) = var pos = L.bufpos - var buf = L.buf tok.tokType = tkComment - # iNumber contains the number of '\n' in the token - tok.iNumber = 0 - assert buf[pos+1] == '#' + assert L.buf[pos+1] == '#' when defined(nimpretty): - tok.commentOffsetA = L.offsetBase + pos - 1 + tok.commentOffsetA = L.offsetBase + pos - if buf[pos+2] == '[': + if L.buf[pos+2] == '[': skipMultiLineComment(L, tok, pos+3, true) return tokenBegin(tok, pos) inc(pos, 2) var toStrip = 0 - while buf[pos] == ' ': - inc pos - inc toStrip + var stripInit = false while true: - var lastBackslash = -1 - while buf[pos] notin {CR, LF, nimlexbase.EndOfFile}: - if buf[pos] == '\\': lastBackslash = pos+1 - add(tok.literal, buf[pos]) + if not stripInit: # find baseline indentation inside comment + while L.buf[pos] == ' ': + inc pos + inc toStrip + if L.buf[pos] in {CR, LF}: # don't set toStrip in blank comment lines + toStrip = 0 + else: # found first non-whitespace character + stripInit = true + while L.buf[pos] notin {CR, LF, nimlexbase.EndOfFile}: + tok.literal.add(L.buf[pos]) inc(pos) tokenEndIgnore(tok, pos) pos = handleCRLF(L, pos) - buf = L.buf var indent = 0 - while buf[pos] == ' ': + while L.buf[pos] == ' ': inc(pos) inc(indent) - if buf[pos] == '#' and buf[pos+1] == '#': + if L.buf[pos] == '#' and L.buf[pos+1] == '#': tok.literal.add "\n" inc(pos, 2) - var c = toStrip - while buf[pos] == ' ' and c > 0: - inc pos - dec c - inc tok.iNumber + if stripInit: + var c = toStrip + while L.buf[pos] == ' ' and c > 0: + inc pos + dec c else: - if buf[pos] > ' ': + if L.buf[pos] > ' ': L.indentAhead = indent tokenEndIgnore(tok, pos) break @@ -1004,58 +1100,65 @@ proc scanComment(L: var TLexer, tok: var TToken) = when defined(nimpretty): tok.commentOffsetB = L.offsetBase + pos - 1 -proc skip(L: var TLexer, tok: var TToken) = +proc skip(L: var Lexer, tok: var Token) = var pos = L.bufpos - var buf = L.buf tokenBegin(tok, pos) - tok.strongSpaceA = 0 + tok.spacing.excl(tsLeading) when defined(nimpretty): var hasComment = false + var commentIndent = L.currLineIndent tok.commentOffsetA = L.offsetBase + pos tok.commentOffsetB = tok.commentOffsetA + tok.line = -1 while true: - case buf[pos] + case L.buf[pos] of ' ': inc(pos) - inc(tok.strongSpaceA) + tok.spacing.incl(tsLeading) of '\t': - if not L.allowTabs: lexMessagePos(L, errGenerated, pos, "tabulators are not allowed") + lexMessagePos(L, errGenerated, pos, "tabs are not allowed, use spaces instead") inc(pos) of CR, LF: tokenEndPrevious(tok, pos) - when defined(nimpretty): - # we are not yet in a comment, so update the comment token's line information: - if not hasComment: inc tok.line pos = handleCRLF(L, pos) - buf = L.buf var indent = 0 while true: - if buf[pos] == ' ': + if L.buf[pos] == ' ': inc(pos) inc(indent) - elif buf[pos] == '#' and buf[pos+1] == '[': - when defined(nimpretty): hasComment = true + elif L.buf[pos] == '#' and L.buf[pos+1] == '[': + when defined(nimpretty): + hasComment = true + if tok.line < 0: + tok.line = L.lineNumber + commentIndent = indent skipMultiLineComment(L, tok, pos+2, false) pos = L.bufpos - buf = L.buf else: break - tok.strongSpaceA = 0 - if buf[pos] > ' ' and (buf[pos] != '#' or buf[pos+1] == '#'): + 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] == '#'): tok.indent = indent L.currLineIndent = indent break of '#': # do not skip documentation comment: - if buf[pos+1] == '#': break - when defined(nimpretty): hasComment = true - if buf[pos+1] == '[': + if L.buf[pos+1] == '#': break + when defined(nimpretty): + hasComment = true + if tok.line < 0: + tok.line = L.lineNumber + + if L.buf[pos+1] == '[': skipMultiLineComment(L, tok, pos+2, false) pos = L.bufpos - buf = L.buf else: tokenBegin(tok, pos) - while buf[pos] notin {CR, LF, nimlexbase.EndOfFile}: inc(pos) + while L.buf[pos] notin {CR, LF, nimlexbase.EndOfFile}: + when defined(nimpretty): tok.literal.add L.buf[pos] + inc(pos) tokenEndIgnore(tok, pos+1) when defined(nimpretty): tok.commentOffsetB = L.offsetBase + pos + 1 @@ -1067,20 +1170,21 @@ proc skip(L: var TLexer, tok: var TToken) = if hasComment: tok.commentOffsetB = L.offsetBase + pos - 1 tok.tokType = tkComment - if gIndentationWidth <= 0: - gIndentationWidth = tok.indent + tok.indent = commentIndent -proc rawGetTok*(L: var TLexer, tok: var TToken) = +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 - when defined(nimsuggest): - L.cursor = CursorPosition.None - fillToken(tok) + reset(tok) if L.indentAhead >= 0: tok.indent = L.indentAhead L.currLineIndent = L.indentAhead @@ -1092,13 +1196,18 @@ proc rawGetTok*(L: var TLexer, tok: var TToken) = 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 '*': @@ -1115,7 +1224,7 @@ proc rawGetTok*(L: var TLexer, tok: var TToken) = of 'r', 'R': if L.buf[L.bufpos + 1] == '\"': inc(L.bufpos) - getString(L, tok, true) + getString(L, tok, raw) else: getSymbol(L, tok) of '(': @@ -1150,7 +1259,6 @@ proc rawGetTok*(L: var TLexer, tok: var TToken) = if L.fileIdx == L.config.m.trackPos.fileIndex and tok.col+1 == L.config.m.trackPos.col and tok.line == L.config.m.trackPos.line.int and L.config.ideCmd == ideSug: tok.tokType = tkDot - L.cursor = CursorPosition.InToken L.config.m.trackPos.col = tok.col.int16 inc(L.bufpos) atTokenEnd() @@ -1192,10 +1300,10 @@ proc rawGetTok*(L: var TLexer, tok: var TToken) = tok.tokType = tkInvalid lexMessage(L, errGenerated, "invalid token: " & c & " (\\" & $(ord(c)) & ')') of '\"': - # check for extended raw string literal: - var rawMode = L.bufpos > 0 and L.buf[L.bufpos-1] in SymChars - getString(L, tok, rawMode) - if rawMode: + # check for generalized raw string literal: + let mode = if L.bufpos > 0 and L.buf[L.bufpos-1] in SymChars: generalized else: normal + getString(L, tok, mode) + if mode == generalized: # tkRStrLit -> tkGStrLit # tkTripleStrLit -> tkGTripleStrLit inc(tok.tokType, 2) @@ -1207,7 +1315,28 @@ proc rawGetTok*(L: var TLexer, tok: var TToken) = 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) @@ -1223,12 +1352,26 @@ proc rawGetTok*(L: var TLexer, tok: var TToken) = proc getIndentWidth*(fileIdx: FileIndex, inputstream: PLLStream; cache: IdentCache; config: ConfigRef): int = - var lex: TLexer - var tok: TToken - initToken(tok) + result = 0 + var lex: Lexer = default(Lexer) + var tok: Token = default(Token) openLexer(lex, fileIdx, inputstream, cache, config) - while true: + var prevToken = tkEof + while tok.tokType != tkEof: rawGetTok(lex, tok) - result = tok.indent - if result > 0 or tok.tokType == tkEof: break + if tok.indent > 0 and prevToken in {tkColon, tkEquals, tkType, tkConst, tkLet, tkVar, tkUsing}: + result = tok.indent + if result > 0: break + prevToken = tok.tokType closeLexer(lex) + +proc getPrecedence*(ident: PIdent): int = + ## assumes ident is binary operator already + 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 new file mode 100644 index 000000000..9ff5c0a9d --- /dev/null +++ b/compiler/liftdestructors.nim @@ -0,0 +1,1324 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## This module implements lifting for type-bound operations +## (`=sink`, `=copy`, `=destroy`, `=deepCopy`, `=wasMoved`, `=dup`). + +import modulegraphs, lineinfos, idents, ast, renderer, semdata, + 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 + info: TLineInfo # for construction + kind: TTypeAttachedOp + fn: PSym + asgnForType: PType + recurse: bool + addMemReset: bool # add wasMoved() call after destructor call + canRaise: bool + filterDiscriminator: PSym # we generating destructor for case branch + c: PContext # c can be nil, then we are called from lambdalifting! + idgen: IdGenerator + +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; isDistinct = false): PSym + +proc createTypeBoundOps*(g: ModuleGraph; c: PContext; orig: PType; info: TLineInfo; + idgen: IdGenerator) + +proc at(a, i: PNode, elemType: PType): PNode = + result = newNodeI(nkBracketExpr, a.info, 2) + result[0] = a + result[1] = i + result.typ = elemType + +proc destructorOverridden(g: ModuleGraph; t: PType): bool = + let op = getAttachedOp(g, t, attachedDestructor) + op != nil and sfOverridden in op.flags + +proc fillBodyTup(c: var TLiftCtx; t: PType; body, x, y: PNode) = + 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, a) + fillBody(c, a, body, x.at(lit, a), b) + +proc dotField(x: PNode, f: PSym): PNode = + result = newNodeI(nkDotExpr, x.info, 2) + if x.typ.skipTypes(abstractInst).kind == tyVar: + result[0] = x.newDeref + else: + result[0] = x + result[1] = newSymNode(f, x.info) + result.typ = f.typ + +proc newAsgnStmt(le, ri: PNode): PNode = + result = newNodeI(nkAsgn, le.info, 2) + result[0] = le + result[1] = ri + +proc genBuiltin*(g: ModuleGraph; idgen: IdGenerator; magic: TMagic; name: string; i: PNode): PNode = + result = newNodeI(nkCall, i.info) + result.add createMagic(g, idgen, name, magic).newSymNode + result.add i + +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, 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: + checkSonsLen(x, 1, c.g.config) + result = x[0] + else: + result = newNodeIT(nkHiddenAddr, x.info, makeVarType(x.typ.owner, x.typ, c.idgen)) + result.add x + +proc genWhileLoop(c: var TLiftCtx; i, dest: PNode): PNode = + result = newNodeI(nkWhileStmt, c.info, 2) + let cmp = genBuiltin(c, mLtI, "<", i) + cmp.add genLen(c.g, dest) + cmp.typ = getSysType(c.g, c.info, tyBool) + result[0] = cmp + result[1] = newNodeI(nkStmtList, c.info) + +proc genIf(c: var TLiftCtx; cond, action: PNode): PNode = + result = newTree(nkIfStmt, newTree(nkElifBranch, cond, action)) + +proc genContainerOf(c: var TLiftCtx; objType: PType, field, x: PSym): PNode = + # generate: cast[ptr ObjType](cast[int](addr(x)) - offsetOf(objType.field)) + let intType = getSysType(c.g, unknownLineInfo, tyInt) + + let addrOf = newNodeIT(nkAddr, c.info, makePtrType(x.owner, x.typ, c.idgen)) + addrOf.add newDeref(newSymNode(x)) + let castExpr1 = newNodeIT(nkCast, c.info, intType) + castExpr1.add newNodeIT(nkType, c.info, intType) + castExpr1.add addrOf + + let dotExpr = newNodeIT(nkDotExpr, c.info, x.typ) + dotExpr.add newNodeIT(nkType, c.info, objType) + dotExpr.add newSymNode(field) + + let offsetOf = genBuiltin(c, mOffsetOf, "offsetof", dotExpr) + offsetOf.typ = intType + + let minusExpr = genBuiltin(c, mSubI, "-", castExpr1) + minusExpr.typ = intType + minusExpr.add offsetOf + + let objPtr = makePtrType(objType.owner, objType, c.idgen) + result = newNodeIT(nkCast, c.info, objPtr) + result.add newNodeIT(nkType, c.info, objPtr) + result.add minusExpr + +proc destructorCall(c: var TLiftCtx; op: PSym; x: PNode): PNode = + var destroy = newNodeIT(nkCall, x.info, op.typ.returnType) + destroy.add(newSymNode(op)) + 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)) + else: + result = destroy + +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 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: + # XXX This is only correct for 'attachedSink'! + var localEnforceDefaultOp = enforceDefaultOp + if c.kind == attachedSink: + # 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: + # copy the selector before case stmt, but destroy after case stmt + fillBodyObj(c, n[0], body, x, y, enforceDefaultOp = false) + + let oldfilterDiscriminator = c.filterDiscriminator + if c.filterDiscriminator == n[0].sym: + c.filterDiscriminator = nil # we have found the case part, proceed as normal + + # we need to generate a case statement: + var caseStmt = newNodeI(nkCaseStmt, c.info) + # XXX generate 'if' that checks same branches + # generate selector: + var access = dotField(x, n[0].sym) + caseStmt.add(access) + var emptyBranches = 0 + # copy the branches over, but replace the fields with the for loop body: + for i in 1..<n.len: + var branch = copyTree(n[i]) + branch[^1] = newNodeI(nkStmtList, c.info) + + fillBodyObj(c, n[i].lastSon, branch[^1], x, y, + enforceDefaultOp = localEnforceDefaultOp, enforceWasMoved = c.kind == attachedAsgn) + if branch[^1].len == 0: inc emptyBranches + caseStmt.add(branch) + if emptyBranches != n.len-1: + body.add(caseStmt) + + if c.kind == attachedDestructor: + # destructor for selector is done after case stmt + 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, enforceWasMoved) + else: + illFormedAstLocal(n, c.g.config) + +proc fillBodyObjTImpl(c: var TLiftCtx; t: PType, body, x, y: PNode) = + 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.baseClass != nil: + obj = skipTypes(obj.baseClass, abstractPtrs) + hasCase = hasCase or isCaseObj(obj.n) + + if hasCase and c.kind in {attachedAsgn, attachedDeepCopy}: + # assignment for case objects is complex, we do: + # =destroy(dest) + # wasMoved(dest) + # for every field: + # `=` dest.field, src.field + # ^ this is what we used to do, but for 'result = result.sons[0]' it + # destroys 'result' too early. + # So this is what we really need to do: + # let blob {.cursor.} = dest # remembers the old dest.kind + # wasMoved(dest) + # dest.kind = src.kind + # for every field (dependent on dest.kind): + # `=` dest.field, src.field + # =destroy(blob) + 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) + let blob = newSymNode(temp) + v.addVar(blob, x) + body.add v + #body.add newAsgnStmt(blob, x) + + var wasMovedCall = newNodeI(nkCall, c.info) + wasMovedCall.add(newSymNode(createMagic(c.g, c.idgen, "`=wasMoved`", mWasMoved))) + wasMovedCall.add x # mWasMoved does not take the address + body.add wasMovedCall + + fillBodyObjTImpl(c, t, body, x, y) + when false: + # does not work yet due to phase-ordering problems: + assert t.destructor != nil + body.add destructorCall(c.g, t.destructor, blob) + let prevKind = c.kind + c.kind = attachedDestructor + fillBodyObjTImpl(c, t, body, blob, y) + c.kind = prevKind + + else: + fillBodyObjTImpl(c, t, body, x, y) + +proc boolLit*(g: ModuleGraph; info: TLineInfo; value: bool): PNode = + result = newIntLit(g, info, ord value) + result.typ = getSysType(g, info, tyBool) + +proc getCycleParam(c: TLiftCtx): PNode = + 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" + else: + result = boolLit(c.g, c.info, true) + +proc newHookCall(c: var TLiftCtx; op: PSym; x, y: PNode): PNode = + #if sfError in op.flags: + # localError(c.config, x.info, "usage of '$1' is a user-defined error" % op.name.s) + result = newNodeI(nkCall, x.info) + result.add newSymNode(op) + if sfNeverRaises notin op.flags: + c.canRaise = true + if op.typ.firstParamType.kind == tyVar: + result.add genAddr(c, x) + else: + result.add x + if y != nil: + result.add y + if op.typ.signatureLen == 4: + assert y != nil + 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.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) + +proc useNoGc(c: TLiftCtx; t: PType): bool {.inline.} = + result = optSeqDestructors in c.g.config.globalOptions and + ({tfHasGCedMem, tfHasOwned} * t.flags != {} or usesBuiltinArc(t)) + +proc requiresDestructor(c: TLiftCtx; t: PType): bool {.inline.} = + result = optSeqDestructors in c.g.config.globalOptions and + containsGarbageCollectedRef(t) + +proc instantiateGeneric(c: var TLiftCtx; op: PSym; t, typeInst: PType): PSym = + if c.c != nil and typeInst != nil: + result = c.c.instTypeBoundOp(c.c, op, typeInst, c.info, attachedAsgn, 1) + else: + localError(c.g.config, c.info, + "cannot generate destructor for generic type: " & typeToString(t)) + result = nil + +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 destructorOverridden = destructorOverridden(c.g, t) + if op != nil and op != c.fn and + (sfOverridden in op.flags or destructorOverridden): + if sfError in op.flags: + incl c.fn.flags, sfError + #else: + # markUsed(c.g.config, c.info, op, c.g.usageSym) + onUse(c.info, op) + body.add newHookCall(c, op, x, y) + result = true + 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): + # generate recursive call: + if c.recurse: + op = c.fn + else: + c.recurse = true + return false + else: + op = field + if op == nil: + op = produceSym(c.g, c.c, t, c.kind, c.info, c.idgen) + if sfError in op.flags: + incl c.fn.flags, sfError + #else: + # markUsed(c.g.config, c.info, op, c.g.usageSym) + onUse(c.info, op) + # We also now do generic instantiations in the destructor lifting pass: + if op.ast.isGenericRoutine: + op = instantiateGeneric(c, op, t, t.typeInst) + field = op + #echo "trying to use ", op.ast + #echo "for ", op.name.s, " " + #debug(t) + #return false + 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 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, attachedDestructor, op) + + if op == nil and (useNoGc(c, t) or requiresDestructor(c, t)): + op = produceSym(c.g, c.c, t, attachedDestructor, c.info, c.idgen) + doAssert op != nil + doAssert op == t.destructor + + if op != nil: + #markUsed(c.g.config, c.info, op, c.g.usageSym) + onUse(c.info, op) + body.add destructorCall(c, op, x) + elif useNoGc(c, t): + internalError(c.g.config, c.info, + "type-bound operator could not be resolved") + +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 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, attachedDestructor, op) + + #markUsed(c.g.config, c.info, op, c.g.usageSym) + 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 attachedDeepCopy: + let op = getAttachedOp(c.g, t, attachedDeepCopy) + if op != nil: + #markUsed(c.g.config, c.info, op, c.g.usageSym) + 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), c.idgen, c.fn, c.info) + temp.typ = getSysType(c.g, body.info, tyInt) + incl(temp.flags, sfFromGeneric) + + var v = newNodeI(nkVarSection, c.info) + result = newSymNode(temp) + v.addVar(result, lowerings.newIntLit(c.g, body.info, first)) + body.add v + +proc declareTempOf(c: var TLiftCtx; body: PNode; value: PNode): PNode = + var temp = newSym(skTemp, getIdent(c.g.cache, lowerings.genPrefix), c.idgen, c.fn, c.info) + temp.typ = value.typ + incl(temp.flags, sfFromGeneric) + + var v = newNodeI(nkVarSection, c.info) + result = newSymNode(temp) + v.addVar(result, value) + body.add v + +proc addIncStmt(c: var TLiftCtx; body, i: PNode) = + let incCall = genBuiltin(c, mInc, "inc", i) + incCall.add lowerings.newIntLit(c.g, c.info, 1) + body.add incCall + +proc newSeqCall(c: var TLiftCtx; x, y: PNode): PNode = + # don't call genAddr(c, x) here: + result = genBuiltin(c, mNewSeq, "newSeq", x) + let lenCall = genBuiltin(c, mLengthSeq, "len", y) + lenCall.typ = getSysType(c.g, x.info, tyInt) + result.add lenCall + +proc setLenStrCall(c: var TLiftCtx; x, y: PNode): PNode = + let lenCall = genBuiltin(c, mLengthStr, "len", y) + lenCall.typ = getSysType(c.g, x.info, tyInt) + result = genBuiltin(c, mSetLengthStr, "setLen", x) # genAddr(g, x)) + result.add lenCall + +proc setLenSeqCall(c: var TLiftCtx; t: PType; x, y: PNode): PNode = + let lenCall = genBuiltin(c, mLengthSeq, "len", y) + lenCall.typ = getSysType(c.g, x.info, tyInt) + var op = getSysMagic(c.g, x.info, "setLen", mSetLengthSeq) + op = instantiateGeneric(c, op, t, t) + 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.elementType + let b = if c.kind == attachedTrace: y else: y.at(i, elemType) + fillBody(c, elemType, whileLoop[1], x.at(i, elemType), b) + if whileLoop[1].len > 0: + 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: + let moveCall = genBuiltin(c, mMove, "move", x) + moveCall.add y + doAssert t.destructor != nil + moveCall.add destructorCall(c, t.destructor, x) + body.add moveCall + of attachedDestructor: + # destroy all elements: + forallElements(c, t, body, x, y) + body.add genBuiltin(c, mDestroy, "destroy", x) + of attachedTrace: + 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 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 + + case c.kind + of attachedAsgn, attachedDeepCopy: + # XXX: replace these with assertions. + if t.assignment == nil: + return # protect from recursion + body.add newHookCall(c, t.assignment, x, y) + of attachedSink: + # we always inline the move for better performance: + let moveCall = genBuiltin(c, mMove, "move", x) + moveCall.add y + doAssert t.destructor != nil + moveCall.add destructorCall(c, t.destructor, x) + body.add moveCall + # alternatively we could do this: + when false: + doAssert t.asink != nil + body.add newHookCall(c, t.asink, x, y) + of attachedDestructor: + 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 newDupCall(c, op, x, y) + +proc fillStrOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = + case c.kind + 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) + moveCall.add y + doAssert t.destructor != nil + moveCall.add destructorCall(c, t.destructor, x) + body.add moveCall + 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*(g: ModuleGraph, t: PType): bool = + case t.kind + of tyRef: result = types.canFormAcycle(g, t.elementType) + of tyProc: result = t.callConv == ccClosure + else: result = false + +proc atomicRefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = + #[ bug #15753 is really subtle. Usually the classical write barrier for reference + counting looks like this:: + + incRef source # increment first; this takes care of self-assignments1 + decRef dest + dest[] = source + + However, 'decRef dest' might trigger a cycle collection and then the collector + traverses the graph. It is crucial that when it follows the pointers the assignment + 'dest[] = source' already happened so that we don't do trial deletion on a wrong + graph -- this causes premature freeing of objects! The correct barrier looks like + this:: + + let tmp = dest + incRef source + dest[] = source + decRef tmp + + ]# + var actions = newNodeI(nkStmtList, c.info) + let elemType = t.elementType + + createTypeBoundOps(c.g, c.c, elemType, c.info, c.idgen) + let isCyclic = c.g.config.selectedGC == gcOrc and types.canFormAcycle(c.g, elemType) + + 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, attachedDup}: + declareTempOf(c, body, x) + else: + x + + if isFinal(elemType): + addDestructorCall(c, elemType, actions, genDeref(tmp, nkDerefExpr)) + var alignOf = genBuiltin(c, mAlignOf, "alignof", newNodeIT(nkType, c.info, elemType)) + alignOf.typ = getSysType(c.g, c.info, tyInt) + actions.add callCodegenProc(c.g, "nimRawDispose", c.info, tmp, alignOf) + else: + addDestructorCall(c, elemType, newNodeI(nkStmtList, c.info), genDeref(tmp, nkDerefExpr)) + actions.add callCodegenProc(c.g, "nimDestroyAndDispose", c.info, tmp) + + var cond: PNode + if isCyclic: + if isFinal(elemType): + let typInfo = genBuiltin(c, mGetTypeInfoV2, "getTypeInfoV2", newNodeIT(nkType, x.info, elemType)) + typInfo.typ = getSysType(c.g, c.info, tyPointer) + 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) + + case c.kind + of attachedSink: + if isCyclic: + body.add newAsgnStmt(x, y) + body.add genIf(c, cond, actions) + else: + body.add genIf(c, cond, actions) + body.add newAsgnStmt(x, y) + of attachedAsgn: + if isCyclic: + body.add genIf(c, y, callCodegenProc(c.g, + "nimIncRefCyclic", c.info, y, getCycleParam(c))) + body.add newAsgnStmt(x, y) + body.add genIf(c, cond, actions) + else: + body.add genIf(c, y, callCodegenProc(c.g, "nimIncRef", c.info, y)) + body.add genIf(c, cond, actions) + body.add newAsgnStmt(x, y) + of attachedDestructor: + body.add genIf(c, cond, actions) + of attachedDeepCopy: assert(false, "cannot happen") + of attachedTrace: + 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: + 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 + ## and we need to do the refcounting only on the ref field which we call 'xenv': + let xenv = genBuiltin(c, mAccessEnv, "accessEnv", x) + xenv.typ = getSysType(c.g, c.info, tyPointer) + + let isCyclic = c.g.config.selectedGC == gcOrc + let tmp = + if isCyclic and c.kind in {attachedAsgn, attachedSink, attachedDup}: + declareTempOf(c, body, xenv) + else: + xenv + + var actions = newNodeI(nkStmtList, c.info) + actions.add callCodegenProc(c.g, "nimDestroyAndDispose", c.info, tmp) + + let decRefProc = + if isCyclic: "nimDecRefIsLastCyclicDyn" + else: "nimDecRefIsLast" + let cond = callCodegenProc(c.g, decRefProc, c.info, tmp) + cond.typ = getSysType(c.g, x.info, tyBool) + + case c.kind + of attachedSink: + if isCyclic: + body.add newAsgnStmt(x, y) + body.add genIf(c, cond, actions) + else: + body.add genIf(c, cond, actions) + body.add newAsgnStmt(x, y) + of attachedAsgn: + let yenv = genBuiltin(c, mAccessEnv, "accessEnv", y) + yenv.typ = getSysType(c.g, c.info, tyPointer) + if isCyclic: + body.add genIf(c, yenv, callCodegenProc(c.g, "nimIncRefCyclic", c.info, yenv, getCycleParam(c))) + body.add newAsgnStmt(x, y) + body.add genIf(c, cond, actions) + else: + body.add genIf(c, yenv, callCodegenProc(c.g, "nimIncRef", c.info, yenv)) + + 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 attachedWasMoved: body.add genBuiltin(c, mWasMoved, "`=wasMoved`", x) + +proc weakrefOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = + case c.kind + of attachedSink: + # we 'nil' y out afterwards so we *need* to take over its reference + # count value: + body.add genIf(c, x, callCodegenProc(c.g, "nimDecWeakRef", c.info, x)) + body.add newAsgnStmt(x, y) + of attachedAsgn: + 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: + var actions = newNodeI(nkStmtList, c.info) + actions.add callCodegenProc(c.g, "nimDecWeakRef", c.info, x) + let des = genIf(c, x, actions) + if body.len == 0: + body.add des + else: + body.sons.insert(des, 0) + of attachedDeepCopy: assert(false, "cannot happen") + 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.skipModifier + #fillBody(c, elemType, actions, genDeref(x), genDeref(y)) + #var disposeCall = genBuiltin(c, mDispose, "dispose", x) + + if isFinal(elemType): + addDestructorCall(c, elemType, actions, genDeref(x, nkDerefExpr)) + var alignOf = genBuiltin(c, mAlignOf, "alignof", newNodeIT(nkType, c.info, elemType)) + alignOf.typ = getSysType(c.g, c.info, tyInt) + actions.add callCodegenProc(c.g, "nimRawDispose", c.info, x, alignOf) + else: + addDestructorCall(c, elemType, newNodeI(nkStmtList, c.info), genDeref(x, nkDerefExpr)) + actions.add callCodegenProc(c.g, "nimDestroyAndDispose", c.info, x) + + case c.kind + 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: 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: + # a big problem is that we don't know the environment's type here, so we + # have to go through some indirection; we delegate this to the codegen: + let call = newNodeI(nkCall, c.info, 2) + call.typ = t + call[0] = newSymNode(createMagic(c.g, c.idgen, "deepCopy", mDeepCopy)) + call[1] = y + body.add newAsgnStmt(x, call) + elif (optOwnedRefs in c.g.config.globalOptions and + optRefCheck in c.g.config.options) or c.g.config.selectedGC in {gcArc, gcAtomicArc, gcOrc}: + let xx = genBuiltin(c, mAccessEnv, "accessEnv", x) + xx.typ = getSysType(c.g, c.info, tyPointer) + case c.kind + of attachedSink: + # we 'nil' y out afterwards so we *need* to take over its reference + # count value: + body.add genIf(c, xx, callCodegenProc(c.g, "nimDecWeakRef", c.info, xx)) + body.add newAsgnStmt(x, y) + of attachedAsgn: + let yy = genBuiltin(c, mAccessEnv, "accessEnv", y) + yy.typ = getSysType(c.g, c.info, tyPointer) + body.add genIf(c, yy, callCodegenProc(c.g, "nimIncRef", c.info, yy)) + body.add genIf(c, xx, callCodegenProc(c.g, "nimDecWeakRef", c.info, xx)) + body.add newAsgnStmt(x, y) + of attachedDup: + let yy = genBuiltin(c, mAccessEnv, "accessEnv", y) + yy.typ = getSysType(c.g, c.info, tyPointer) + 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: + body.add des + else: + body.sons.insert(des, 0) + of attachedDeepCopy: assert(false, "cannot happen") + 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) + xx.typ = getSysType(c.g, c.info, tyPointer) + var actions = newNodeI(nkStmtList, c.info) + #discard addDestructorCall(c, elemType, newNodeI(nkStmtList, c.info), genDeref(xx)) + actions.add callCodegenProc(c.g, "nimDestroyAndDispose", c.info, xx) + case c.kind + 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: 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, + tyPtr, tyUncheckedArray, tyVar, tyLent: + defaultOp(c, t, body, x, y) + of tyRef: + 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): + weakrefOp(c, t, body, x, y) + else: + defaultOp(c, t, body, x, y) + of tyProc: + if t.callConv == ccClosure: + if c.g.config.selectedGC in {gcArc, gcOrc, gcAtomicArc}: + atomicClosureOp(c, t, body, x, y) + else: + closureOp(c, t, body, x, y) + else: + defaultOp(c, t, body, x, y) + of tyOwned: + let base = t.skipTypes(abstractInstOwned) + if optOwnedRefs in c.g.config.globalOptions: + case base.kind + of tyRef: + ownedRefOp(c, base, body, x, y) + return + of tyProc: + if base.callConv == ccClosure: + ownedClosureOp(c, base, body, x, y) + return + else: discard + defaultOp(c, base, body, x, y) + of tyArray: + if tfHasAsgn in t.flags or useNoGc(c, t): + forallElements(c, t, body, x, y) + else: + defaultOp(c, t, body, x, y) + of tySequence: + if useNoGc(c, t): + useSeqOrStrOp(c, t, body, x, y) + elif optSeqDestructors in c.g.config.globalOptions: + # note that tfHasAsgn is propagated so we need the check on + # 'selectedGC' here to determine if we have the new runtime. + discard considerUserDefinedOp(c, t, body, x, y) + elif tfHasAsgn in t.flags: + if c.kind in {attachedAsgn, attachedSink, attachedDeepCopy}: + body.add newSeqCall(c, x, y) + forallElements(c, t, body, x, y) + else: + defaultOp(c, t, body, x, y) + of tyString: + if useNoGc(c, t): + useSeqOrStrOp(c, t, body, x, y) + elif tfHasAsgn in t.flags: + discard considerUserDefinedOp(c, t, body, x, y) + else: + defaultOp(c, t, body, x, y) + of tyObject: + if not considerUserDefinedOp(c, t, body, 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: + 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.elementType, body, x, y) + of tyTuple: + fillBodyTup(c, t, body, x, y) + of tyVarargs, tyOpenArray: + if c.kind == attachedDestructor and (tfHasAsgn in t.flags or useNoGc(c, t)): + forallElements(c, t, body, x, y) + else: + discard "cannot copy openArray" + + of tyFromExpr, tyError, tyBuiltInTypeClass, tyUserTypeClass, + tyUserTypeClassInst, tyCompositeTypeClass, tyAnd, tyOr, tyNot, tyAnything, + tyGenericParam, tyGenericBody, tyNil, tyUntyped, tyTyped, + tyTypeDesc, tyGenericInvocation, tyForward, tyStatic: + #internalError(c.g.config, c.info, "assignment requested for type: " & typeToString(t)) + discard + of tyOrdinal, tyRange, tyInferred, + tyGenericInst, tyAlias, tySink: + 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.elementType + if getAttachedOp(g, baseType, kind) == nil: + # 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 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, 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"), + 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, idgen, owner) + result.typ.addParam dest + if kind notin {attachedDestructor, attachedWasMoved}: + result.typ.addParam src + + if kind == attachedAsgn and 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+1) + 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) + 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; 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, isDistinct = isDistinct) + + var a = TLiftCtx(info: info, g: g, kind: kind, c: c, asgnForType: typ, idgen: idgen, + fn: result) + + let dest = if kind == attachedDup: result.ast[resultPos].sym else: result.typ.n[1].sym + let d = if result.typ.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 destructorOverridden(g, typ): + ## compiler can use a combination of `=destroy` and memCopy for sink op + dest.flags.incl sfCursor + let op = getAttachedOp(g, typ, attachedDestructor) + result.ast[bodyPos].add newOpCall(a, op, if op.typ.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, gcAtomicArc}: + tk = skipTypes(typ, {tyOrdinal, tyRange, tyInferred, tyGenericInst, tyStatic, tyAlias, tySink}).kind + else: + tk = tyNone # no special casing for strings and seqs + case tk + of tySequence: + fillSeqOp(a, typ, result.ast[bodyPos], d, src) + of tyString: + fillStrOp(a, typ, result.ast[bodyPos], d, src) + else: + fillBody(a, typ, result.ast[bodyPos], d, src) + if tk == tyObject and a.kind in {attachedAsgn, attachedSink, attachedDeepCopy, attachedDup} and not 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) + # 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 + a.filterDiscriminator = field + a.addMemReset = true + let discrimantDest = result.typ.n[1].sym + + 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) + let v = newNodeI(nkVarSection, info) + v.addVar(dstSym, genContainerOf(a, typ, field, discrimantDest)) + result.ast[bodyPos].add v + let placeHolder = newNodeIT(nkSym, info, getSysType(g, info, tyPointer)) + fillBody(a, typ, result.ast[bodyPos], d, placeHolder) + if not a.canRaise: incl result.flags, sfNeverRaises + + +template liftTypeBoundOps*(c: PContext; typ: PType; info: TLineInfo) = + discard "now a nop" + +proc patchBody(g: ModuleGraph; c: PContext; n: PNode; info: TLineInfo; idgen: IdGenerator) = + if n.kind in nkCallKinds: + if n[0].kind == nkSym and n[0].sym.magic == mDestroy: + let t = n[1].typ.skipTypes(abstractVar) + if getAttachedOp(g, t, attachedDestructor) == nil: + discard produceSym(g, c, t, attachedDestructor, info, idgen) + + let op = getAttachedOp(g, t, attachedDestructor) + if op != nil: + if op.ast.isGenericRoutine: + internalError(g.config, info, "resolved destructor is generic") + 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) + +proc inst(g: ModuleGraph; c: PContext; t: PType; kind: TTypeAttachedOp; idgen: IdGenerator; + info: TLineInfo) = + let op = getAttachedOp(g, t, kind) + if op != nil and op.ast != nil and op.ast.isGenericRoutine: + if t.typeInst != nil: + 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) + setAttachedOp(g, idgen.module, t, kind, opInst) + else: + localError(g.config, info, "unresolved generic parameter") + +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; + idgen: IdGenerator) = + ## In the semantic pass this is called in strategic places + ## to ensure we lift assignment, destructors and moves properly. + ## The later 'injectdestructors' pass depends on it. + if orig == nil or {tfCheckedForDestructor, tfHasMeta} * orig.flags != {}: return + incl orig.flags, tfCheckedForDestructor + + let skipped = orig.skipTypes({tyGenericInst, tyAlias, tySink}) + if isEmptyContainer(skipped) or skipped.kind == tyStatic: return + + let h = sighashes.hashType(skipped, g.config, {CoType, CoConsiderOwned, CoDistinct}) + var canon = g.canonTypes.getOrDefault(h) + if canon == nil: + g.canonTypes[h] = skipped + canon = skipped + + # multiple cases are to distinguish here: + # 1. we don't know yet if 'typ' has a nontrival destructor. + # 2. we have a nop destructor. --> mDestroy + # 3. we have a lifted destructor. + # 4. We have a custom destructor. + # 5. We have a (custom) generic destructor. + + # we do not generate '=trace' procs if we + # have the cycle detection disabled, saves code size. + 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[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 attachedWasMoved..lastAttached: + if not generics[k]: + discard produceSym(g, c, canon, k, info, idgen) + else: + inst(g, c, canon, k, idgen, info) + if canon != orig: + setAttachedOp(g, idgen.module, orig, k, getAttachedOp(g, canon, k)) + + if not isTrival(getAttachedOp(g, orig, attachedDestructor)): + #or not isTrival(orig.assignment) or + # not isTrival(orig.sink): + orig.flags.incl tfHasAsgn + # ^ XXX Breaks IC! diff --git a/compiler/liftlocals.nim b/compiler/liftlocals.nim index ae789cd88..aaa0707e0 100644 --- a/compiler/liftlocals.nim +++ b/compiler/liftlocals.nim @@ -10,9 +10,11 @@ ## This module implements the '.liftLocals' pragma. import - intsets, strutils, options, ast, astalgo, msgs, + options, ast, msgs, idents, renderer, types, lowerings, lineinfos +import std/strutils + from pragmas import getPragmaVal from wordrecg import wLiftLocals @@ -21,19 +23,20 @@ type partialParam: PSym objType: PType cache: IdentCache + idgen: IdGenerator proc interestingVar(s: PSym): bool {.inline.} = result = s.kind in {skVar, skLet, skTemp, skForVar, skResult} and sfGlobal notin s.flags proc lookupOrAdd(c: var Ctx; s: PSym; info: TLineInfo): PNode = - let field = addUniqueField(c.objType, s, c.cache) + let field = addUniqueField(c.objType, s, c.cache, c.idgen) var deref = newNodeI(nkHiddenDeref, info) deref.typ = c.objType - add(deref, newSymNode(c.partialParam, info)) + deref.add(newSymNode(c.partialParam, info)) result = newNodeI(nkDotExpr, info) - add(result, deref) - add(result, newSymNode(field)) + result.add(deref) + result.add(newSymNode(field)) result.typ = field.typ proc liftLocals(n: PNode; i: int; c: var Ctx) = @@ -42,18 +45,20 @@ proc liftLocals(n: PNode; i: int; c: var Ctx) = of nkSym: if interestingVar(it.sym): n[i] = lookupOrAdd(c, it.sym, it.info) - of procDefs, nkTypeSection: discard + of procDefs, nkTypeSection, nkMixinStmt, nkBindStmt: discard else: - for i in 0 ..< it.safeLen: + for i in 0..<it.safeLen: liftLocals(it, i, c) proc lookupParam(params, dest: PNode): PSym = + result = nil if dest.kind != nkIdent: return nil - for i in 1 ..< params.len: + for i in 1..<params.len: if params[i].kind == nkSym and params[i].sym.name.id == dest.ident.id: return params[i].sym -proc liftLocalsIfRequested*(prc: PSym; n: PNode; cache: IdentCache; conf: ConfigRef): PNode = +proc liftLocalsIfRequested*(prc: PSym; n: PNode; cache: IdentCache; conf: ConfigRef; + idgen: IdGenerator): PNode = let liftDest = getPragmaVal(prc.ast, wLiftLocals) if liftDest == nil: return n let partialParam = lookupParam(prc.typ.n, liftDest) @@ -65,7 +70,7 @@ proc liftLocalsIfRequested*(prc: PSym; n: PNode; cache: IdentCache; conf: Config if objType.kind != tyObject or tfPartial notin objType.flags: localError(conf, liftDest.info, "parameter '$1' is not a pointer to a partial object" % $liftDest) return n - var c = Ctx(partialParam: partialParam, objType: objType, cache: cache) + var c = Ctx(partialParam: partialParam, objType: objType, cache: cache, idgen: idgen) let w = newTree(nkStmtList, n) liftLocals(w, 0, c) result = w[0] diff --git a/compiler/lineinfos.nim b/compiler/lineinfos.nim index cad1fe6aa..94a483299 100644 --- a/compiler/lineinfos.nim +++ b/compiler/lineinfos.nim @@ -7,187 +7,273 @@ # 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 +import ropes, pathutils +import std/[hashes, tables] const - explanationsBaseUrl* = "https://nim-lang.org/docs/manual" + explanationsBaseUrl* = "https://nim-lang.github.io/Nim" + # was: "https://nim-lang.org/docs" but we're now usually showing devel docs + # instead of latest release docs. + +proc createDocLink*(urlSuffix: string): string = + # os.`/` is not appropriate for urls. + result = explanationsBaseUrl + if urlSuffix.len > 0 and urlSuffix[0] == '/': + result.add urlSuffix + else: + result.add "/" & urlSuffix type TMsgKind* = enum - errUnknown, errInternal, errIllFormedAstX, errCannotOpenFile, + # fatal errors + errUnknown, errFatal, errInternal, + # non-fatal errors + errIllFormedAstX, errCannotOpenFile, errXExpected, - errGridTableNotImplemented, - errGeneralParseError, - errNewSectionExpected, - errInvalidDirectiveX, + errRstMissingClosing, + errRstGridTableNotImplemented, + errRstMarkdownIllformedTable, + errRstIllformedTable, + errRstNewSectionExpected, + errRstGeneralParseError, + errRstInvalidDirectiveX, + errRstInvalidField, + errRstFootnoteMismatch, + errRstSandboxedDirective, + errProveInit, # deadcode errGenerated, + errFailedMove, errUser, - warnCannotOpenFile, - warnOctalEscape, warnXIsNeverRead, warnXmightNotBeenInit, - warnDeprecated, warnConfigDeprecated, - warnSmallLshouldNotBeUsed, warnUnknownMagic, warnRedefinitionOfLabel, - warnUnknownSubstitutionX, warnLanguageXNotSupported, - warnFieldXNotSupported, warnCommentXIgnored, - warnTypelessParam, - warnUseBase, warnWriteToForeignHeap, warnUnsafeCode, - warnEachIdentIsTuple, warnShadowIdent, - warnProveInit, warnProveField, warnProveIndex, warnGcUnsafe, warnGcUnsafe2, - warnUninit, warnGcMem, warnDestructor, warnLockLevel, warnResultShadowed, - warnInconsistentSpacing, warnUser, - hintSuccess, hintSuccessX, - hintLineTooLong, hintXDeclaredButNotUsed, hintConvToBaseNotNeeded, - hintConvFromXtoItselfNotNeeded, hintExprAlwaysX, hintQuitCalled, - hintProcessing, hintCodeBegin, hintCodeEnd, hintConf, hintPath, - hintConditionAlwaysTrue, hintName, hintPattern, - hintExecuting, hintLinking, hintDependency, - hintSource, hintPerformance, hintStackTrace, hintGCStats, - hintGlobalVar, - hintUser, hintUserRaw + # warnings + warnCannotOpenFile = "CannotOpenFile", warnOctalEscape = "OctalEscape", + warnXIsNeverRead = "XIsNeverRead", warnXmightNotBeenInit = "XmightNotBeenInit", + warnDeprecated = "Deprecated", warnConfigDeprecated = "ConfigDeprecated", + warnDotLikeOps = "DotLikeOps", + warnSmallLshouldNotBeUsed = "SmallLshouldNotBeUsed", warnUnknownMagic = "UnknownMagic", + 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", + warnInheritFromException = "InheritFromException", warnEachIdentIsTuple = "EachIdentIsTuple", + warnUnsafeSetLen = "UnsafeSetLen", warnUnsafeDefault = "UnsafeDefault", + warnProveInit = "ProveInit", warnProveField = "ProveField", warnProveIndex = "ProveIndex", + warnUnreachableElse = "UnreachableElse", warnUnreachableCode = "UnreachableCode", + warnStaticIndexCheck = "IndexCheck", warnGcUnsafe = "GcUnsafe", warnGcUnsafe2 = "GcUnsafe2", + warnUninit = "Uninit", warnGcMem = "GcMem", warnDestructor = "Destructor", + warnLockLevel = "LockLevel", # 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", + 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", hintProcessingStmt = "ProcessingStmt", hintCodeBegin = "CodeBegin", + hintCodeEnd = "CodeEnd", hintConf = "Conf", hintPath = "Path", + hintConditionAlwaysTrue = "CondTrue", hintConditionAlwaysFalse = "CondFalse", hintName = "Name", + hintPattern = "Pattern", hintExecuting = "Exec", hintLinking = "Link", hintDependency = "Dependency", + hintSource = "Source", hintPerformance = "Performance", hintStackTrace = "StackTrace", + hintGCStats = "GCStats", hintGlobalVar = "GlobalVar", hintExpandMacro = "ExpandMacro", + hintUser = "User", hintUserRaw = "UserRaw", hintExtendedContext = "ExtendedContext", + hintMsgOrigin = "MsgOrigin", # since 1.3.5 + hintDeclaredLoc = "DeclaredLoc", # since 1.5.1 + 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", - errGeneralParseError: "general parse error", - errNewSectionExpected: "new section expected", - errInvalidDirectiveX: "invalid directive: '$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", warnXIsNeverRead: "'$1' is never read", warnXmightNotBeenInit: "'$1' might not have been initialized", - warnDeprecated: "$1 is deprecated", + 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'", + warnUnusedImportX: "imported and not used: '$1'", + warnInheritFromException: "inherit from a more precise exception type like ValueError, " & + "IOError or OSError. If these don't suit, inherit from CatchableError or Defect.", warnEachIdentIsTuple: "each identifier is a tuple", - warnShadowIdent: "shadowed identifier: '$1'", + warnUnsafeSetLen: "setLen can potentially expand the sequence, " & + "but the element type '$1' doesn't have a valid default value", + warnUnsafeDefault: "The '$1' type doesn't have a valid default value", warnProveInit: "Cannot prove that '$1' is initialized. This will become a compile time error in the future.", warnProveField: "cannot prove that field '$1' is accessible", warnProveIndex: "cannot prove index '$1' is valid", + warnUnreachableElse: "unreachable else, all cases are already covered", + warnUnreachableCode: "unreachable code after 'return' statement or '{.noReturn.}' proc", + warnStaticIndexCheck: "$1", warnGcUnsafe: "not GC-safe: '$1'", warnGcUnsafe2: "$1", - warnUninit: "'$1' might not have been initialized", + 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", - hintSuccess: "operation successful", - hintSuccessX: "operation successful ($# lines compiled; $# sec total; $#; $#)", - hintLineTooLong: "line too long", + warnGlobalVarConstructorTemporary: "global variable '$1' initialization requires a temporary variable", + hintSuccess: "operation successful: $#", + # keep in sync with `testament.isSuccess` + hintSuccessX: "$build\n$loc lines; ${sec}s; $mem; proj: $project; out: $output", + hintCC: "CC: $1", hintXDeclaredButNotUsed: "'$1' is declared but not used", + hintDuplicateModuleImport: "$1", + hintXCannotRaiseY: "$1", hintConvToBaseNotNeeded: "conversion to base object is not needed", hintConvFromXtoItselfNotNeeded: "conversion from $1 to itself is pointless", hintExprAlwaysX: "expression evaluates always to '$1'", hintQuitCalled: "quit() called", hintProcessing: "$1", + hintProcessingStmt: "$1", hintCodeBegin: "generated code listing:", hintCodeEnd: "end of listing", hintConf: "used config file '$1'", hintPath: "added path: '$1'", hintConditionAlwaysTrue: "condition is always true: '$1'", - hintName: "name should be: '$1'", + hintConditionAlwaysFalse: "condition is always false: '$1'", + hintName: "$1", hintPattern: "$1", hintExecuting: "$1", - hintLinking: "", + hintLinking: "$1", hintDependency: "$1", hintSource: "$1", hintPerformance: "$1", hintStackTrace: "$1", hintGCStats: "$1", hintGlobalVar: "global variable declared here", + hintExpandMacro: "expanded macro: $1", hintUser: "$1", - hintUserRaw: "$1"] + hintUserRaw: "$1", + hintExtendedContext: "$1", + hintMsgOrigin: "$1", + hintDeclaredLoc: "$1", + hintUnknownHint: "unknown hint: $1" + ] const - WarningsToStr* = ["CannotOpenFile", "OctalEscape", - "XIsNeverRead", "XmightNotBeenInit", - "Deprecated", "ConfigDeprecated", - "SmallLshouldNotBeUsed", "UnknownMagic", - "RedefinitionOfLabel", "UnknownSubstitutionX", - "LanguageXNotSupported", "FieldXNotSupported", - "CommentXIgnored", - "TypelessParam", "UseBase", "WriteToForeignHeap", - "UnsafeCode", "EachIdentIsTuple", "ShadowIdent", - "ProveInit", "ProveField", "ProveIndex", "GcUnsafe", "GcUnsafe2", "Uninit", - "GcMem", "Destructor", "LockLevel", "ResultShadowed", - "Spacing", "User"] - - HintsToStr* = ["Success", "SuccessX", "LineTooLong", - "XDeclaredButNotUsed", "ConvToBaseNotNeeded", "ConvFromXtoItselfNotNeeded", - "ExprAlwaysX", "QuitCalled", "Processing", "CodeBegin", "CodeEnd", "Conf", - "Path", "CondTrue", "Name", "Pattern", "Exec", "Link", "Dependency", - "Source", "Performance", "StackTrace", "GCStats", "GlobalVar", - "User", "UserRaw"] - -const - fatalMin* = errUnknown - fatalMax* = errInternal + fatalMsgs* = {errUnknown..errInternal} errMin* = errUnknown errMax* = errUser warnMin* = warnCannotOpenFile warnMax* = pred(hintSuccess) hintMin* = hintSuccess hintMax* = high(TMsgKind) - -static: - doAssert HintsToStr.len == ord(hintMax) - ord(hintMin) + 1 - doAssert WarningsToStr.len == ord(warnMax) - ord(warnMin) + 1 + rstWarnings* = {warnRstRedefinitionOfLabel..warnRstStyle} type TNoteKind* = range[warnMin..hintMax] # "notes" are warnings or hints TNoteKinds* = set[TNoteKind] -const - NotesVerbosity*: array[0..3, TNoteKinds] = [ - {low(TNoteKind)..high(TNoteKind)} - {warnShadowIdent, warnUninit, - warnProveField, warnProveIndex, - warnGcUnsafe, - hintSuccessX, hintPath, hintConf, - hintProcessing, hintPattern, - hintDependency, - hintExecuting, hintLinking, - hintCodeBegin, hintCodeEnd, - hintSource, hintStackTrace, - hintGlobalVar, hintGCStats}, - {low(TNoteKind)..high(TNoteKind)} - {warnShadowIdent, warnUninit, - warnProveField, warnProveIndex, - warnGcUnsafe, - hintPath, - hintDependency, - hintCodeBegin, hintCodeEnd, - hintSource, hintStackTrace, - hintGlobalVar, hintGCStats}, - {low(TNoteKind)..high(TNoteKind)} - {hintStackTrace, warnUninit}, - {low(TNoteKind)..high(TNoteKind)}] +proc computeNotesVerbosity(): array[0..3, TNoteKinds] = + 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, hintPerformance} + result[0] = result[1] - {hintSuccessX, hintSuccess, hintConf, + hintProcessing, hintPattern, hintExecuting, hintLinking, hintCC} const + NotesVerbosity* = computeNotesVerbosity() errXMustBeCompileTime* = "'$1' can only be used in compile-time context" errArgsNeedRunOption* = "arguments can only be given if the '--run' option is selected" + errFloatToString* = "cannot convert '$1' to '$2'" type TFileInfo* = object - fullPath*: string # This is a canonical full filesystem path - projPath*: string # This is relative to the project's root + fullPath*: AbsoluteFile # This is a canonical full filesystem path + projPath*: RelativeFile # This is relative to the project's root shortName*: string # short name of the module quotedName*: Rope # cached quoted short name for codegen # purposes @@ -198,11 +284,11 @@ type # used for better error messages and # embedding the original source in the # generated code - dirtyfile*: string # the file that is actually read into memory + dirtyFile*: AbsoluteFile # the file that is actually read into memory # and parsed; usually "" but is used # for 'nimsuggest' hash*: string # the checksum of the file - dirty*: bool # for 'nimfix' / 'nimpretty' like tooling + dirty*: bool # for 'nimpretty' like tooling when defined(nimpretty): fullContent*: string FileIndex* = distinct int32 @@ -226,24 +312,28 @@ type TErrorOutputs* = set[TErrorOutput] ERecoverableError* = object of ValueError - ESuggestDone* = object of Exception + ESuggestDone* = object of ValueError proc `==`*(a, b: FileIndex): bool {.borrow.} -const - InvalidFileIDX* = FileIndex(-1) +proc hash*(i: TLineInfo): Hash = + hash (i.line.int, i.col.int, i.fileIndex.int) -proc unknownLineInfo*(): TLineInfo = - result.line = uint16(0) - result.col = int16(-1) - result.fileIndex = InvalidFileIDX +proc raiseRecoverableError*(msg: string) {.noinline, noreturn.} = + raise newException(ERecoverableError, msg) + +const + InvalidFileIdx* = FileIndex(-1) + unknownLineInfo* = TLineInfo(line: 0, col: -1, fileIndex: InvalidFileIdx) type Severity* {.pure.} = enum ## VS Code only supports these three Hint, Warning, Error -const trackPosInvalidFileIdx* = FileIndex(-2) # special marker so that no suggestions - # are produced within comments and string literals +const + trackPosInvalidFileIdx* = FileIndex(-2) # special marker so that no suggestions + # are produced within comments and string literals + commandLineIdx* = FileIndex(-3) type MsgConfig* = object ## does not need to be stored in the incremental cache @@ -252,7 +342,7 @@ type ## some close token. errorOutputs*: TErrorOutputs - msgContext*: seq[TLineInfo] + msgContext*: seq[tuple[info: TLineInfo, detail: string]] lastError*: TLineInfo filenameToIndexTbl*: Table[string, FileIndex] fileInfos*: seq[TFileInfo] @@ -260,8 +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 7c9cdec83..a80c377e9 100644 --- a/compiler/linter.nim +++ b/compiler/linter.nim @@ -7,53 +7,24 @@ # distribution, for details about the copyright. # -## This module implements the code "prettifier". This is part of the toolchain -## to convert Nim code into a consistent style. +## This module implements the style checker. -import - strutils, os, intsets, strtabs +import std/strutils +from std/sugar import dup -import options, ast, astalgo, msgs, semdata, ropes, idents, - lineinfos +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 -when false: - import prettybase - -type - StyleCheck* {.pure.} = enum None, Warn, Auto - -var - gOverWrite* = true - gStyleCheck*: StyleCheck - gCheckExtern*, gOnlyMainfile*: bool - -proc overwriteFiles*(conf: ConfigRef) = - let doStrip = options.getConfigVar(conf, "pretty.strip").normalize == "on" - for i in 0 .. high(conf.m.fileInfos): - if conf.m.fileInfos[i].dirty and - (not gOnlyMainfile or FileIndex(i) == conf.projectMainIdx): - let newFile = if gOverWrite: conf.m.fileInfos[i].fullpath - else: conf.m.fileInfos[i].fullpath.changeFileExt(".pretty.nim") - try: - var f = open(newFile, fmWrite) - for line in conf.m.fileInfos[i].lines: - if doStrip: - f.write line.strip(leading = false, trailing = true) - else: - f.write line - f.write(conf.m.fileInfos[i], "\L") - f.close - except IOError: - rawMessage(conf, errGenerated, "cannot open file: " & newFile) - proc `=~`(s: string, a: openArray[string]): bool = + result = false for x in a: if s.startsWith(x): return true @@ -70,10 +41,10 @@ proc beautifyName(s: string, k: TSymKind): string = # Types should start with a capital unless builtins like 'int' etc.: if s =~ ["int", "uint", "cint", "cuint", "clong", "cstring", "string", "char", "byte", "bool", "openArray", "seq", "array", "void", - "pointer", "float", "csize", "cdouble", "cchar", "cschar", - "cshort", "cu", "nil", "expr", "stmt", "typedesc", "auto", "any", - "range", "openarray", "varargs", "set", "cfloat" - ]: + "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", "iterable"]: result.add s[i] else: result.add toUpperAscii(s[i]) @@ -88,7 +59,9 @@ proc beautifyName(s: string, k: TSymKind): string = inc i while i < s.len: if s[i] == '_': - if i > 0 and s[i-1] in {'A'..'Z'}: + if i+1 >= s.len: + discard "trailing underscores should be stripped off" + elif i > 0 and s[i-1] in {'A'..'Z'}: # don't skip '_' as it's essential for e.g. 'GC_disable' result.add('_') inc i @@ -102,75 +75,84 @@ proc beautifyName(s: string, k: TSymKind): string = result.add s[i] inc i -proc differ*(line: string, a, b: int, x: string): bool = - let y = line[a..b] - result = cmpIgnoreStyle(y, x) == 0 and y != x +proc differ*(line: string, a, b: int, x: string): string = + proc substrEq(s: string, pos, last: int, substr: string): bool = + result = true + for i in 0..<substr.len: + if pos+i > last or s[pos+i] != substr[i]: return false + + result = "" + if not substrEq(line, a, b, x): + let y = line[a..b] + if cmpIgnoreStyle(y, x) == 0: + result = y -proc replaceInFile(conf: ConfigRef; info: TLineInfo; newName: string) = - let line = conf.m.fileInfos[info.fileIndex.int].lines[info.line.int-1] +proc nep1CheckDefImpl(conf: ConfigRef; info: TLineInfo; s: PSym; k: TSymKind) = + let beau = beautifyName(s.name.s, k) + if s.name.s != beau: + lintReport(conf, info, beau, s.name.s) + +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) 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 + if first+1 < line.len and line[first] == '`': inc first let last = first+identLen(line, first)-1 - if differ(line, first, last, newName): - # last-first+1 != newName.len or - var x = line.substr(0, first-1) & newName & line.substr(last+1) - system.shallowCopy(conf.m.fileInfos[info.fileIndex.int].lines[info.line.int-1], x) - conf.m.fileInfos[info.fileIndex.int].dirty = true - -proc checkStyle(conf: ConfigRef; cache: IdentCache; info: TLineInfo, s: string, k: TSymKind; sym: PSym) = - let beau = beautifyName(s, k) - if s != beau: - if gStyleCheck == StyleCheck.Auto: - sym.name = getIdent(cache, beau) - replaceInFile(conf, info, beau) - else: - message(conf, info, hintName, beau) - -proc styleCheckDefImpl(conf: ConfigRef; cache: IdentCache; 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 {sfImportc, sfExportc} * s.flags == {} or gCheckExtern: - checkStyle(conf, cache, info, s.name.s, k, s) - -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 - let beau = beautifyName(s.name.s, k) - if s.name.s != beau: - message(conf, info, hintName, beau) - -template styleCheckDef*(conf: ConfigRef; info: TLineInfo; s: PSym; k: TSymKind) = - if optCheckNep1 in conf.globalOptions: - nep1CheckDefImpl(conf, info, s, k) - when defined(nimfix): - if gStyleCheck != StyleCheck.None: styleCheckDefImpl(conf, cache, 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) + result = differ(line, first, last, newName) proc styleCheckUseImpl(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 in {skResult, skTemp} or s.name.s[0] notin Letters: - return - if s.kind in {skType, skGenericParam} and sfAnon in s.flags: return let newName = s.name.s - - replaceInFile(conf, info, newName) - #if newName == "File": writeStackTrace() - -template styleCheckUse*(info: TLineInfo; s: PSym) = - when defined(nimfix): - if gStyleCheck != StyleCheck.None: styleCheckUseImpl(conf, info, s) + 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/lists.nim b/compiler/lists.nim deleted file mode 100644 index bfd052204..000000000 --- a/compiler/lists.nim +++ /dev/null @@ -1,28 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2012 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module is deprecated, don't use it. -# TODO Remove this - -import os - -static: - echo "WARNING: imported deprecated module compiler/lists.nim, use seq ore lists from the standard library" - -proc appendStr*(list: var seq[string]; data: string) {.deprecated.} = - # just use system.add - list.add(data) - -proc includeStr(list: var seq[string]; data: string): bool {.deprecated.} = - if list.contains(data): - result = true - else: - result = false - list.add data - diff --git a/compiler/llstream.nim b/compiler/llstream.nim index 42bbb7600..cc8148483 100644 --- a/compiler/llstream.nim +++ b/compiler/llstream.nim @@ -10,13 +10,20 @@ ## Low-level streams for high performance. import - strutils + pathutils -# support '-d:useGnuReadline' for backwards compatibility: -when not defined(windows) and (defined(useGnuReadline) or defined(useLinenoise)): - import rdstdin +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 std/rdstdin type + TLLRepl* = proc (s: PLLStream, buf: pointer, bufLen: int): int + OnPrompt* = proc() {.closure.} TLLStreamKind* = enum # enum of different stream implementations llsNone, # null stream: reading and writing has no effect llsString, # stream encapsulates a string @@ -28,33 +35,27 @@ type s*: string rd*, wr*: int # for string streams lineOffset*: int # for fake stdin line numbers + repl*: TLLRepl # gives stdin control to clients + onPrompt*: OnPrompt 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: string, mode: FileMode): PLLStream = - new(result) - result.kind = llsFile - if not open(result.f, filename, mode): result = nil +proc llStreamOpen*(filename: AbsoluteFile, mode: FileMode): PLLStream = + 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 llStreamOpenStdIn*(): PLLStream = - new(result) - result.kind = llsStdIn - result.s = "" - result.lineOffset = -1 +proc llReadFromStdin(s: PLLStream, buf: pointer, bufLen: int): int +proc llStreamOpenStdIn*(r: TLLRepl = llReadFromStdin, onPrompt: OnPrompt = nil): PLLStream = + PLLStream(kind: llsStdIn, s: "", lineOffset: -1, repl: r, onPrompt: onPrompt) proc llStreamClose*(s: PLLStream) = case s.kind @@ -67,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") @@ -77,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 = {'+', '-', '*', '/', '\\', '<', '>', '!', '?', '^', @@ -87,13 +91,14 @@ proc endsWithOpr*(x: string): bool = result = x.endsWith(LineContinuationOprs) proc continueLine(line: string, inTripleString: bool): bool {.inline.} = - result = inTripleString or - line[0] == ' ' or - line.endsWith(LineContinuationOprs+AdditionalLineContinuationOprs) + result = inTripleString or line.len > 0 and ( + line[0] == ' ' or + line.endsWith(LineContinuationOprs+AdditionalLineContinuationOprs)) proc countTriples(s: string): int = + result = 0 var i = 0 - while i < s.len: + while i+2 < s.len: if s[i] == '"' and s[i+1] == '"' and s[i+2] == '"': inc result inc i, 2 @@ -105,12 +110,12 @@ proc llReadFromStdin(s: PLLStream, buf: pointer, bufLen: int): int = var line = newStringOfCap(120) var triples = 0 while readLineFromStdin(if s.s.len == 0: ">>> " else: "... ", line): - add(s.s, line) - add(s.s, "\n") + s.s.add(line) + s.s.add("\n") inc triples, countTriples(line) if not continueLine(line, (triples and 1) == 1): break inc(s.lineOffset) - result = min(bufLen, len(s.s) - s.rd) + result = min(bufLen, s.s.len - s.rd) if result > 0: copyMem(buf, addr(s.s[s.rd]), result) inc(s.rd, result) @@ -120,14 +125,15 @@ proc llStreamRead*(s: PLLStream, buf: pointer, bufLen: int): int = of llsNone: result = 0 of llsString: - result = min(bufLen, len(s.s) - s.rd) + result = min(bufLen, s.s.len - s.rd) if result > 0: copyMem(buf, addr(s.s[0 + s.rd]), result) inc(s.rd, result) of llsFile: result = readBuffer(s.f, buf, bufLen) of llsStdIn: - result = llReadFromStdin(s, buf, bufLen) + if s.onPrompt!=nil: s.onPrompt() + result = s.repl(s, buf, bufLen) proc llStreamReadLine*(s: PLLStream, line: var string): bool = setLen(line, 0) @@ -135,19 +141,19 @@ proc llStreamReadLine*(s: PLLStream, line: var string): bool = of llsNone: result = true of llsString: - while s.rd < len(s.s): + while s.rd < s.s.len: case s.s[s.rd] - of '\x0D': + of '\r': inc(s.rd) - if s.s[s.rd] == '\x0A': inc(s.rd) + if s.s[s.rd] == '\n': inc(s.rd) break - of '\x0A': + of '\n': inc(s.rd) break else: - add(line, s.s[s.rd]) + line.add(s.s[s.rd]) inc(s.rd) - result = line.len > 0 or s.rd < len(s.s) + result = line.len > 0 or s.rd < s.s.len of llsFile: result = readLine(s.f, line) of llsStdIn: @@ -158,8 +164,8 @@ proc llStreamWrite*(s: PLLStream, data: string) = of llsNone, llsStdIn: discard of llsString: - add(s.s, data) - inc(s.wr, len(data)) + s.s.add(data) + inc(s.wr, data.len) of llsFile: write(s.f, data) @@ -173,7 +179,7 @@ proc llStreamWrite*(s: PLLStream, data: char) = of llsNone, llsStdIn: discard of llsString: - add(s.s, data) + s.s.add(data) inc(s.wr) of llsFile: c = data @@ -185,7 +191,7 @@ proc llStreamWrite*(s: PLLStream, buf: pointer, buflen: int) = discard of llsString: if buflen > 0: - setLen(s.s, len(s.s) + buflen) + setLen(s.s, s.s.len + buflen) copyMem(addr(s.s[0 + s.wr]), buf, buflen) inc(s.wr, buflen) of llsFile: @@ -200,7 +206,7 @@ proc llStreamReadAll*(s: PLLStream): string = of llsString: if s.rd == 0: result = s.s else: result = substr(s.s, s.rd) - s.rd = len(s.s) + s.rd = s.s.len of llsFile: result = newString(bufSize) var bytes = readBuffer(s.f, addr(result[0]), bufSize) diff --git a/compiler/lookups.nim b/compiler/lookups.nim index 87694988a..d8fcf73e0 100644 --- a/compiler/lookups.nim +++ b/compiler/lookups.nim @@ -8,10 +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, wordrecg, idgen, nimfix.prettybase, lineinfos, strutils + ast, astalgo, idents, semdata, types, msgs, options, + renderer, lineinfos, modulegraphs, astmsgs, wordrecg + +import std/[intsets, sets] proc ensureNoMissingOrUnusedSymbols(c: PContext; scope: PScope) @@ -36,34 +42,41 @@ proc considerQuotedIdent*(c: PContext; n: PNode, origin: PNode = nil): PIdent = of nkAccQuoted: case n.len of 0: handleError(n, origin) - of 1: result = considerQuotedIdent(c, n.sons[0], origin) + of 1: result = considerQuotedIdent(c, n[0], origin) else: var id = "" for i in 0..<n.len: - let x = n.sons[i] + let x = n[i] 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) of nkOpenSymChoice, nkClosedSymChoice: if n[0].kind == nkSym: - result = n.sons[0].sym.name + result = n[0].sym.name else: handleError(n, origin) + of nkOpenSym: + result = considerQuotedIdent(c, n[0], origin) else: handleError(n, origin) template addSym*(scope: PScope, s: PSym) = strTableAdd(scope.symbols, s) -proc addUniqueSym*(scope: PScope, s: PSym): bool = - result = not strTableIncl(scope.symbols, s) +proc addUniqueSym*(scope: PScope, s: PSym): PSym = + result = strTableInclReportConflict(scope.symbols, s) proc openScope*(c: PContext): PScope {.discardable.} = result = PScope(parent: c.currentScope, - symbols: newStrTable(), + symbols: initStrTable(), depthLevel: c.scopeDepth + 1) c.currentScope = result @@ -74,67 +87,242 @@ proc closeScope*(c: PContext) = ensureNoMissingOrUnusedSymbols(c, c.currentScope) rawCloseScope(c) -iterator walkScopes*(scope: PScope): PScope = +iterator allScopes*(scope: PScope): PScope = var current = scope while current != nil: yield current current = current.parent -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 == cmdPretty: - prettybase.replaceDeprecated(conf, n.info, s, result) - else: - message(conf, n.info, warnDeprecated, "use " & result.name.s & " instead; " & - s.name.s) +iterator localScopesFrom*(c: PContext; scope: PScope): PScope = + for s in allScopes(scope): + if s == c.topLevelScope: break + yield s -proc localSearchInScope*(c: PContext, s: PIdent): PSym = - result = strTableGet(c.currentScope.symbols, s) +proc isShadowScope*(s: PScope): bool {.inline.} = + s.parent != nil and s.parent.depthLevel == s.depthLevel -proc searchInScopes*(c: PContext, s: PIdent): PSym = - for scope in walkScopes(c.currentScope): +proc localSearchInScope*(c: PContext, s: PIdent): PSym = + var scope = c.currentScope + result = strTableGet(scope.symbols, s) + while result == nil and scope.isShadowScope: + # We are in a shadow scope, check in the parent too + scope = scope.parent result = strTableGet(scope.symbols, s) - if result != nil: return + +proc initIdentIter(ti: var ModuleIter; marked: var IntSet; im: ImportedModule; name: PIdent; + g: ModuleGraph): PSym = + result = initModuleIter(ti, g, im.m, name) + while result != nil: + let b = + case im.mode + of importAll: true + of importSet: result.id in im.imported + of importExcept: name.id notin im.exceptSet + if b and not containsOrIncl(marked, result.id): + return result + result = nextModuleIter(ti, g) + +proc nextIdentIter(ti: var ModuleIter; marked: var IntSet; im: ImportedModule; + g: ModuleGraph): PSym = + while true: + result = nextModuleIter(ti, g) + if result == nil: return nil + case im.mode + of importAll: + if not containsOrIncl(marked, result.id): + return result + of importSet: + if result.id in im.imported and not containsOrIncl(marked, result.id): + return result + of importExcept: + if result.name.id notin im.exceptSet and not containsOrIncl(marked, result.id): + return result + +iterator symbols(im: ImportedModule; marked: var IntSet; name: PIdent; g: ModuleGraph): PSym = + var ti: ModuleIter = default(ModuleIter) + var candidate = initIdentIter(ti, marked, im, name, g) + while candidate != nil: + yield candidate + candidate = nextIdentIter(ti, marked, im, g) + +iterator importedItems*(c: PContext; name: PIdent): PSym = + var marked = initIntSet() + for im in c.imports.mitems: + for s in symbols(im, marked, name, c.graph): + yield s + +proc allPureEnumFields(c: PContext; name: PIdent): seq[PSym] = + var ti: TIdentIter = default(TIdentIter) + result = @[] + var res = initIdentIter(ti, c.pureEnumFields, name) + while res != nil: + result.add res + res = nextIdentIter(ti, c.pureEnumFields) + +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 + dec scopeN + for item in scope.symbols: + yield (item, scopeN, isLocal) + + dec scopeN + isLocal = false + for im in c.imports.mitems: + for s in modulegraphs.allSyms(c.graph, im.m): + 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 + 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): + result = strTableGet(scope.symbols, s) + if result != nil: return result + result = someSymFromImportTable(c, s, ambiguous) -when declared(echo): - proc debugScopes*(c: PContext; limit=0) {.deprecated.} = - var i = 0 - for scope in walkScopes(c.currentScope): - echo "scope ", i - for h in 0 .. high(scope.symbols.data): - if scope.symbols.data[h] != nil: - echo scope.symbols.data[h].name.s - if i == limit: break - inc i - -proc searchInScopes*(c: PContext, s: PIdent, filter: TSymKinds): PSym = - for scope in walkScopes(c.currentScope): - var ti: TIdentIter +proc debugScopes*(c: PContext; limit=0, max = int.high) {.deprecated.} = + var i = 0 + var count = 0 + for scope in allScopes(c.currentScope): + echo "scope ", i + for h in 0..high(scope.symbols.data): + if scope.symbols.data[h] != nil: + if count >= max: return + echo count, ": ", scope.symbols.data[h].name.s + count.inc + if i == limit: return + inc i + +proc searchInScopesAllCandidatesFilterBy*(c: PContext, s: PIdent, filter: TSymKinds): seq[PSym] = + result = @[] + 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: return candidate + if candidate.kind in filter: + result.add candidate candidate = nextIdentIter(ti, scope.symbols) - result = nil -proc errorSym*(c: PContext, n: PNode): PSym = + 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 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.sons[1] + if m.kind == nkDotExpr: m = m[1] let ident = if m.kind in {nkIdent, nkSym, nkAccQuoted}: considerQuotedIdent(c, m) else: getIdent(c.cache, "err:" & renderTree(m)) - result = newSym(skError, ident, getCurrOwner(c), n.info, {}) - result.typ = errorType(c) - incl(result.flags, sfDiscardable) - # pretend it's imported from some unknown module to prevent cascading errors: - if c.config.cmd != cmdInteractive and c.compilesContextId == 0: - c.importTable.addSym(result) + result = errorSym(c, ident, n.info) type TOverloadIterMode* = enum @@ -142,152 +330,309 @@ type oimSymChoiceLocalLookup TOverloadIter* = object it*: TIdentIter + mit*: ModuleIter m*: PSym mode*: TOverloadIterMode symChoiceIndex*: int - scope*: PScope - inSymChoice: IntSet + currentScope: PScope + importIdx: int + marked: IntSet -proc getSymRepr*(conf: ConfigRef; s: PSym): string = +proc getSymRepr*(conf: ConfigRef; s: PSym, getDeclarationPath = true): string = case s.kind - of skProc, skFunc, skMethod, skConverter, skIterator: - result = getProcHeader(conf, s) + of routineKinds, skType: + result = getProcHeader(conf, s, getDeclarationPath = getDeclarationPath) else: - result = s.name.s + result = "'$1'" % s.name.s + if getDeclarationPath: + result.addDeclaredLoc(conf, s) proc ensureNoMissingOrUnusedSymbols(c: PContext; scope: PScope) = # check if all symbols have been used and defined: - var it: TTabIter + 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 != skType: + if sfForward in s.flags and s.kind notin {skType, skModule}: # too many 'implementation of X' errors are annoying # and slow 'suggest' down: if missingImpls == 0: localError(c.config, s.info, "implementation of '$1' expected" % - getSymRepr(c.config, s)) + getSymRepr(c.config, s, getDeclarationPath=false)) inc missingImpls - elif {sfUsed, sfExported} * s.flags == {} and optHints in s.options: - if s.kind notin {skForVar, skParam, skMethod, skUnknown, skGenericParam}: + elif {sfUsed, sfExported} * s.flags == {}: + if s.kind notin {skForVar, skParam, skMethod, skUnknown, skGenericParam, skEnumField}: # XXX: implicit type params are currently skTypes # 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, getSymRepr(c.config, 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) = +proc wrongRedefinition*(c: PContext; info: TLineInfo, s: string; + conflictsWith: TLineInfo, note = errGenerated) = + ## Emit a redefinition error if in non-interactive mode if c.config.cmd != cmdInteractive: - localError(c.config, info, "redefinition of '$1'" % s) + localError(c.config, info, note, + "redefinition of '$1'; previous declaration here: $2" % + [s, c.config $ conflictsWith]) + +# xxx pending bootstrap >= 1.4, replace all those overloads with a single one: +# proc addDecl*(c: PContext, sym: PSym, info = sym.info, scope = c.currentScope) {.inline.} = +proc addDeclAt*(c: PContext; scope: PScope, sym: PSym, info: TLineInfo) = + if sym.name.id == ord(wUnderscore): return + let conflict = scope.addUniqueSym(sym) + if conflict != nil: + 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, info: TLineInfo) = - if not c.currentScope.addUniqueSym(sym): - wrongRedefinition(c, info, sym.name.s) +proc addDeclAt*(c: PContext; scope: PScope, sym: PSym) {.inline.} = + addDeclAt(c, scope, sym, sym.info) -proc addDecl*(c: PContext, sym: PSym) = - if not c.currentScope.addUniqueSym(sym): - wrongRedefinition(c, sym.info, sym.name.s) +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) = - if not scope.addUniqueSym(sym): - wrongRedefinition(c, sym.info, sym.name.s) +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: strTableAdd(c.module.tab, sym) + 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) - 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) - -when defined(nimfix): - # when we cannot find the identifier, retry with a changed identifer: - proc altSpelling(x: PIdent): PIdent = - case x.s[0] - of 'A'..'Z': result = getIdent(toLowerAscii(x.s[0]) & x.s.substr(1)) - of 'a'..'z': result = getIdent(toLowerAscii(x.s[0]) & x.s.substr(1)) - else: result = x - - template fixSpelling(n: PNode; ident: PIdent; op: untyped) = - let alt = ident.altSpelling - result = op(c, alt).skipAlias(n) - if result != nil: - prettybase.replaceDeprecated(n.info, ident, alt) - return result -else: - template fixSpelling(n: PNode; ident: PIdent; op: untyped) = discard + 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: initStrTable(), + depthLevel: c.scopeDepth) + +proc closeShadowScope*(c: PContext) = + ## 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: + if sym.kind in OverloadableSyms: + c.addInterfaceOverloadableSymAt(c.currentScope, sym) + else: + c.addInterfaceDecl(sym) + + +import std/[editdistance, heapqueue] + +type SpellCandidate = object + dist: int + depth: int + msg: string + sym: PSym + +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 + (a.dist, a.depth, a.msg) + +proc `<`(a, b: SpellCandidate): bool = + a.toOrderTup < b.toOrderTup + +proc mustFixSpelling(c: PContext): bool {.inline.} = + result = c.config.spellSuggestMax != 0 and c.compilesContextId == 0 + # don't slowdown inside compiles() + +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 + + for (sym, depth, isLocal) in allSyms(c): + let depth = -depth - 1 + let dist = editDistance(name0, sym.name.s.nimIdentNormalize) + var msg: string = "" + msg.add "\n ($1, $2): '$3'" % [$dist, $depth, sym.name.s] + list.push SpellCandidate(dist: dist, depth: depth, msg: msg, sym: sym) + + if list.len == 0: return + let e0 = list[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 + 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': " + 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" + err.add " " & candidate.owner.name.s & "." & candidate.name.s + err.add ": " & typeToString(candidate.typ) + if candidate.kind == skModule: + inc ignoredModules + else: + result = candidate + inc i + if ignoredModules != i-1: + localError(c.config, info, errGenerated, err) + result = nil + else: + amb = false proc errorUseQualifier*(c: PContext; info: TLineInfo; s: PSym) = - var err = "Error: ambiguous identifier: '" & s.name.s & "'" - var ti: TIdentIter - var candidate = initIdentIter(ti, c.importTable.symbols, s.name) + var amb: bool = false + discard errorUseQualifier(c, info, s, amb) + +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 - while candidate != nil: - if i == 0: err.add " --use " - else: err.add " or " - err.add candidate.owner.name.s & "." & candidate.name.s - candidate = nextIdentIter(ti, c.importTable.symbols) + for candidate in candidates: + 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 errorUndeclaredIdentifier*(c: PContext; info: TLineInfo; name: string) = - var err = "undeclared identifier: '" & name & "'" - if c.recursiveDep.len > 0: - err.add "\nThis might be caused by a recursive module dependency: " - err.add c.recursiveDep - # prevent excessive errors for 'nim check' - c.recursiveDep = nil +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: 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; ident: PIdent; info: TLineInfo): PSym = + var extra = "" + 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).skipAlias(n, c.config) - if result == nil: - fixSpelling(n, n.ident, searchInScopes) - errorUndeclaredIdentifier(c, n.info, n.ident.s) - result = errorSym(c, n) + 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).skipAlias(n, c.config) - if result == nil: - fixSpelling(n, ident, searchInScopes) - errorUndeclaredIdentifier(c, n.info, ident.s) - result = errorSym(c, n) + result = searchInScopes(c, ident, amb) + if result == nil: result = errorUndeclaredIdentifierHint(c, ident, n.info) else: internalError(c.config, n.info, "lookUp") - return - if contains(c.ambiguousSymbols, result.id): - errorUseQualifier(c, n.info, result) + return nil + if amb: + #contains(c.ambiguousSymbols, result.id): + result = errorUseQualifier(c, n.info, result, amb) when false: if result.kind == skStub: loadStub(result) @@ -295,163 +640,277 @@ 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).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: - result = searchInScopes(c, ident, allExceptModule).skipAlias(n, c.config) - if result == nil and checkPureEnumFields in flags: - result = strTableGet(c.pureEnumFields, 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: - fixSpelling(n, ident, searchInScopes) - errorUndeclaredIdentifier(c, n.info, ident.s) - result = errorSym(c, n) - elif checkAmbiguity in flags and result != nil and - contains(c.ambiguousSymbols, result.id): - errorUseQualifier(c, n.info, result) + 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 - if checkAmbiguity in flags and contains(c.ambiguousSymbols, result.id): - errorUseQualifier(c, n.info, n.sym) + of nkOpenSym: + result = qualifiedLookUp(c, n[0], flags) of nkDotExpr: result = nil - var m = qualifiedLookUp(c, n.sons[0], (flags*{checkUndeclared})+{checkModule}) + var m = qualifiedLookUp(c, n[0], (flags * {checkUndeclared}) + {checkModule}) if m != nil and m.kind == skModule: var ident: PIdent = nil - if n.sons[1].kind == nkIdent: - ident = n.sons[1].ident - elif n.sons[1].kind == nkAccQuoted: - ident = considerQuotedIdent(c, n.sons[1]) + 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 = strTableGet(m.tab, 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: - fixSpelling(n.sons[1], ident, searchInScopes) - errorUndeclaredIdentifier(c, n.sons[1].info, ident.s) - result = errorSym(c, n.sons[1]) - elif n.sons[1].kind == nkSym: - result = n.sons[1].sym + 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.sons[1].kind notin {nkOpenSymChoice, nkClosedSymChoice}: - localError(c.config, n.sons[1].info, "identifier expected, but got: " & - renderTree(n.sons[1])) - result = errorSym(c, n.sons[1]) + n[1].kind notin {nkOpenSymChoice, nkClosedSymChoice}: + localError(c.config, n[1].info, "identifier expected, but got: " & + renderTree(n[1])) + result = errorSym(c, n[1]) else: result = nil when false: 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) - o.scope = c.currentScope + var scope = c.currentScope o.mode = oimNoQualifier while true: - result = initIdentIter(o.it, o.scope.symbols, ident).skipAlias(n, c.config) + result = initIdentIter(o.it, scope.symbols, ident) if result != nil: + o.currentScope = scope break else: - o.scope = o.scope.parent - if o.scope == nil: break + 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) + if result != nil: + o.currentScope = nil + o.importIdx = i + return result + return nil + of nkSym: result = n.sym o.mode = oimDone of nkDotExpr: + result = nil o.mode = oimOtherModule - o.m = qualifiedLookUp(c, n.sons[0], {checkUndeclared, checkModule}) + o.m = qualifiedLookUp(c, n[0], {checkUndeclared, checkModule}) if o.m != nil and o.m.kind == skModule: var ident: PIdent = nil - if n.sons[1].kind == nkIdent: - ident = n.sons[1].ident - elif n.sons[1].kind == nkAccQuoted: - ident = considerQuotedIdent(c, n.sons[1], n) + if n[1].kind == nkIdent: + ident = n[1].ident + elif n[1].kind == nkAccQuoted: + ident = considerQuotedIdent(c, n[1], n) if ident != nil: 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 = initIdentIter(o.it, o.m.tab, ident).skipAlias(n, c.config) + result = initModuleIter(o.mit, c.graph, o.m, ident) else: - noidentError(c.config, n.sons[1], n) - result = errorSym(c, n.sons[1]) + noidentError(c.config, n[1], n) + result = errorSym(c, n[1]) of nkClosedSymChoice, nkOpenSymChoice: o.mode = oimSymChoice if n[0].kind == nkSym: - result = n.sons[0].sym + result = n[0].sym else: o.mode = oimDone return nil o.symChoiceIndex = 1 - o.inSymChoice = initIntSet() - incl(o.inSymChoice, result.id) - else: discard + o.marked = initIntSet() + incl(o.marked, result.id) + else: result = nil when false: if result != nil and result.kind == skStub: loadStub(result) proc lastOverloadScope*(o: TOverloadIter): int = case o.mode - of oimNoQualifier: result = if o.scope.isNil: -1 else: o.scope.depthLevel + of oimNoQualifier: + result = if o.importIdx >= 0: 0 + elif o.currentScope.isNil: -1 + else: o.currentScope.depthLevel of oimSelfModule: result = 1 of oimOtherModule: result = 0 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) + if result != nil: + # oh, we were wrong, some other module had the symbol, so remember that: + o.importIdx = idx + break + 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) + #while result != nil and result.id in o.marked: + # result = nextIdentIter(o.it, o.marked, c.imports[o.importIdx]) + if result != nil: + #assert result.id notin o.marked + return result + inc o.importIdx + proc nextOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = case o.mode of oimDone: result = nil of oimNoQualifier: - if o.scope != nil: - result = nextIdentIter(o.it, o.scope.symbols).skipAlias(n, c.config) + if o.currentScope != nil: + assert o.importIdx < 0 + result = nextIdentIter(o.it, o.currentScope.symbols) while result == nil: - o.scope = o.scope.parent - if o.scope == nil: break - result = initIdentIter(o.it, o.scope.symbols, o.it.name).skipAlias(n, c.config) - # BUGFIX: o.it.name <-> n.ident + o.currentScope = o.currentScope.parent + if o.currentScope != nil: + 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) + 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) + 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 = nextIdentIter(o.it, o.m.tab).skipAlias(n, c.config) + result = nextModuleIter(o.mit, c.graph) of oimSymChoice: - if o.symChoiceIndex < sonsLen(n): - result = n.sons[o.symChoiceIndex].sym - incl(o.inSymChoice, result.id) + if o.symChoiceIndex < n.len: + result = n[o.symChoiceIndex].sym + incl(o.marked, result.id) inc o.symChoiceIndex elif n.kind == nkOpenSymChoice: # try 'local' symbols too for Koenig's lookup: o.mode = oimSymChoiceLocalLookup - o.scope = c.currentScope - result = firstIdentExcluding(o.it, o.scope.symbols, - n.sons[0].sym.name, o.inSymChoice).skipAlias(n, c.config) + o.currentScope = c.currentScope + result = firstIdentExcluding(o.it, o.currentScope.symbols, + n[0].sym.name, o.marked) while result == nil: - o.scope = o.scope.parent - if o.scope == nil: break - result = firstIdentExcluding(o.it, o.scope.symbols, - n.sons[0].sym.name, o.inSymChoice).skipAlias(n, c.config) + o.currentScope = o.currentScope.parent + if o.currentScope != nil: + result = firstIdentExcluding(o.it, o.currentScope.symbols, + 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: - result = nextIdentExcluding(o.it, o.scope.symbols, o.inSymChoice).skipAlias(n, c.config) - while result == nil: - o.scope = o.scope.parent - if o.scope == nil: break - result = firstIdentExcluding(o.it, o.scope.symbols, - n.sons[0].sym.name, o.inSymChoice).skipAlias(n, c.config) + if o.currentScope != nil: + 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) + else: + o.importIdx = 0 + result = symChoiceExtension(o, c, n) + break + if result != nil: + incl o.marked, result.id + + elif o.importIdx < c.imports.len: + 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]) + 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 24a4f186e..2c9c4cb32 100644 --- a/compiler/lowerings.nim +++ b/compiler/lowerings.nim @@ -14,224 +14,271 @@ const import ast, astalgo, types, idents, magicsys, msgs, options, modulegraphs, lineinfos -from trees import getMagic + +when defined(nimPreviewSlimSystem): + import std/assertions proc newDeref*(n: PNode): PNode {.inline.} = - result = newNodeIT(nkHiddenDeref, n.info, n.typ.sons[0]) - addSon(result, n) + result = newNodeIT(nkHiddenDeref, n.info, n.typ.elementType) + result.add n proc newTupleAccess*(g: ModuleGraph; tup: PNode, i: int): PNode = - result = newNodeIT(nkBracketExpr, tup.info, tup.typ.skipTypes( - abstractInst).sons[i]) - addSon(result, copyTree(tup)) - var lit = newNodeIT(nkIntLit, tup.info, getSysType(g, tup.info, tyInt)) - lit.intVal = i - addSon(result, lit) + if tup.kind == nkHiddenAddr: + result = newNodeIT(nkHiddenAddr, tup.info, tup.typ.skipTypes(abstractInst+{tyPtr, tyVar, tyLent})) + result.add newNodeIT(nkBracketExpr, tup.info, tup.typ.skipTypes(abstractInst+{tyPtr, tyVar, tyLent})[i]) + result[0].add tup[0] + var lit = newNodeIT(nkIntLit, tup.info, getSysType(g, tup.info, tyInt)) + lit.intVal = i + result[0].add lit + else: + result = newNodeIT(nkBracketExpr, tup.info, tup.typ.skipTypes( + abstractInst)[i]) + result.add copyTree(tup) + var lit = newNodeIT(nkIntLit, tup.info, getSysType(g, tup.info, tyInt)) + lit.intVal = i + result.add lit proc addVar*(father, v: PNode) = var vpart = newNodeI(nkIdentDefs, v.info, 3) - vpart.sons[0] = v - vpart.sons[1] = newNodeI(nkEmpty, v.info) - vpart.sons[2] = vpart[1] - addSon(father, vpart) + vpart[0] = v + vpart[1] = newNodeI(nkEmpty, v.info) + vpart[2] = vpart[1] + father.add vpart -proc newAsgnStmt(le, ri: PNode): PNode = +proc addVar*(father, v, value: PNode) = + var vpart = newNodeI(nkIdentDefs, v.info, 3) + vpart[0] = v + vpart[1] = newNodeI(nkEmpty, v.info) + vpart[2] = value + father.add vpart + +proc newAsgnStmt*(le, ri: PNode): PNode = result = newNodeI(nkAsgn, le.info, 2) - result.sons[0] = le - result.sons[1] = ri + result[0] = le + result[1] = ri + +proc newFastAsgnStmt*(le, ri: PNode): PNode = + result = newNodeI(nkFastAsgn, le.info, 2) + result[0] = le + result[1] = ri -proc newFastAsgnStmt(le, ri: PNode): PNode = +proc newFastMoveStmt*(g: ModuleGraph, le, ri: PNode): PNode = result = newNodeI(nkFastAsgn, le.info, 2) - result.sons[0] = le - result.sons[1] = ri + result[0] = le + result[1] = newNodeIT(nkCall, ri.info, ri.typ) + result[1].add newSymNode(getSysMagic(g, ri.info, "move", mMove)) + result[1].add ri -proc lowerTupleUnpacking*(g: ModuleGraph; n: PNode; owner: PSym): PNode = +proc lowerTupleUnpacking*(g: ModuleGraph; n: PNode; idgen: IdGenerator; owner: PSym): PNode = assert n.kind == nkVarTuple let value = n.lastSon result = newNodeI(nkStmtList, n.info) - var temp = newSym(skTemp, getIdent(g.cache, genPrefix), owner, value.info, g.config.options) + 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) + if not avoidTemp: + v.addVar(tempAsNode, value) + result.add(v) + + for i in 0..<n.len-2: + let val = newTupleAccess(g, tempAsNode, i) + if n[i].kind == nkSym: v.addVar(n[i], val) + else: result.add newAsgnStmt(n[i], val) + +proc evalOnce*(g: ModuleGraph; value: PNode; idgen: IdGenerator; owner: PSym): PNode = + ## Turns (value) into (let tmp = value; tmp) so that 'value' can be re-used + ## 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), idgen, + owner, value.info, g.config.options) temp.typ = skipTypes(value.typ, abstractInst) incl(temp.flags, sfFromGeneric) - var v = newNodeI(nkVarSection, value.info) + var v = newNodeI(nkLetSection, value.info) let tempAsNode = newSymNode(temp) v.addVar(tempAsNode) result.add(v) - result.add newAsgnStmt(tempAsNode, value) - for i in 0 .. n.len-3: - if n.sons[i].kind == nkSym: v.addVar(n.sons[i]) - result.add newAsgnStmt(n.sons[i], newTupleAccess(g, tempAsNode, i)) + result.add tempAsNode proc newTupleAccessRaw*(tup: PNode, i: int): PNode = result = newNodeI(nkBracketExpr, tup.info) - addSon(result, copyTree(tup)) + result.add copyTree(tup) var lit = newNodeI(nkIntLit, tup.info) lit.intVal = i - addSon(result, lit) + result.add lit proc newTryFinally*(body, final: PNode): PNode = - result = newTree(nkTryStmt, body, newTree(nkFinally, final)) + result = newTree(nkHiddenTryStmt, body, newTree(nkFinally, final)) -proc lowerTupleUnpackingForAsgn*(g: ModuleGraph; n: PNode; owner: PSym): PNode = - let value = n.lastSon - result = newNodeI(nkStmtList, n.info) - - var temp = newSym(skLet, getIdent(g.cache, "_"), 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.sons[0] = tempAsNode - vpart.sons[1] = newNodeI(nkEmpty, value.info) - vpart.sons[2] = value - addSon(v, vpart) - result.add(v) - - let lhs = n.sons[0] - for i in 0 .. lhs.len-1: - result.add newAsgnStmt(lhs.sons[i], newTupleAccessRaw(tempAsNode, i)) - -proc lowerSwap*(g: ModuleGraph; n: PNode; owner: PSym): PNode = +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), owner, n.info, owner.options) - temp.typ = n.sons[1].typ + 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) var v = newNodeI(nkVarSection, n.info) let tempAsNode = newSymNode(temp) var vpart = newNodeI(nkIdentDefs, v.info, 3) - vpart.sons[0] = tempAsNode - vpart.sons[1] = newNodeI(nkEmpty, v.info) - vpart.sons[2] = n[1] - addSon(v, vpart) + vpart[0] = tempAsNode + vpart[1] = newNodeI(nkEmpty, v.info) + vpart[2] = n[1] + v.add vpart result.add(v) result.add newFastAsgnStmt(n[1], n[2]) result.add newFastAsgnStmt(n[2], tempAsNode) -proc createObj*(g: ModuleGraph; owner: PSym, info: TLineInfo; final=true): PType = - result = newType(tyObject, owner) +proc createObj*(g: ModuleGraph; idgen: IdGenerator; owner: PSym, info: TLineInfo; final=true): PType = + result = newType(tyObject, idgen, owner) if final: rawAddSon(result, nil) incl result.flags, tfFinal else: rawAddSon(result, getCompilerProc(g, "RootObj").typ) result.n = newNodeI(nkRecList, info) - let s = newSym(skType, getIdent(g.cache, "Env_" & toFilename(g.config, info)), - owner, info, owner.options) + let s = newSym(skType, getIdent(g.cache, "Env_" & toFilename(g.config, info) & "_" & $owner.name.s), + idgen, owner, info, owner.options) incl s.flags, sfAnon s.typ = result result.sym = s +template fieldCheck {.dirty.} = + when false: + if tfCheckedForDestructor in obj.flags: + echo "missed field ", field.name.s + writeStackTrace() + proc rawAddField*(obj: PType; field: PSym) = assert field.kind == skField - field.position = sonsLen(obj.n) - addSon(obj.n, newSymNode(field)) + field.position = obj.n.len + obj.n.add newSymNode(field) + propagateToOwner(obj, field.typ) + fieldCheck() proc rawIndirectAccess*(a: PNode; field: PSym; info: TLineInfo): PNode = # returns a[].field as a node assert field.kind == skField var deref = newNodeI(nkHiddenDeref, info) - deref.typ = a.typ.skipTypes(abstractInst).sons[0] - addSon(deref, a) + deref.typ = a.typ.skipTypes(abstractInst)[0] + deref.add a result = newNodeI(nkDotExpr, info) - addSon(result, deref) - addSon(result, newSymNode(field)) + result.add deref + result.add newSymNode(field) result.typ = field.typ proc rawDirectAccess*(obj, field: PSym): PNode = # returns a.field as a node assert field.kind == skField result = newNodeI(nkDotExpr, field.info) - addSon(result, newSymNode obj) - addSon(result, newSymNode field) + result.add newSymNode(obj) + result.add newSymNode(field) result.typ = field.typ -proc lookupInRecord(n: PNode, id: int): PSym = +proc lookupInRecord(n: PNode, id: ItemId): PSym = result = nil case n.kind of nkRecList: - for i in countup(0, sonsLen(n) - 1): - result = lookupInRecord(n.sons[i], id) + for i in 0..<n.len: + result = lookupInRecord(n[i], id) if result != nil: return of nkRecCase: - if n.sons[0].kind != nkSym: return - result = lookupInRecord(n.sons[0], id) + if n[0].kind != nkSym: return + result = lookupInRecord(n[0], id) if result != nil: return - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind + for i in 1..<n.len: + case n[i].kind of nkOfBranch, nkElse: - result = lookupInRecord(lastSon(n.sons[i]), id) + result = lookupInRecord(lastSon(n[i]), id) if result != nil: return else: discard of nkSym: - if n.sym.id == -abs(id): result = n.sym + 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) = +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), s.owner, s.info, - s.options) - field.id = -s.id - let t = skipIntLit(s.typ) + 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) field.typ = t - assert t.kind != tyStmt - field.position = sonsLen(obj.n) - addSon(obj.n, newSymNode(field)) - -proc addUniqueField*(obj: PType; s: PSym; cache: IdentCache): PSym {.discardable.} = - result = lookupInRecord(obj.n, s.id) + 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 + # 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), s.owner, s.info, - s.options) - field.id = -s.id - let t = skipIntLit(s.typ) + 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) field.typ = t - assert t.kind != tyStmt - field.position = sonsLen(obj.n) - addSon(obj.n, newSymNode(field)) + assert t.kind != tyTyped + propagateToOwner(obj, t) + field.position = obj.n.len + obj.n.add newSymNode(field) result = field -proc newDotExpr(obj, b: PSym): PNode = +proc newDotExpr*(obj, b: PSym): PNode = result = newNodeI(nkDotExpr, obj.info) - let field = lookupInRecord(obj.typ.n, b.id) + let field = lookupInRecord(obj.typ.n, b.itemId) assert field != nil, b.name.s - addSon(result, newSymNode(obj)) - addSon(result, newSymNode(field)) + result.add newSymNode(obj) + result.add newSymNode(field) result.typ = field.typ -proc indirectAccess*(a: PNode, b: int, info: TLineInfo): 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).sons[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.sons[0] + t = t.baseClass if t == nil: break t = t.skipTypes(skipPtrs) #if field == nil: # echo "FIELD ", b # debug deref.typ assert field != nil - addSon(deref, a) + deref.add a result = newNodeI(nkDotExpr, info) - addSon(result, deref) - addSon(result, newSymNode(field)) + result.add deref + result.add newSymNode(field) result.typ = field.typ -proc indirectAccess(a: PNode, b: string, info: TLineInfo; cache: IdentCache): 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).sons[0] + deref.typ = a.typ.skipTypes(abstractInst).elementType var t = deref.typ.skipTypes(abstractInst) var field: PSym let bb = getIdent(cache, b) @@ -239,17 +286,17 @@ proc indirectAccess(a: PNode, b: string, info: TLineInfo; cache: IdentCache): PN assert t.kind == tyObject field = getSymFromList(t.n, bb) if field != nil: break - t = t.sons[0] + t = t.baseClass if t == nil: break t = t.skipTypes(skipPtrs) #if field == nil: # echo "FIELD ", b # debug deref.typ assert field != nil - addSon(deref, a) + deref.add a result = newNodeI(nkDotExpr, info) - addSon(result, deref) - addSon(result, newSymNode(field)) + result.add deref + result.add newSymNode(field) result.typ = field.typ proc getFieldFromObj*(t: PType; v: PSym): PSym = @@ -257,258 +304,47 @@ proc getFieldFromObj*(t: PType; v: PSym): PSym = var t = t while true: assert t.kind == tyObject - result = lookupInRecord(t.n, v.id) + result = lookupInRecord(t.n, v.itemId) if result != nil: break - t = t.sons[0] + t = t.baseClass if t == nil: break t = t.skipTypes(skipPtrs) proc indirectAccess*(a: PNode, b: PSym, info: TLineInfo): PNode = # returns a[].b as a node - result = indirectAccess(a, b.id, info) + result = indirectAccess(a, b.itemId, info) proc indirectAccess*(a, b: PSym, info: TLineInfo): PNode = result = indirectAccess(newSymNode(a), b, info) -proc genAddrOf*(n: PNode): PNode = +proc genAddrOf*(n: PNode; idgen: IdGenerator; typeKind = tyPtr): PNode = result = newNodeI(nkAddr, n.info, 1) - result.sons[0] = n - result.typ = newType(tyPtr, n.typ.owner) + result[0] = n + result.typ = newType(typeKind, idgen, n.typ.owner) result.typ.rawAddSon(n.typ) -proc genDeref*(n: PNode): PNode = - result = newNodeIT(nkHiddenDeref, n.info, - n.typ.skipTypes(abstractInst).sons[0]) +proc genDeref*(n: PNode; k = nkHiddenDeref): PNode = + result = newNodeIT(k, n.info, + n.typ.skipTypes(abstractInst).elementType) result.add n -proc callCodegenProc*(g: ModuleGraph; name: string, arg1: PNode; - arg2, arg3, optionalArgs: PNode = nil): PNode = - result = newNodeI(nkCall, arg1.info) +proc callCodegenProc*(g: ModuleGraph; name: string; + info: TLineInfo = unknownLineInfo; + 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: - localError(g.config, arg1.info, "system module needs: " & name) + localError(g.config, info, "system module needs: " & name) else: result.add newSymNode(sym) - result.add arg1 + if arg1 != nil: result.add arg1 if arg2 != nil: result.add arg2 if arg3 != nil: result.add arg3 if optionalArgs != nil: - for i in 1..optionalArgs.len-3: + for i in 1..<optionalArgs.len-2: result.add optionalArgs[i] - result.typ = sym.typ.sons[0] - -proc callProc(a: PNode): PNode = - result = newNodeI(nkCall, a.info) - result.add a - result.typ = a.typ.sons[0] - -# we have 4 cases to consider: -# - a void proc --> nothing to do -# - a proc returning GC'ed memory --> requires a flowVar -# - a proc returning non GC'ed memory --> pass as hidden 'var' parameter -# - not in a parallel environment --> requires a flowVar for memory safety -type - TSpawnResult* = enum - srVoid, srFlowVar, srByVar - TFlowVarKind = enum - fvInvalid # invalid type T for 'FlowVar[T]' - fvGC # FlowVar of a GC'ed type - fvBlob # FlowVar of a blob type - -proc spawnResult*(t: PType; inParallel: bool): TSpawnResult = - if t.isEmptyType: srVoid - elif inParallel and not containsGarbageCollectedRef(t): srByVar - else: srFlowVar - -proc flowVarKind(t: PType): TFlowVarKind = - if t.skipTypes(abstractInst).kind in {tyRef, tyString, tySequence}: fvGC - elif containsGarbageCollectedRef(t): fvInvalid - else: fvBlob - -proc typeNeedsNoDeepCopy(t: PType): bool = - var t = t.skipTypes(abstractInst) - # for the tconvexhull example (and others) we're a bit lax here and pretend - # seqs and strings are *by value* only and 'shallow' doesn't exist! - if t.kind == tyString: return true - # 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 - result = not containsGarbageCollectedRef(t) - -proc addLocalVar(g: ModuleGraph; varSection, varInit: PNode; owner: PSym; typ: PType; - v: PNode; useShallowCopy=false): PSym = - result = newSym(skTemp, getIdent(g.cache, genPrefix), owner, varSection.info, - owner.options) - result.typ = typ - incl(result.flags, sfFromGeneric) - - var vpart = newNodeI(nkIdentDefs, varSection.info, 3) - vpart.sons[0] = newSymNode(result) - vpart.sons[1] = newNodeI(nkEmpty, varSection.info) - vpart.sons[2] = if varInit.isNil: v else: vpart[1] - varSection.add vpart - if varInit != nil: - if useShallowCopy and typeNeedsNoDeepCopy(typ): - varInit.add newFastAsgnStmt(newSymNode(result), v) - else: - let deepCopyCall = newNodeI(nkCall, varInit.info, 3) - deepCopyCall.sons[0] = newSymNode(getSysMagic(g, varSection.info, "deepCopy", mDeepCopy)) - deepCopyCall.sons[1] = newSymNode(result) - deepCopyCall.sons[2] = v - varInit.add deepCopyCall - -discard """ -We generate roughly this: - -proc f_wrapper(thread, args) = - barrierEnter(args.barrier) # for parallel statement - var a = args.a # thread transfer; deepCopy or shallowCopy or no copy - # depending on whether we're in a 'parallel' statement - var b = args.b - var fv = args.fv - - fv.owner = thread # optional - nimArgsPassingDone() # signal parent that the work is done - # - args.fv.blob = f(a, b, ...) - nimFlowVarSignal(args.fv) - - # - or - - f(a, b, ...) - barrierLeave(args.barrier) # for parallel statement - -stmtList: - var scratchObj - scratchObj.a = a - scratchObj.b = b - - nimSpawn(f_wrapper, addr scratchObj) - scratchObj.fv # optional - -""" - -proc createWrapperProc(g: ModuleGraph; f: PNode; threadParam, argsParam: PSym; - varSection, varInit, call, barrier, fv: PNode; - spawnKind: TSpawnResult): PSym = - var body = newNodeI(nkStmtList, f.info) - var threadLocalBarrier: PSym - if barrier != nil: - var varSection2 = newNodeI(nkVarSection, barrier.info) - threadLocalBarrier = addLocalVar(g, varSection2, nil, argsParam.owner, - barrier.typ, barrier) - body.add varSection2 - body.add callCodegenProc(g, "barrierEnter", threadLocalBarrier.newSymNode) - var threadLocalProm: PSym - if spawnKind == srByVar: - threadLocalProm = addLocalVar(g, varSection, nil, argsParam.owner, fv.typ, fv) - elif fv != nil: - internalAssert g.config, fv.typ.kind == tyGenericInst - threadLocalProm = addLocalVar(g, varSection, nil, argsParam.owner, fv.typ, fv) - body.add varSection - body.add varInit - if fv != nil and spawnKind != srByVar: - # generate: - # fv.owner = threadParam - body.add newAsgnStmt(indirectAccess(threadLocalProm.newSymNode, - "owner", fv.info, g.cache), threadParam.newSymNode) - - body.add callCodegenProc(g, "nimArgsPassingDone", threadParam.newSymNode) - if spawnKind == srByVar: - body.add newAsgnStmt(genDeref(threadLocalProm.newSymNode), call) - elif fv != nil: - let fk = fv.typ.sons[1].flowVarKind - if fk == fvInvalid: - localError(g.config, f.info, "cannot create a flowVar of type: " & - typeToString(fv.typ.sons[1])) - body.add newAsgnStmt(indirectAccess(threadLocalProm.newSymNode, - if fk == fvGC: "data" else: "blob", fv.info, g.cache), call) - if fk == fvGC: - let incRefCall = newNodeI(nkCall, fv.info, 2) - incRefCall.sons[0] = newSymNode(getSysMagic(g, fv.info, "GCref", mGCref)) - incRefCall.sons[1] = indirectAccess(threadLocalProm.newSymNode, - "data", fv.info, g.cache) - body.add incRefCall - if barrier == nil: - # by now 'fv' is shared and thus might have beeen overwritten! we need - # to use the thread-local view instead: - body.add callCodegenProc(g, "nimFlowVarSignal", threadLocalProm.newSymNode) - else: - body.add call - if barrier != nil: - body.add callCodegenProc(g, "barrierLeave", threadLocalBarrier.newSymNode) - - var params = newNodeI(nkFormalParams, f.info) - params.add newNodeI(nkEmpty, f.info) - params.add threadParam.newSymNode - params.add argsParam.newSymNode - - var t = newType(tyProc, threadParam.owner) - t.rawAddSon nil - t.rawAddSon threadParam.typ - t.rawAddSon argsParam.typ - t.n = newNodeI(nkFormalParams, f.info) - t.n.add newNodeI(nkEffectList, f.info) - t.n.add threadParam.newSymNode - t.n.add argsParam.newSymNode - - let name = (if f.kind == nkSym: f.sym.name.s else: genPrefix) & "Wrapper" - result = newSym(skProc, getIdent(g.cache, name), argsParam.owner, f.info, - argsParam.options) - let emptyNode = newNodeI(nkEmpty, f.info) - result.ast = newProcNode(nkProcDef, f.info, body = body, - params = params, name = newSymNode(result), pattern = emptyNode, - genericParams = emptyNode, pragmas = emptyNode, - exceptions = emptyNode) - result.typ = t - -proc createCastExpr(argsParam: PSym; objType: PType): PNode = - result = newNodeI(nkCast, argsParam.info) - result.add newNodeI(nkEmpty, argsParam.info) - result.add newSymNode(argsParam) - result.typ = newType(tyPtr, objType.owner) - result.typ.rawAddSon(objType) - -proc setupArgsForConcurrency(g: ModuleGraph; n: PNode; objType: PType; scratchObj: PSym, - castExpr, call, - varSection, varInit, result: PNode) = - let formals = n[0].typ.n - let tmpName = getIdent(g.cache, genPrefix) - for i in 1 ..< n.len: - # we pick n's type here, which hopefully is 'tyArray' and not - # 'tyOpenArray': - var argType = n[i].typ.skipTypes(abstractInst) - if i < formals.len and formals[i].typ.kind in {tyVar, tyLent}: - localError(g.config, n[i].info, "'spawn'ed function cannot have a 'var' parameter") - #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, objType.owner, n.info, g.config.options) - field.typ = argType - objType.addField(field, g.cache) - result.add newFastAsgnStmt(newDotExpr(scratchObj, field), n[i]) - - let temp = addLocalVar(g, varSection, varInit, objType.owner, argType, - indirectAccess(castExpr, field, n.info)) - call.add(newSymNode(temp)) - -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 - ## determined as the owner; ``obj`` in the example. - case n.kind - of nkSym: - if n.sym.kind in {skVar, skResult, skTemp, skLet, skForVar}: - result = n.sym - of nkDotExpr, nkBracketExpr, nkHiddenDeref, nkDerefExpr, - nkObjUpConv, nkObjDownConv, nkCheckedFieldExpr: - result = getRoot(n.sons[0]) - of nkHiddenStdConv, nkHiddenSubConv, nkConv: - result = getRoot(n.sons[1]) - of nkCallKinds: - if getMagic(n) == mSlice: result = getRoot(n.sons[1]) - else: discard + result.typ = sym.typ.returnType proc newIntLit*(g: ModuleGraph; info: TLineInfo; value: BiggestInt): PNode = result = nkIntLit.newIntNode(value) @@ -516,202 +352,19 @@ proc newIntLit*(g: ModuleGraph; info: TLineInfo; value: BiggestInt): PNode = proc genHigh*(g: ModuleGraph; n: PNode): PNode = if skipTypes(n.typ, abstractVar).kind == tyArray: - result = newIntLit(g, n.info, lastOrd(g.config, skipTypes(n.typ, abstractVar))) + result = newIntLit(g, n.info, toInt64(lastOrd(g.config, skipTypes(n.typ, abstractVar)))) else: result = newNodeI(nkCall, n.info, 2) result.typ = getSysType(g, n.info, tyInt) - result.sons[0] = newSymNode(getSysMagic(g, n.info, "high", mHigh)) - result.sons[1] = n - -proc setupArgsForParallelism(g: ModuleGraph; n: PNode; objType: PType; scratchObj: PSym; - castExpr, call, - varSection, varInit, result: PNode) = - let formals = n[0].typ.n - let tmpName = getIdent(g.cache, genPrefix) - # we need to copy the foreign scratch object fields into local variables - # for correctness: These are called 'threadLocal' here. - for i in 1 ..< n.len: - let n = n[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, objType.owner, n.info, g.config.options) - - if argType.kind in {tyVarargs, tyOpenArray}: - # important special case: we always create a zero-copy slice: - let slice = newNodeI(nkCall, n.info, 4) - slice.typ = n.typ - slice.sons[0] = newSymNode(createMagic(g, "slice", mSlice)) - slice.sons[0].typ = getSysType(g, n.info, tyInt) # fake type - var fieldB = newSym(skField, tmpName, objType.owner, n.info, g.config.options) - fieldB.typ = getSysType(g, n.info, tyInt) - objType.addField(fieldB, g.cache) - - if getMagic(n) == mSlice: - let a = genAddrOf(n[1]) - field.typ = a.typ - objType.addField(field, g.cache) - result.add newFastAsgnStmt(newDotExpr(scratchObj, field), a) - - var fieldA = newSym(skField, tmpName, objType.owner, n.info, g.config.options) - fieldA.typ = getSysType(g, n.info, tyInt) - objType.addField(fieldA, g.cache) - result.add newFastAsgnStmt(newDotExpr(scratchObj, fieldA), n[2]) - result.add newFastAsgnStmt(newDotExpr(scratchObj, fieldB), n[3]) - - let threadLocal = addLocalVar(g, varSection,nil, objType.owner, fieldA.typ, - indirectAccess(castExpr, fieldA, n.info), - useShallowCopy=true) - slice.sons[2] = threadLocal.newSymNode - else: - let a = genAddrOf(n) - field.typ = a.typ - objType.addField(field, g.cache) - result.add newFastAsgnStmt(newDotExpr(scratchObj, field), a) - result.add newFastAsgnStmt(newDotExpr(scratchObj, fieldB), genHigh(g, n)) - - slice.sons[2] = newIntLit(g, n.info, 0) - # the array itself does not need to go through a thread local variable: - slice.sons[1] = genDeref(indirectAccess(castExpr, field, n.info)) - - let threadLocal = addLocalVar(g, varSection,nil, objType.owner, fieldB.typ, - indirectAccess(castExpr, fieldB, n.info), - useShallowCopy=true) - slice.sons[3] = threadLocal.newSymNode - call.add slice - elif (let size = computeSize(g.config, argType); size < 0 or size > 16) and - n.getRoot != nil: - # it is more efficient to pass a pointer instead: - let a = genAddrOf(n) - field.typ = a.typ - objType.addField(field, g.cache) - result.add newFastAsgnStmt(newDotExpr(scratchObj, field), a) - let threadLocal = addLocalVar(g, varSection,nil, objType.owner, field.typ, - indirectAccess(castExpr, field, n.info), - useShallowCopy=true) - call.add(genDeref(threadLocal.newSymNode)) - else: - # boring case - field.typ = argType - objType.addField(field, g.cache) - result.add newFastAsgnStmt(newDotExpr(scratchObj, field), n) - let threadLocal = addLocalVar(g, varSection, varInit, - objType.owner, field.typ, - indirectAccess(castExpr, field, n.info), - useShallowCopy=true) - call.add(threadLocal.newSymNode) - -proc wrapProcForSpawn*(g: ModuleGraph; owner: PSym; spawnExpr: PNode; retType: PType; - barrier, dest: PNode = nil): PNode = - # if 'barrier' != nil, then it is in a 'parallel' section and we - # generate quite different code - let n = spawnExpr[^2] - let spawnKind = spawnResult(retType, barrier!=nil) - case spawnKind - of srVoid: - internalAssert g.config, dest == nil - result = newNodeI(nkStmtList, n.info) - of srFlowVar: - internalAssert g.config, dest == nil - result = newNodeIT(nkStmtListExpr, n.info, retType) - of srByVar: - if dest == nil: localError(g.config, n.info, "'spawn' must not be discarded") - result = newNodeI(nkStmtList, n.info) - - if n.kind notin nkCallKinds: - localError(g.config, n.info, "'spawn' takes a call expression") - return - if optThreadAnalysis in g.config.globalOptions: - if {tfThread, tfNoSideEffect} * n[0].typ.flags == {}: - localError(g.config, n.info, "'spawn' takes a GC safe call expression") - var - threadParam = newSym(skParam, getIdent(g.cache, "thread"), owner, n.info, g.config.options) - argsParam = newSym(skParam, getIdent(g.cache, "args"), owner, n.info, g.config.options) - block: - let ptrType = getSysType(g, n.info, tyPointer) - threadParam.typ = ptrType - argsParam.typ = ptrType - argsParam.position = 1 - - var objType = createObj(g, owner, n.info) - incl(objType.flags, tfFinal) - let castExpr = createCastExpr(argsParam, objType) - - var scratchObj = newSym(skVar, getIdent(g.cache, "scratch"), owner, n.info, g.config.options) - block: - scratchObj.typ = objType - incl(scratchObj.flags, sfFromGeneric) - var varSectionB = newNodeI(nkVarSection, n.info) - varSectionB.addVar(scratchObj.newSymNode) - result.add varSectionB - - var call = newNodeIT(nkCall, n.info, n.typ) - var fn = n.sons[0] - # templates and macros are in fact valid here due to the nature of - # the transformation: - if fn.kind == nkClosure: - localError(g.config, n.info, "closure in spawn environment is not allowed") - if not (fn.kind == nkSym and fn.sym.kind in {skProc, skTemplate, skMacro, - skFunc, skMethod, skConverter}): - # for indirect calls we pass the function pointer in the scratchObj - var argType = n[0].typ.skipTypes(abstractInst) - var field = newSym(skField, getIdent(g.cache, "fn"), owner, n.info, g.config.options) - field.typ = argType - objType.addField(field, g.cache) - 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) - var varInit = newNodeI(nkStmtList, n.info) - if barrier.isNil: - setupArgsForConcurrency(g, n, objType, scratchObj, castExpr, call, - varSection, varInit, result) + result[0] = newSymNode(getSysMagic(g, n.info, "high", mHigh)) + result[1] = n + +proc genLen*(g: ModuleGraph; n: PNode): PNode = + if skipTypes(n.typ, abstractVar).kind == tyArray: + result = newIntLit(g, n.info, toInt64(lastOrd(g.config, skipTypes(n.typ, abstractVar)) + 1)) else: - setupArgsForParallelism(g, n, objType, scratchObj, castExpr, call, - varSection, varInit, result) - - var barrierAsExpr: PNode = nil - if barrier != nil: - let typ = newType(tyPtr, owner) - typ.rawAddSon(magicsys.getCompilerProc(g, "Barrier").typ) - var field = newSym(skField, getIdent(g.cache, "barrier"), owner, n.info, g.config.options) - field.typ = typ - objType.addField(field, g.cache) - 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"), owner, n.info, g.config.options) - field.typ = retType - objType.addField(field, g.cache) - 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) - - elif spawnKind == srByVar: - var field = newSym(skField, getIdent(g.cache, "fv"), owner, n.info, g.config.options) - field.typ = newType(tyPtr, objType.owner) - field.typ.rawAddSon(retType) - objType.addField(field, g.cache) - fvAsExpr = indirectAccess(castExpr, field, n.info) - result.add newFastAsgnStmt(newDotExpr(scratchObj, field), genAddrOf(dest)) - - let wrapper = createWrapperProc(g, fn, threadParam, argsParam, - varSection, varInit, call, - barrierAsExpr, fvAsExpr, spawnKind) - result.add callCodegenProc(g, "nimSpawn" & $spawnExpr.len, wrapper.newSymNode, - genAddrOf(scratchObj.newSymNode), nil, spawnExpr) - - if spawnKind == srFlowVar: result.add fvField + result = newNodeI(nkCall, n.info, 2) + result.typ = getSysType(g, n.info, tyInt) + result[0] = newSymNode(getSysMagic(g, n.info, "len", mLengthSeq)) + result[1] = n + diff --git a/compiler/macrocacheimpl.nim b/compiler/macrocacheimpl.nim index d23040763..c869c2289 100644 --- a/compiler/macrocacheimpl.nim +++ b/compiler/macrocacheimpl.nim @@ -9,71 +9,36 @@ ## This module implements helpers for the macro cache. -import lineinfos, ast, modulegraphs, vmdef, magicsys +import lineinfos, ast, vmdef + +proc append(c: PCtx; n: PNode) = + c.vmstateDiff.add((c.module, n)) proc recordInc*(c: PCtx; info: TLineInfo; key: string; by: BiggestInt) = - var recorded = newNodeI(nkCommentStmt, info) + var recorded = newNodeI(nkReplayAction, info) recorded.add newStrNode("inc", info) recorded.add newStrNode(key, info) recorded.add newIntNode(nkIntLit, by) - c.graph.recordStmt(c.graph, c.module, recorded) + c.append(recorded) proc recordPut*(c: PCtx; info: TLineInfo; key: string; k: string; val: PNode) = - var recorded = newNodeI(nkCommentStmt, info) + var recorded = newNodeI(nkReplayAction, info) recorded.add newStrNode("put", info) recorded.add newStrNode(key, info) recorded.add newStrNode(k, info) recorded.add copyTree(val) - c.graph.recordStmt(c.graph, c.module, recorded) + c.append(recorded) proc recordAdd*(c: PCtx; info: TLineInfo; key: string; val: PNode) = - var recorded = newNodeI(nkCommentStmt, info) + var recorded = newNodeI(nkReplayAction, info) recorded.add newStrNode("add", info) recorded.add newStrNode(key, info) recorded.add copyTree(val) - c.graph.recordStmt(c.graph, c.module, recorded) + c.append(recorded) proc recordIncl*(c: PCtx; info: TLineInfo; key: string; val: PNode) = - var recorded = newNodeI(nkCommentStmt, info) + var recorded = newNodeI(nkReplayAction, info) recorded.add newStrNode("incl", info) recorded.add newStrNode(key, info) recorded.add copyTree(val) - c.graph.recordStmt(c.graph, c.module, recorded) - -when false: - proc genCall3(g: ModuleGraph; m: TMagic; s: string; a, b, c: PNode): PNode = - newTree(nkStaticStmt, newTree(nkCall, createMagic(g, s, m).newSymNode, a, b, c)) - - proc genCall2(g: ModuleGraph; m: TMagic; s: string; a, b: PNode): PNode = - newTree(nkStaticStmt, newTree(nkCall, createMagic(g, s, m).newSymNode, a, b)) - - template nodeFrom(s: string): PNode = - var res = newStrNode(s, info) - res.typ = getSysType(g, info, tyString) - res - - template nodeFrom(i: BiggestInt): PNode = - var res = newIntNode(i, info) - res.typ = getSysType(g, info, tyInt) - res - - template nodeFrom(n: PNode): PNode = copyTree(n) - - template record(call) = - g.recordStmt(g, c.module, call) - - proc recordInc*(c: PCtx; info: TLineInfo; key: string; by: BiggestInt) = - let g = c.graph - record genCall2(mNccInc, "inc", nodeFrom key, nodeFrom by) - - proc recordPut*(c: PCtx; info: TLineInfo; key: string; k: string; val: PNode) = - let g = c.graph - record genCall3(mNctPut, "[]=", nodeFrom key, nodeFrom k, nodeFrom val) - - proc recordAdd*(c: PCtx; info: TLineInfo; key: string; val: PNode) = - let g = c.graph - record genCall2(mNcsAdd, "add", nodeFrom key, nodeFrom val) - - proc recordIncl*(c: PCtx; info: TLineInfo; key: string; val: PNode) = - let g = c.graph - record genCall2(mNcsIncl, "incl", nodeFrom key, nodeFrom val) + c.append(recorded) diff --git a/compiler/magicsys.nim b/compiler/magicsys.nim index d40b9d732..1ec6b9a69 100644 --- a/compiler/magicsys.nim +++ b/compiler/magicsys.nim @@ -10,43 +10,37 @@ # Built-in types and compilerprocs are registered here. import - ast, astalgo, hashes, msgs, platform, nversion, times, idents, + ast, astalgo, msgs, platform, idents, modulegraphs, lineinfos export createMagic proc nilOrSysInt*(g: ModuleGraph): PType = g.sysTypes[tyInt] -proc registerSysType*(g: ModuleGraph; t: PType) = - if g.sysTypes[t.kind] == nil: g.sysTypes[t.kind] = t - proc newSysType(g: ModuleGraph; kind: TTypeKind, size: int): PType = - result = newType(kind, g.systemModule) + result = newType(kind, g.idgen, g.systemModule) result.size = size result.align = size.int16 proc getSysSym*(g: ModuleGraph; info: TLineInfo; name: string): PSym = - result = strTableGet(g.systemModule.tab, getIdent(g.cache, name)) + 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), g.systemModule, g.systemModule.info, {}) - result.typ = newType(tyError, 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 = - var ti: TIdentIter + result = nil let id = getIdent(g.cache, name) - var r = initIdentIter(ti, g.systemModule.tab, id) - while r != nil: + for r in systemModuleSyms(g, id): if r.magic == m: # prefer the tyInt variant: - if r.typ.sons[0] != nil and r.typ.sons[0].kind == tyInt: return r + if r.typ.returnType != nil and r.typ.returnType.kind == tyInt: return r result = r - r = nextIdentIter(ti, g.systemModule.tab) if result != nil: return result localError(g.config, info, "system module needs: " & name) - result = newSym(skError, id, g.systemModule, g.systemModule.info, {}) - result.typ = newType(tyError, 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 @@ -56,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") @@ -68,95 +63,58 @@ proc getSysType*(g: ModuleGraph; info: TLineInfo; kind: TTypeKind): PType = of tyUInt64: result = sysTypeFromName("uint64") of tyFloat: result = sysTypeFromName("float") of tyFloat32: result = sysTypeFromName("float32") - of tyFloat64: return sysTypeFromName("float64") + of tyFloat64: result = sysTypeFromName("float64") of tyFloat128: result = sysTypeFromName("float128") 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) g.sysTypes[kind] = result if result.kind != kind: - internalError(g.config, "wanted: " & $kind & " got: " & $result.kind) + if kind == tyFloat64 and result.kind == tyFloat: discard # because of aliasing + else: + internalError(g.config, "wanted: " & $kind & " got: " & $result.kind) if result == nil: internalError(g.config, "type not found: " & $kind) 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 - for i in low(g.intTypeCache)..high(g.intTypeCache): - g.intTypeCache[i] = nil - -proc getIntLitType*(g: ModuleGraph; literal: PNode): PType = - # we cache some common integer literal types for performance: - let value = literal.intVal - if value >= low(g.intTypeCache) and value <= high(g.intTypeCache): - result = g.intTypeCache[value.int] - if result == nil: - let ti = getSysType(g, literal.info, tyInt) - result = copyType(ti, ti.owner, false) - result.n = literal - g.intTypeCache[value.int] = result - else: - let ti = getSysType(g, literal.info, tyInt) - result = copyType(ti, ti.owner, false) - result.n = literal - proc getFloatLitType*(g: ModuleGraph; literal: PNode): PType = # for now we do not cache these: result = newSysType(g, tyFloat, size=8) result.n = literal -proc skipIntLit*(t: PType): PType {.inline.} = +proc skipIntLit*(t: PType; id: IdGenerator): PType {.inline.} = if t.n != nil and t.kind in {tyInt, tyFloat}: - result = copyType(t, t.owner, false) + result = copyType(t, id, t.owner) result.n = nil else: result = t -proc addSonSkipIntLit*(father, son: PType) = - if isNil(father.sons): father.sons = @[] - let s = son.skipIntLit - add(father.sons, s) +proc addSonSkipIntLit*(father, son: PType; id: IdGenerator) = + let s = son.skipIntLit(id) + father.add(s) propagateToOwner(father, s) -proc setIntLitType*(g: ModuleGraph; result: PNode) = - let i = result.intVal - case g.config.target.intSize - of 8: result.typ = getIntLitType(g, result) - of 4: - if i >= low(int32) and i <= high(int32): - result.typ = getIntLitType(g, result) - else: - result.typ = getSysType(g, result.info, tyInt64) - of 2: - if i >= low(int16) and i <= high(int16): - result.typ = getIntLitType(g, result) - elif i >= low(int32) and i <= high(int32): - result.typ = getSysType(g, result.info, tyInt32) - else: - result.typ = getSysType(g, result.info, tyInt64) - of 1: - # 8 bit CPUs are insane ... - if i >= low(int8) and i <= high(int8): - result.typ = getIntLitType(g, result) - elif i >= low(int16) and i <= high(int16): - result.typ = getSysType(g, result.info, tyInt16) - elif i >= low(int32) and i <= high(int32): - result.typ = getSysType(g, result.info, tyInt32) - else: - result.typ = getSysType(g, result.info, tyInt64) +proc makeVarType*(owner: PSym; baseType: PType; idgen: IdGenerator; kind = tyVar): PType = + if baseType.kind == kind: + result = baseType else: - internalError(g.config, result.info, "invalid int size") + 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) + if result == nil: + result = loadCompilerProc(g, name) proc registerCompilerProc*(g: ModuleGraph; s: PSym) = strTableAdd(g.compilerprocs, s) @@ -173,4 +131,39 @@ 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 + of tyInt, tyInt8, tyInt16, tyInt32, tyInt64, + tyUInt, tyUInt8, tyUInt16, tyUInt32, tyUInt64: + result = getSysMagic(g, info, "==", mEqI) + of tyEnum: + result = getSysMagic(g, info, "==", mEqEnum) + of tyBool: + result = getSysMagic(g, info, "==", mEqB) + of tyRef, tyPtr, tyPointer: + result = getSysMagic(g, info, "==", mEqRef) + of tyString: + result = getSysMagic(g, info, "==", mEqStr) + of tyChar: + result = getSysMagic(g, info, "==", mEqCh) + of tySet: + result = getSysMagic(g, info, "==", mEqSet) + 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 cd05ded62..4c52317cf 100644 --- a/compiler/main.nim +++ b/compiler/main.nim @@ -13,126 +13,189 @@ when not defined(nimcore): {.error: "nimcore MUST be defined for Nim's core tooling".} import - llstream, strutils, ast, astalgo, lexer, syntaxes, renderer, options, msgs, - os, condsyms, times, - wordrecg, sem, semdata, idents, passes, docgen, extccomp, - cgen, jsgen, json, nversion, - platform, nimconf, importer, passaux, depends, vm, vmdef, types, idgen, - docgen2, parser, modules, ccgutils, sigmatch, ropes, - modulegraphs, tables, rod, lineinfos - -from magicsys import resetSysTypes - -proc codegenPass(g: ModuleGraph) = - registerPass g, cgenPass - -proc semanticPasses(g: ModuleGraph) = - registerPass g, verbosePass - registerPass g, semPass - -proc writeDepsFile(g: ModuleGraph; project: string) = - let f = open(changeFileExt(project, "deps"), fmWrite) - for m in g.modules: - if m != nil: - f.writeLine(toFullPath(g.config, m.position.FileIndex)) + std/[strutils, os, times, tables, with, json], + llstream, ast, lexer, syntaxes, options, msgs, + condsyms, + idents, extccomp, + cgen, nversion, + platform, nimconf, depends, + modules, + modulegraphs, lineinfos, pathutils, vmprofiler + + +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] + +import ic / [cbackend, integrity, navigator, ic] + +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") + let f = open(fname.string, fmWrite) + for m in g.ifaces: + if m.module != nil: + f.writeLine(toFullPath(g.config, m.module.position.FileIndex)) for k in g.inclToMod.keys: if g.getModule(k).isNil: # don't repeat includes which are also modules 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, project) + writeDepsFile(graph) generateDot(graph, project) - execExternalProgram(graph.config, "dot -Tpng -o" & changeFileExt(project, "png") & - ' ' & changeFileExt(project, "dot")) + + # 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.errorMax = high(int) # do not stop after first error - defineSymbol(graph.config.symbols, "nimcheck") - semanticPasses(graph) # use an empty backend for semantic checking only - compileProject(graph) - -proc commandDoc2(graph: ModuleGraph; json: bool) = - graph.config.errorMax = high(int) # do not stop after first error - semanticPasses(graph) - if json: registerPass(graph, docgen2JsonPass) - else: registerPass(graph, docgen2Pass) - compileProject(graph) - finishDoc2Pass(graph.config.projectName) + 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; ext: string) = + handleDocOutputOptions graph.config + graph.config.setErrorMaxHighMaybe + 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 extccomp.initVars(conf) - semanticPasses(graph) - registerPass(graph, cgenPass) - - compileProject(graph) - cgenWriteModules(graph.backend, conf) - if conf.cmd != cmdRun: - let proj = changeFileExt(conf.projectFull, "") - extccomp.callCCompiler(conf, proj) - extccomp.writeJsonBuildInstructions(conf, proj) + if conf.symbolFiles == disabledSf: + if {optRun, optForceFullMake} * conf.globalOptions == {optRun} or isDefined(conf, "nimBetterRun"): + if not changeDetectedViaJsonBuildInstructions(conf, conf.jsonBuildInstructionsFile): + # nothing changed + graph.config.notes = graph.config.mainPackageNotes + return + + if not extccomp.ccHasSaneOverflow(conf): + conf.symbols.defineSymbol("nimEmulateOverflowChecks") + + if conf.symbolFiles == disabledSf: + setPipeLinePass(graph, 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: + cgenWriteModules(graph.backend, conf) + if conf.cmd != cmdTcc and graph.backend != nil: + 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, graph.cachedFiles) if optGenScript in graph.config.globalOptions: - writeDepsFile(graph, toGeneratedFile(conf, proj, "")) + 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) = - #incl(gGlobalOptions, optSafeCode) - setTarget(graph.config.target, osJS, cpuJS) - #initDefines() - defineSymbol(graph.config.symbols, "ecmascript") # For backward compatibility - defineSymbol(graph.config.symbols, "js") - semanticPasses(graph) - registerPass(graph, JSgenPass) - compileProject(graph) - -proc interactivePasses(graph: ModuleGraph) = + let conf = graph.config + when defined(leanCompiler): + globalError(conf, unknownLineInfo, "compiler wasn't built with JS code generator") + else: + conf.exc = excCpp + 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 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.errorMax = high(int) # do not stop after first error - 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) - processModule(graph, m, llStreamOpenStdIn()) - -const evalPasses = [verbosePass, semPass, evalPass] - -proc evalNim(graph: ModuleGraph; nodes: PNode, module: PSym) = - carryPasses(graph, nodes, module, evalPasses) - -proc commandEval(graph: ModuleGraph; exp: string) = - if graph.systemModule == nil: - interactivePasses(graph) - compileSystemModule(graph) - let echoExp = "echo \"eval\\t\", " & "repr(" & exp & ")" - evalNim(graph, echoExp.parseString(graph.cache, graph.config), - makeStdinModule(graph)) + var idgen = IdGenerator(module: m.itemId.module, symId: m.itemId.item, typeId: 0) + let s = llStreamOpenStdIn(onPrompt = proc() = flushDot(graph.config)) + discard processPipelineModule(graph, m, idgen, s) proc commandScan(cache: IdentCache, config: ConfigRef) = - var f = addFileExt(mainCommandArg(config), NimExt) + var f = addFileExt(AbsoluteFile mainCommandArg(config), NimExt) var stream = llStreamOpen(f, fmRead) if stream != nil: var - L: TLexer - tok: TToken - initToken(tok) + L: Lexer = default(Lexer) + tok: Token = default(Token) openLexer(L, f, stream, cache, config) while true: rawGetTok(L, tok) @@ -140,90 +203,160 @@ proc commandScan(cache: IdentCache, config: ConfigRef) = if tok.tokType == tkEof: break closeLexer(L) else: - rawMessage(config, errGenerated, "cannot open file: " & f) + rawMessage(config, errGenerated, "cannot open file: " & f.string) + +proc commandView(graph: ModuleGraph) = + let f = toAbsolute(mainCommandArg(graph.config), AbsoluteDir getCurrentDir()).addFileExt(RodExt) + rodViewer(f, graph.config, graph.cache) 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 - setupModuleCache(graph) - # In "nim serve" scenario, each command must reset the registered passes - clearPasses(graph) conf.lastCmdTime = epochTime() conf.searchPaths.add(conf.libpath) - setId(100) - case conf.command.normalize - of "c", "cc", "compile", "compiletoc": - # compile means compileToC currently - conf.cmd = cmdCompileToC - commandCompileToC(graph) - of "cpp", "compiletocpp": - conf.cmd = cmdCompileToCpp - defineSymbol(graph.config.symbols, "cpp") - commandCompileToC(graph) - of "objc", "compiletooc": - conf.cmd = cmdCompileToOC - defineSymbol(graph.config.symbols, "objc") - commandCompileToC(graph) - of "run": - conf.cmd = cmdRun + + proc customizeForBackend(backend: TBackend) = + ## Sets backend specific options but don't compile to backend yet in + ## case command doesn't require it. This must be called by all commands. + if conf.backend == backendInvalid: + # only set if wasn't already set, to allow override via `nim c -b:cpp` + conf.backend = backend + + defineSymbol(graph.config.symbols, $conf.backend) + case conf.backend + of backendC: + if conf.exc == excNone: conf.exc = excSetjmp + of backendCpp: + if conf.exc == excNone: conf.exc = excCpp + of backendObjc: discard + of backendJs: + if conf.hcrOn: + # XXX: At the moment, system.nim cannot be compiled in JS mode + # with "-d:useNimRtl". The HCR option has been processed earlier + # 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: 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: raiseAssert "unreachable" + + template docLikeCmd(body) = + when defined(leanCompiler): + conf.quitOrRaise "compiler wasn't built with documentation generator" + else: + wantMainModule(conf) + let docConf = if conf.cmd == cmdDoc2tex: DocTexConfig else: DocConfig + loadConfigs(docConf, cache, conf, graph.idgen) + defineSymbol(conf.symbols, "nimdoc") + body + + ## command prepass + if conf.cmd == cmdCrun: conf.globalOptions.incl {optRun, optUseNimcache} + if conf.cmd notin cmdBackends + {cmdTcc}: customizeForBackend(backendC) + if conf.outDir.isEmpty: + # doc like commands can generate a lot of files (especially with --project) + # so by default should not end up in $PWD nor in $projectPath. + var ret = if optUseNimcache in conf.globalOptions: getNimcacheDir(conf) + else: conf.projectPath + 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() + when BenchIC: + echoTimes graph.packed + of cmdTcc: when hasTinyCBackend: - extccomp.setCC("tcc") - commandCompileToC(graph) + extccomp.setCC(conf, "tcc", unknownLineInfo) + if conf.backend != backendC: + rawMessage(conf, errGenerated, "'run' requires c backend, got: '$1'" % $conf.backend) + compileToBackend() else: rawMessage(conf, errGenerated, "'run' command not available; rebuild with -d:tinyc") - of "js", "compiletojs": - conf.cmd = cmdCompileToJS - commandCompileToJS(graph) - of "doc0": - wantMainModule(conf) - conf.cmd = cmdDoc - loadConfigs(DocConfig, cache, conf) - commandDoc(cache, conf) - of "doc2", "doc": - conf.cmd = cmdDoc - loadConfigs(DocConfig, cache, conf) - defineSymbol(conf.symbols, "nimdoc") - commandDoc2(graph, false) - of "rst2html": - conf.cmd = cmdRst2html - loadConfigs(DocConfig, cache, conf) - commandRst2Html(cache, conf) - of "rst2tex": - conf.cmd = cmdRst2tex - loadConfigs(DocTexConfig, cache, conf) - commandRst2TeX(cache, conf) - of "jsondoc0": - wantMainModule(conf) - conf.cmd = cmdDoc - loadConfigs(DocConfig, cache, conf) - wantMainModule(conf) - defineSymbol(conf.symbols, "nimdoc") - commandJson(cache, conf) - of "jsondoc2", "jsondoc": - conf.cmd = cmdDoc - loadConfigs(DocConfig, cache, conf) - wantMainModule(conf) - defineSymbol(conf.symbols, "nimdoc") - commandDoc2(graph, true) - of "ctags": - wantMainModule(conf) - conf.cmd = cmdDoc - loadConfigs(DocConfig, cache, conf) - defineSymbol(conf.symbols, "nimdoc") - commandTags(cache, conf) - of "buildindex": - conf.cmd = cmdDoc - loadConfigs(DocConfig, cache, conf) - commandBuildIndex(cache, conf) - of "gendepend": - conf.cmd = cmdGenDepend - commandGenDepend(graph) - of "dump": - conf.cmd = cmdDump + of cmdDoc0: docLikeCmd commandDoc(cache, conf) + of cmdDoc: + docLikeCmd(): + 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, HtmlExt) + if optGenIndex in conf.globalOptions and optWholeProject in conf.globalOptions: + commandBuildIndex(conf, $conf.outDir) + of cmdRst2html, cmdMd2html: + # XXX: why are warnings disabled by default for rst2html and rst2tex? + for warn in rstWarnings: + conf.setNoteDefaults(warn, true) + conf.setNoteDefaults(warnRstRedefinitionOfLabel, false) # similar to issue #13218 + when defined(leanCompiler): + conf.quitOrRaise "compiler wasn't built with documentation generator" + else: + loadConfigs(DocConfig, cache, conf, graph.idgen) + commandRst2Html(cache, conf, preferMarkdown = (conf.cmd == cmdMd2html)) + of cmdRst2tex, cmdMd2tex, cmdDoc2tex: + for warn in rstWarnings: + conf.setNoteDefaults(warn, true) + when defined(leanCompiler): + conf.quitOrRaise "compiler wasn't built with documentation generator" + else: + 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, 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) + of cmdDump: if getConfigVar(conf, "dump.format") == "json": wantMainModule(conf) @@ -231,60 +364,72 @@ proc mainCommand*(graph: ModuleGraph) = for s in definedSymbolNames(conf.symbols): definedSymbols.elems.add(%s) var libpaths = newJArray() - for dir in conf.searchPaths: libpaths.elems.add(%dir) + var lazyPaths = newJArray() + for dir in conf.searchPaths: libpaths.elems.add(%dir.string) + for dir in conf.lazyPaths: lazyPaths.elems.add(%dir.string) + + var hints = newJObject() # consider factoring with `listHints` + for a in hintMin..hintMax: + hints[$a] = %(a in conf.notes) + var warnings = newJObject() + for a in warnMin..warnMax: + warnings[$a] = %(a in conf.notes) - var dumpdata = % [ + var dumpdata = %[ (key: "version", val: %VersionAsString), - (key: "project_path", val: %conf.projectFull), + (key: "nimExe", val: %(getAppFilename())), + (key: "prefixdir", val: %conf.getPrefixDir().string), + (key: "libpath", val: %conf.libpath.string), + (key: "project_path", val: %conf.projectFull.string), (key: "defined_symbols", val: definedSymbols), - (key: "lib_paths", val: libpaths) + (key: "lib_paths", val: %libpaths), + (key: "lazyPaths", val: %lazyPaths), + (key: "outdir", val: %conf.outDir.string), + (key: "out", val: %conf.outFile.string), + (key: "nimcache", val: %getNimcacheDir(conf).string), + (key: "hints", val: hints), + (key: "warnings", val: warnings), ] - msgWriteln(conf, $dumpdata, {msgStdout, msgSkipHook}) + 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) - of "check": - conf.cmd = cmdCheck + for it in conf.searchPaths: msgWriteln(conf, it.string) + of cmdCheck: + commandCheck(graph) + of cmdM: + graph.config.symbolFiles = v2Sf + setUseIc(graph.config.symbolFiles != disabledSf) commandCheck(graph) - of "parse": - conf.cmd = cmdParse + of cmdParse: wantMainModule(conf) discard parseFile(conf.projectMainIdx, cache, conf) - of "scan": - conf.cmd = cmdScan + of cmdRod: wantMainModule(conf) - commandScan(cache, conf) - msgWriteln(conf, "Beware: Indentation tokens depend on the parser's state!") - of "secret": - conf.cmd = cmdInteractive - commandInteractive(graph) - of "e": - commandEval(graph, mainCommandArg(conf)) - of "nop", "help": - # prevent the "success" message: - conf.cmd = cmdDump - of "jsonscript": - conf.cmd = cmdJsonScript + commandView(graph) + #msgWriteln(conf, "Beware: Indentation tokens depend on the parser's state!") + of cmdInteractive: commandInteractive(graph) + of cmdNimscript: + if conf.projectIsCmd or conf.projectIsStdin: discard + elif not fileExists(conf.projectFull): + rawMessage(conf, errGenerated, "NimScript file does not exist: " & conf.projectFull.string) + # main NimScript logic handled in `loadConfigs`. + of cmdNop: discard + of cmdJsonscript: + setOutFile(graph.config) commandJsonScript(graph) - else: + of cmdUnknown, cmdNone, cmdIdeTools: rawMessage(conf, errGenerated, "invalid command: " & conf.command) - if conf.errorCounter == 0 and - conf.cmd notin {cmdInterpret, cmdRun, cmdDump}: - when declared(system.getMaxMem): - let usedMem = formatSize(getMaxMem()) & " peakmem" - else: - let usedMem = formatSize(getTotalMem()) - rawMessage(conf, hintSuccessX, [$conf.linesCompiled, - formatFloat(epochTime() - conf.lastCmdTime, ffDecimal, 3), - usedMem, - if isDefined(conf, "release"): "Release Build" - else: "Debug Build"]) + if conf.errorCounter == 0 and conf.cmd notin {cmdTcc, cmdDump, cmdNop}: + if optProfileVM in conf.globalOptions: + echo conf.dump(conf.vmProfileData) + genSuccessX(conf) when PrintRopeCacheStats: echo "rope cache stats: " @@ -293,5 +438,3 @@ proc mainCommand*(graph: ModuleGraph) = echo " int tries: ", gCacheIntTries echo " efficiency: ", formatFloat(1-(gCacheMisses.float/gCacheTries.float), ffDecimal, 3) - - resetAttributes(conf) 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 334cd1ae6..77762d23a 100644 --- a/compiler/modulegraphs.nim +++ b/compiler/modulegraphs.nim @@ -9,32 +9,85 @@ ## This module implements the module graph data structure. The module graph ## represents a complete Nim project. Single modules can either be kept in RAM -## or stored in a Sqlite database. -## -## The caching of modules is critical for 'nimsuggest' and is tricky to get -## right. If module E is being edited, we need autocompletion (and type -## checking) for E but we don't want to recompile depending -## modules right away for faster turnaround times. Instead we mark the module's -## dependencies as 'dirty'. Let D be a dependency of E. If D is dirty, we -## need to recompile it and all of its dependencies that are marked as 'dirty'. -## 'nimsuggest sug' actually is invoked for the file being edited so we know -## its content changed and there is no need to compute any checksums. -## Instead of a recursive algorithm, we use an iterative algorithm: -## -## - If a module gets recompiled, its dependencies need to be updated. -## - Its dependent module stays the same. -## - -import ast, intsets, tables, options, lineinfos, hashes, idents, - incremental, btrees +## or stored in a rod-file. + +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 - ModuleGraph* = ref object - modules*: seq[PSym] ## indexed by int32 fileIdx + SigHash* = distinct MD5Digest + + LazySym* = object + id*: FullId + sym*: PSym + + Iface* = object ## data we don't want to store directly in the + ## ast.PSym type for s.kind == skModule + module*: PSym ## module this "Iface" belongs to + converters*: seq[LazySym] + patterns*: seq[LazySym] + pureEnums*: seq[LazySym] + interf: TStrTable + interfHidden: TStrTable + uniqueName*: Rope + + Operators* = object + opNot*, opContains*, opLe*, opLt*, opAnd*, opOr*, opIsNil*, opEq*: PSym + opAdd*, opSub*, opMul*, opDiv*, opLen*: PSym + + FullId* = object + module*: int + packed*: PackedItemId + + LazyType* = object + id*: FullId + typ*: PType + + LazyInstantiation* = object + module*: int + sym*: FullId + concreteTypes*: seq[FullId] + inst*: PInstantiation + + 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, 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 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 @@ -44,98 +97,571 @@ 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] - methods*: seq[tuple[methods: TSymSeq, dispatcher: PSym]] # needs serialization! + 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 exposed*: TStrTable - intTypeCache*: array[-5..64, PType] - opContains*, opNot*: PSym + packageTypes*: TStrTable emptyNode*: PNode - incr*: IncrementalCtx + canonTypes*: Table[SigHash, PType] + symBodyHashes*: Table[int, SigHash] # symId to digest mapping importModuleCallback*: proc (graph: ModuleGraph; m: PSym, fileIdx: FileIndex): PSym {.nimcall.} includeFileCallback*: proc (graph: ModuleGraph; m: PSym, fileIdx: FileIndex): PNode {.nimcall.} - recordStmt*: proc (graph: ModuleGraph; m: PSym; n: PNode) {.nimcall.} - cacheSeqs*: Table[string, PNode] # state that is shared to suppor the 'macrocache' API - cacheCounters*: Table[string, BiggestInt] - cacheTables*: Table[string, BTree[string, PNode]] + cacheSeqs*: Table[string, PNode] # state that is shared to support the 'macrocache' API; IC: implemented + 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.} + globalDestructors*: seq[PNode] + strongSemCheck*: proc (graph: ModuleGraph; owner: PSym; body: PNode) {.nimcall.} + compatibleProps*: proc (graph: ModuleGraph; formal, actual: PType): bool {.nimcall.} + idgen*: IdGenerator + operators*: Operators + + cachedFiles*: StringTableRef + + TPassContext* = object of RootObj # the pass's context + idgen*: IdGenerator + PPassContext* = ref TPassContext + + TPassOpen* = proc (graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext {.nimcall.} + TPassClose* = proc (graph: ModuleGraph; p: PPassContext, n: PNode): PNode {.nimcall.} + TPassProcess* = proc (p: PPassContext, topLevelStmt: PNode): PNode {.nimcall.} + + TPass* = tuple[open: TPassOpen, + process: TPassProcess, + close: TPassClose, + isFrontend: bool] + +proc resetForBackend*(g: ModuleGraph) = + g.compilerprocs = initStrTable() + g.typeInstCache.clear() + g.procInstCache.clear() + for a in mitems(g.attachedOps): + a.clear() + g.methodsPerGenericType.clear() + g.enumToStringProcs.clear() + g.dispatchers.setLen(0) + g.methodsPerType.clear() + +const + cb64 = [ + "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", + "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", + "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", + "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", + "0", "1", "2", "3", "4", "5", "6", "7", "8", "9a", + "9b", "9c"] + +proc toBase64a(s: cstring, len: int): string = + ## encodes `s` into base64 representation. + result = newStringOfCap(((len + 2) div 3) * 4) + result.add "__" + var i = 0 + while i < len - 2: + let a = ord(s[i]) + let b = ord(s[i+1]) + let c = ord(s[i+2]) + result.add cb64[a shr 2] + result.add cb64[((a and 3) shl 4) or ((b and 0xF0) shr 4)] + result.add cb64[((b and 0x0F) shl 2) or ((c and 0xC0) shr 6)] + result.add cb64[c and 0x3F] + inc(i, 3) + if i < len-1: + let a = ord(s[i]) + let b = ord(s[i+1]) + result.add cb64[a shr 2] + result.add cb64[((a and 3) shl 4) or ((b and 0xF0) shr 4)] + result.add cb64[((b and 0x0F) shl 2)] + elif i < len: + let a = ord(s[i]) + result.add cb64[a shr 2] + result.add cb64[(a and 3) shl 4] + +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.} = + isCachedModule(g, m.position) + +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) + +proc initEncoder*(g: ModuleGraph; module: PSym) = + let id = module.position + if id >= g.encoders.len: + setLen g.encoders, id+1 + ic.initEncoder(g.encoders[id], + g.packed[id].fromDisk, module, g.config, g.startupPackedConfig) + +type + ModuleIter* = object + fromRod: bool + 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, mi.importHidden) + else: + 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].interfSelect(mi.importHidden)) + +iterator allSyms*(g: ModuleGraph; m: PSym): PSym = + let importHidden = optImportHidden in m.options + if isCachedModule(g, m): + 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].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, importHidden) + else: + result = strTableGet(g.ifaces[m.position].interfSelect(importHidden), name) + +proc someSymAmb*(g: ModuleGraph; m: PSym; name: PIdent; amb: var bool): PSym = + let importHidden = optImportHidden in m.options + if isCachedModule(g, m): + result = nil + for s in interfaceSymbols(g.config, g.cache, g.packed, FileIndex(m.position), name, importHidden): + if result == nil: + # set result to the first symbol + result = s + else: + # another symbol found + amb = true + break + else: + var ti: TIdentIter = default(TIdentIter) + result = initIdentIter(ti, g.ifaces[m.position].interfSelect(importHidden), name) + if result != nil and nextIdentIter(ti, g.ifaces[m.position].interfSelect(importHidden)) != nil: + # another symbol exists with same name + amb = true + +proc systemModuleSym*(g: ModuleGraph; name: PIdent): PSym = + result = someSym(g, g.systemModule, name) + +iterator systemModuleSyms*(g: ModuleGraph; name: PIdent): PSym = + var mi: ModuleIter = default(ModuleIter) + var r = initModuleIter(mi, g, g.systemModule, name) + while r != nil: + yield r + r = nextModuleIter(mi, g) + +proc resolveType(g: ModuleGraph; t: var LazyType): PType = + result = t.typ + if result == nil and isCachedModule(g, t.id.module): + result = loadTypeFromId(g.config, g.cache, g.packed, t.id.module, t.id.packed) + t.typ = result + assert result != nil + +proc resolveSym(g: ModuleGraph; t: var LazySym): PSym = + result = t.sym + if result == nil and isCachedModule(g, t.id.module): + result = loadSymFromId(g.config, g.cache, g.packed, t.id.module, t.id.packed) + t.sym = result + assert result != nil + +proc resolveInst(g: ModuleGraph; t: var LazyInstantiation): PInstantiation = + result = t.inst + if result == nil and isCachedModule(g, t.module): + result = PInstantiation(sym: loadSymFromId(g.config, g.cache, g.packed, t.sym.module, t.sym.packed)) + result.concreteTypes = newSeq[PType](t.concreteTypes.len) + for i in 0..high(result.concreteTypes): + result.concreteTypes[i] = loadTypeFromId(g.config, g.cache, g.packed, + t.concreteTypes[i].module, t.concreteTypes[i].packed) + 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]) + for t in mitems(x[]): + yield resolveType(g, t) + +iterator procInstCacheItems*(g: ModuleGraph; s: PSym): PInstantiation = + if g.procInstCache.contains(s.itemId): + let x = addr(g.procInstCache[s.itemId]) + 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. + 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] = LazySym(sym: value) + +proc setAttachedOpPartial*(g: ModuleGraph; module: int; t: PType; op: TTypeAttachedOp; value: PSym) = + ## we also need to record this to the packed module. + g.attachedOps[op][t.itemId] = LazySym(sym: value) + +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]) + assert result != nil + +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.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.methodsPerGenericType.mgetOrPut(t.itemId, @[]).add (col, LazySym(sym: m)) + +proc hasDisabledAsgn*(g: ModuleGraph; t: PType): bool = + let op = getAttachedOp(g, t, attachedAsgn) + result = op != nil and sfError in op.flags + +proc copyTypeProps*(g: ModuleGraph; module: int; dest, src: PType) = + for k in low(TTypeAttachedOp)..high(TTypeAttachedOp): + let op = getAttachedOp(g, src, k) + if op != nil: + 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..<len(g.packed): + #if isCachedModule(g, module): + let x = searchForCompilerproc(g.packed[module], name) + if x >= 0: + result = loadSymFromId(g.config, g.cache, g.packed, module, toPackedItemId(x)) + if result != nil: + 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)) + +proc `==`*(a, b: SigHash): bool = + result = equalMem(unsafeAddr a, unsafeAddr b, sizeof(a)) + +proc hash*(u: SigHash): Hash = + result = 0 + for x in 0..3: + result = (result shl 8) or u.MD5Digest[x].int proc hash*(x: FileIndex): Hash {.borrow.} -{.this: g.} +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 + template onDefResolveForward*(info: TLineInfo; s: PSym) = discard proc stopCompile*(g: ModuleGraph): bool {.inline.} = - result = doStopCompile != nil and doStopCompile() + result = g.doStopCompile != nil and g.doStopCompile() -proc createMagic*(g: ModuleGraph; name: string, m: TMagic): PSym = - result = newSym(skProc, getIdent(g.cache, name), nil, unknownLineInfo(), {}) +proc createMagic*(g: ModuleGraph; idgen: IdGenerator; name: string, m: TMagic): PSym = + result = newSym(skProc, getIdent(g.cache, name), idgen, nil, unknownLineInfo, {}) result.magic = m + result.flags = {sfNeverRaises} -proc newModuleGraph*(cache: IdentCache; config: ConfigRef): ModuleGraph = - result = ModuleGraph() - initStrTable(result.packageSyms) +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 + + if m.position >= g.ifaces.len: + setLen(g.ifaces, m.position + 1) + + if m.position >= g.packed.len: + setLen(g.packed.pm, m.position + 1) + + g.ifaces[m.position] = Iface(module: m, converters: @[], patterns: @[], + uniqueName: rope(uniqueModuleName(g.config, m))) + initStrTables(g, m) + +proc registerModuleById*(g: ModuleGraph; m: FileIndex) = + registerModule(g, g.packed[int m].module) + +proc initOperators*(g: ModuleGraph): Operators = + # These are safe for IC. + # 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) + result.packageSyms = initStrTable() result.deps = initIntSet() - result.modules = @[] + 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) - result.opNot = createMagic(result, "not", mNot) - result.opContains = createMagic(result, "contains", mInSet) + result.compilerprocs = initStrTable() + result.exposed = initStrTable() + result.packageTypes = initStrTable() result.emptyNode = newNode(nkEmpty) - init(result.incr) - result.recordStmt = proc (graph: ModuleGraph; m: PSym; n: PNode) {.nimcall.} = - discard result.cacheSeqs = initTable[string, PNode]() result.cacheCounters = initTable[string, BiggestInt]() result.cacheTables = initTable[string, BTree[string, PNode]]() + result.canonTypes = initTable[SigHash, PType]() + 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(packageSyms) - deps = initIntSet() - modules = @[] - importStack = @[] - inclToMod = initTable[FileIndex, FileIndex]() - usageSym = nil - owners = @[] - methods = @[] - initStrTable(compilerprocs) - initStrTable(exposed) + g.packageSyms = initStrTable() + g.deps = initIntSet() + g.ifaces = @[] + g.importStack = @[] + g.inclToMod = initTable[FileIndex, FileIndex]() + g.usageSym = nil + g.owners = @[] + g.methods = @[] + g.compilerprocs = initStrTable() + g.exposed = initStrTable() + initModuleGraphFields(g) proc getModule*(g: ModuleGraph; fileIdx: FileIndex): PSym = - if fileIdx.int32 >= 0 and fileIdx.int32 < modules.len: - result = modules[fileIdx.int32] + 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}: + # For stress testing we seek to reload the symbols from memory. This + # way much of the logic is tested but the test is reproducible as it does + # not depend on the hard disk contents! + 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. + let mint = m.position + simulateCachedModule(g, m, g.packed[mint].fromDisk) + g.packed[mint].status = loaded proc dependsOn(a, b: int): int {.inline.} = (a shl 15) + b proc addDep*(g: ModuleGraph; m: PSym, dep: FileIndex) = assert m.position == m.info.fileIndex.int32 - addModuleDep(g.incr, g.config, m.info.fileIndex, dep, isIncludeFile = false) - if suggestMode: - deps.incl m.position.dependsOn(dep.int) - # we compute the transitive closure later when quering the graph lazily. + if g.suggestMode: + g.deps.incl m.position.dependsOn(dep.int) + # we compute the transitive closure later when querying the graph lazily. # this improves efficiency quite a lot: #invalidTransitiveClosure = true proc addIncludeDep*(g: ModuleGraph; module, includeFile: FileIndex) = - addModuleDep(g.incr, g.config, module, includeFile, isIncludeFile = true) - discard hasKeyOrPut(inclToMod, includeFile, module) + discard hasKeyOrPut(g.inclToMod, includeFile, module) proc parentModule*(g: ModuleGraph; fileIdx: FileIndex): FileIndex = ## returns 'fileIdx' if the file belonging to this index is ## directly used as a module or else the module that first ## references this include file. - if fileIdx.int32 >= 0 and fileIdx.int32 < modules.len and modules[fileIdx.int32] != nil: + if fileIdx.int32 >= 0 and fileIdx.int32 < g.ifaces.len and g.ifaces[fileIdx.int32].module != nil: result = fileIdx else: - result = inclToMod.getOrDefault(fileIdx) + result = g.inclToMod.getOrDefault(fileIdx) proc transitiveClosure(g: var IntSet; n: int) = # warshall's algorithm @@ -147,22 +673,107 @@ proc transitiveClosure(g: var IntSet; n: int) = g.incl i.dependsOn(j) proc markDirty*(g: ModuleGraph; fileIdx: FileIndex) = - let m = getModule fileIdx - if m != nil: incl m.flags, sfDirty + let m = g.getModule fileIdx + 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 # nimsuggest is done with this module, the module's dirty flag will be # cleared but D still needs to be remembered as 'dirty'. - if invalidTransitiveClosure: - invalidTransitiveClosure = false - transitiveClosure(deps, modules.len) + if g.invalidTransitiveClosure: + g.invalidTransitiveClosure = false + transitiveClosure(g.deps, g.ifaces.len) # every module that *depends* on this file is also dirty: - for i in 0i32..<modules.len.int32: - let m = modules[i] - if m != nil and deps.contains(i.dependsOn(fileIdx.int)): - incl m.flags, sfDirty + for i in 0i32..<g.ifaces.len.int32: + if g.deps.contains(i.dependsOn(fileIdx.int)): + g.markDirty(FileIndex(i)) -proc isDirty*(g: ModuleGraph; m: PSym): bool = - result = suggestMode and sfDirty in m.flags +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: + if sfDirty in m.flags: + return true + +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] + if result == nil and g.config.symbolFiles in {readOnlySf, v2Sf, stressTest}: + result = loadProcBody(g.config, g.cache, g.packed, s) + s.ast[bodyPos] = result + assert result != nil + +proc moduleFromRodFile*(g: ModuleGraph; fileIdx: FileIndex; + cachedModules: var seq[FileIndex]): PSym = + ## 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 87c7f3541..c9e6060e5 100644 --- a/compiler/modulepaths.nim +++ b/compiler/modulepaths.nim @@ -7,111 +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 -import nimblecmd - -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 - -const stdlibDirs = [ - "pure", "core", "arch", - "pure/collections", - "pure/concurrency", "impure", - "wrappers", "wrappers/linenoise", - "windows", "posix", "js"] - -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 = - result = resolveDollar(gProjectFull, info.toFullPath(), pkg, sub, info) - if result.isNil: result = "" - - 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 @@ -131,13 +30,6 @@ proc getModuleName*(conf: ConfigRef; n: PNode): string = of nkInfix: let n0 = n[0] let n1 = n[1] - if n0.kind == nkIdent and n0.ident.s == "as": - # XXX hack ahead: - n.kind = nkImportAs - n.sons[0] = n.sons[1] - n.sons[1] = n.sons[2] - n.sons.setLen(2) - return getModuleName(conf, n.sons[0]) when false: if n1.kind == nkPrefix and n1[0].kind == nkIdent and n1[0].ident.s == "$": if n0.kind == nkIdent and n0.ident.s == "/": @@ -146,30 +38,31 @@ proc getModuleName*(conf: ConfigRef; n: PNode): string = localError(n.info, "only '/' supported with $package notation") result = "" else: - let modname = getModuleName(conf, n[2]) - if $n1 == "std": - template attempt(a) = - let x = addFileExt(a, "nim") - if fileExists(x): return x - for candidate in stdlibDirs: - attempt(conf.libpath / candidate / modname) - - # hacky way to implement 'x / y /../ z': - result = getModuleName(conf, n1) - result.add renderTree(n0, {renderNoComments}) - 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.sons[0].kind == nkIdent and n.sons[0].ident.s == "$": + if n[0].kind == nkIdent and n[0].ident.s == "$": result = lookupPackage(n[1], nil) else: discard # hacky way to implement 'x / y /../ z': result = renderTree(n, {renderNoComments}).replace(" ") of nkDotExpr: + localError(conf, n.info, warnDeprecated, "using '.' instead of '/' in import paths is deprecated") result = renderTree(n, {renderNoComments}).replace(".", "/") of nkImportAs: - result = getModuleName(conf, n.sons[0]) + result = getModuleName(conf, n[0]) else: localError(conf, n.info, "invalid module name: '$1'" % n.renderTree) result = "" @@ -178,10 +71,25 @@ proc checkModuleName*(conf: ConfigRef; n: PNode; doLocalError=true): FileIndex = # This returns the full canonical path for a given module import let modulename = getModuleName(conf, n) let fullPath = findModule(conf, modulename, toFullPath(conf, n.info)) - if fullPath.len == 0: + if fullPath.isEmpty: if doLocalError: let m = if modulename.len > 0: modulename else: $n localError(conf, n.info, "cannot open file: " & m) - result = InvalidFileIDX + 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 b3a1e90d6..6e2af8bcc 100644 --- a/compiler/modules.nim +++ b/compiler/modules.nim @@ -10,121 +10,54 @@ ## Implements the module handling, including the caching of modules. import - ast, astalgo, magicsys, std / sha1, msgs, cgendata, sigmatch, options, - idents, os, lexer, idgen, passes, syntaxes, llstream, modulegraphs, rod, - lineinfos + ast, magicsys, msgs, options, + idents, lexer, syntaxes, modulegraphs, + lineinfos, pathutils + +import ../dist/checksums/src/checksums/sha1 +import std/strtabs proc resetSystemArtifacts*(g: ModuleGraph) = magicsys.resetSysTypes(g) -proc newModule(graph: ModuleGraph; fileIdx: FileIndex): PSym = - # 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. - new(result) - result.id = -1 # for better error checking - result.kind = skModule - let filename = toFullPath(graph.config, fileIdx) - result.name = getIdent(graph.cache, splitFile(filename).name) - if not isNimIdentifier(result.name.s): - rawMessage(graph.config, errGenerated, "invalid module name: " & result.name.s) - - result.info = newLineInfo(fileIdx, 1, 1) - let - pck = getPackageName(graph.config, filename) - pck2 = if pck.len > 0: pck else: "unknown" - pack = getIdent(graph.cache, pck2) - var packSym = graph.packageSyms.strTableGet(pack) - if packSym == nil: - packSym = newSym(skPackage, getIdent(graph.cache, pck2), nil, result.info) - initStrTable(packSym.tab) - graph.packageSyms.strTableAdd(packSym) +template getModuleIdent(graph: ModuleGraph, filename: AbsoluteFile): PIdent = + getIdent(graph.cache, splitFile(filename).name) +proc partialInitModule*(result: PSym; graph: ModuleGraph; fileIdx: FileIndex; filename: AbsoluteFile) = + let packSym = getPackage(graph, fileIdx) result.owner = packSym result.position = int fileIdx - if int(fileIdx) >= graph.modules.len: - setLen(graph.modules, int(fileIdx) + 1) - #growCache graph.modules, int fileIdx - graph.modules[result.position] = result - - incl(result.flags, sfUsed) - initStrTable(result.tab) - strTableAdd(result.tab, result) # a module knows itself - let existing = strTableGet(packSym.tab, result.name) - if existing != nil and existing.info.fileIndex != result.info.fileIndex: - localError(graph.config, result.info, - "module names need to be unique per Nimble package; module clashes with " & - toFullPath(graph.config, existing.info.fileIndex)) - # strTableIncl() for error corrections: - discard strTableIncl(packSym.tab, result) - -proc compileModule*(graph: ModuleGraph; fileIdx: FileIndex; flags: TSymFlags): PSym = - result = graph.getModule(fileIdx) - if result == nil: - result = newModule(graph, fileIdx) - result.flags = result.flags + flags - if sfMainModule in result.flags: - graph.config.mainPackageId = result.owner.id - - result.id = getModuleId(graph, fileIdx, toFullPath(graph.config, fileIdx)) - discard processModule(graph, result, - if sfMainModule in flags and graph.config.projectIsStdin: stdin.llStreamOpen else: nil) - elif graph.isDirty(result): - result.flags.excl sfDirty - # reset module fields: - initStrTable(result.tab) - result.ast = nil - discard processModule(graph, result, - if sfMainModule in flags and graph.config.projectIsStdin: stdin.llStreamOpen else: nil) - graph.markClientsDirty(fileIdx) - -proc importModule*(graph: ModuleGraph; s: PSym, fileIdx: FileIndex): PSym {.procvar.} = - # this is called by the semantic checking phase - assert graph.config != nil - result = compileModule(graph, fileIdx, {}) - graph.addDep(s, fileIdx) - #if sfSystemModule in result.flags: - # localError(result.info, errAttemptToRedefine, result.name.s) - # restore the notes for outer module: - graph.config.notes = - if s.owner.id == graph.config.mainPackageId: graph.config.mainPackageNotes - else: graph.config.foreignPackageNotes +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. + result = PSym(kind: skModule, itemId: ItemId(module: int32(fileIdx), item: 0'i32), + 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 & + "'; a module name must be a valid Nim identifier.") + partialInitModule(result, graph, fileIdx, filename) + graph.registerModule(result) -proc includeModule*(graph: ModuleGraph; s: PSym, fileIdx: FileIndex): PNode {.procvar.} = +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 / "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.len == 0: - fatal(conf, newLineInfo(conf, "command line", 1, 1), errGenerated, "command expects a filename") + if conf.projectFull.isEmpty: + 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) - let systemFileIdx = fileInfoIdx(conf, conf.libpath / "system.nim") - let projectFile = if projectFileIdx == InvalidFileIDX: conf.projectMainIdx else: projectFileIdx - 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) proc makeModule*(graph: ModuleGraph; filename: string): PSym = - result = graph.newModule(fileInfoIdx(graph.config, filename)) - result.id = getID() + result = makeModule(graph, AbsoluteFile filename) -proc makeStdinModule*(graph: ModuleGraph): PSym = graph.makeModule"stdin" +proc makeStdinModule*(graph: ModuleGraph): PSym = graph.makeModule(AbsoluteFile"stdin") diff --git a/compiler/msgs.nim b/compiler/msgs.nim index 62948e81e..c49ca8c9b 100644 --- a/compiler/msgs.nim +++ b/compiler/msgs.nim @@ -8,10 +8,36 @@ # import - options, strutils, os, tables, ropes, platform, terminal, macros, - lineinfos + std/[strutils, os, tables, terminal, macros, times], + std/private/miscdollars, + options, lineinfos, pathutils -proc toCChar*(c: char; result: var string) = +import ropes except `%` + +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] + + +type InstantiationInfo* = typeof(instantiationInfo()) +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`. + let stdOrr = if optStdout in conf.globalOptions: stdout else: stderr + let stdOrrKind = toStdOrrKind(stdOrr) + if stdOrrKind in conf.lastMsgWasDot: + conf.lastMsgWasDot.excl stdOrrKind + write(stdOrr, "\n") + +proc toCChar*(c: char; result: var string) {.inline.} = case c of '\0'..'\x1F', '\x7F'..'\xFF': result.add '\\' @@ -23,32 +49,28 @@ proc toCChar*(c: char; result: var string) = result.add c proc makeCString*(s: string): Rope = - const MaxLineLength = 64 - result = nil - var res = newStringOfCap(int(s.len.toFloat * 1.1) + 1) - add(res, "\"") - for i in countup(0, len(s) - 1): - if (i + 1) mod MaxLineLength == 0: - add(res, "\"\L\"") - toCChar(s[i], res) - add(res, '\"') - add(result, rope(res)) - - -proc newFileInfo(fullPath, projPath: string): TFileInfo = - result.fullPath = fullPath - #shallow(result.fullPath) - result.projPath = projPath - #shallow(result.projPath) - let fileName = projPath.extractFilename - result.shortName = fileName.changeFileExt("") - result.quotedName = fileName.makeCString - result.quotedFullName = fullPath.makeCString - result.lines = @[] + 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], result) + result.add('\"') + +proc newFileInfo(fullPath: AbsoluteFile, projPath: RelativeFile): TFileInfo = + result = TFileInfo(fullPath: fullPath, projPath: projPath, + shortName: fullPath.extractFilename, + quotedFullName: fullPath.string.makeCString, + lines: @[] + ) + result.quotedName = result.shortName.makeCString when defined(nimpretty): - if result.fullPath.len > 0: + if not result.fullPath.isEmpty: try: - result.fullContent = readFile(result.fullPath) + result.fullContent = readFile(result.fullPath.string) except IOError: #rawMessage(errCannotOpenFile, result.fullPath) # XXX fixme @@ -58,55 +80,76 @@ when defined(nimpretty): proc fileSection*(conf: ConfigRef; fid: FileIndex; a, b: int): string = substr(conf.m.fileInfos[fid.int].fullContent, a, b) -proc fileInfoKnown*(conf: ConfigRef; filename: string): bool = +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 + else: toLowerAscii(path) + +proc fileInfoKnown*(conf: ConfigRef; filename: AbsoluteFile): bool = var - canon: string + canon: AbsoluteFile try: canon = canonicalizePath(conf, filename) - except: + except OSError: canon = filename - result = conf.m.filenameToIndexTbl.hasKey(canon) + canon.string.canonicalCase + result = conf.m.filenameToIndexTbl.hasKey(canon.string) -proc fileInfoIdx*(conf: ConfigRef; filename: string; isKnownFile: var bool): FileIndex = +proc fileInfoIdx*(conf: ConfigRef; filename: AbsoluteFile; isKnownFile: var bool): FileIndex = var - canon: string + canon: AbsoluteFile pseudoPath = false try: canon = canonicalizePath(conf, filename) - shallow(canon) - except: + 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 - if conf.m.filenameToIndexTbl.hasKey(canon): - result = conf.m.filenameToIndexTbl[canon] + var canon2 = canon.string + canon2.canonicalCase + + if conf.m.filenameToIndexTbl.hasKey(canon2): + isKnownFile = true + result = conf.m.filenameToIndexTbl[canon2] else: isKnownFile = false result = conf.m.fileInfos.len.FileIndex - conf.m.fileInfos.add(newFileInfo(canon, if pseudoPath: filename - else: shortenDir(conf, canon))) - conf.m.filenameToIndexTbl[canon] = result + 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: string): FileIndex = - var dummy: bool +proc fileInfoIdx*(conf: ConfigRef; filename: AbsoluteFile): FileIndex = + 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.line = uint16(line) - result.col = int16(col) + result = TLineInfo(fileIndex: fileInfoIdx) + if line < int high(uint16): + result.line = uint16(line) + else: + result.line = high(uint16) + if col < int high(int16): + result.col = int16(col) + else: + result.col = -1 -proc newLineInfo*(conf: ConfigRef; filename: string, line, col: int): TLineInfo {.inline.} = +proc newLineInfo*(conf: ConfigRef; filename: AbsoluteFile, line, col: int): TLineInfo {.inline.} = result = newLineInfo(fileInfoIdx(conf, filename), line, col) -proc raiseRecoverableError*(msg: string) {.noinline, noreturn.} = - raise newException(ERecoverableError, msg) - +const gCmdLineInfo* = newLineInfo(commandLineIdx, 1, 1) -proc concat(strings: openarray[string]): string = +proc concat(strings: openArray[string]): string = var totalLen = 0 for s in strings: totalLen += s.len result = newStringOfCap totalLen @@ -129,7 +172,6 @@ proc suggestQuit*() = # this format is understood by many text editors: it is the same that # Borland and Freepascal use const - PosFormat = "$1($2, $3) " KindFormat = " [$1]" KindColor = fgCyan ErrorTitle = "Error: " @@ -138,45 +180,67 @@ const WarningColor = fgYellow HintTitle = "Hint: " HintColor = fgGreen + # NOTE: currently line info line numbers start with 1, + # but column numbers start with 0, however most editors expect + # first column to be 1, so we need to +1 here + ColOffset* = 1 + commandLineDesc* = "command line" proc getInfoContextLen*(conf: ConfigRef): int = return conf.m.msgContext.len proc setInfoContextLen*(conf: ConfigRef; L: int) = setLen(conf.m.msgContext, L) -proc pushInfoContext*(conf: ConfigRef; info: TLineInfo) = - conf.m.msgContext.add(info) +proc pushInfoContext*(conf: ConfigRef; info: TLineInfo; detail: string = "") = + conf.m.msgContext.add((info, detail)) proc popInfoContext*(conf: ConfigRef) = - setLen(conf.m.msgContext, len(conf.m.msgContext) - 1) + setLen(conf.m.msgContext, conf.m.msgContext.len - 1) proc getInfoContext*(conf: ConfigRef; index: int): TLineInfo = - let L = conf.m.msgContext.len - let i = if index < 0: L + index else: index - if i >=% L: result = unknownLineInfo() - else: result = conf.m.msgContext[i] + let i = if index < 0: conf.m.msgContext.len + index else: index + if i >=% conf.m.msgContext.len: result = unknownLineInfo + else: result = conf.m.msgContext[i].info template toFilename*(conf: ConfigRef; fileIdx: FileIndex): string = - (if fileIdx.int32 < 0: "???" else: conf.m.fileInfos[fileIdx.int32].projPath) + if fileIdx.int32 < 0 or conf == nil: + (if fileIdx == commandLineIdx: commandLineDesc else: "???") + else: + conf.m.fileInfos[fileIdx.int32].shortName + +proc toProjPath*(conf: ConfigRef; fileIdx: FileIndex): string = + if fileIdx.int32 < 0 or conf == nil: + (if fileIdx == commandLineIdx: commandLineDesc else: "???") + else: conf.m.fileInfos[fileIdx.int32].projPath.string proc toFullPath*(conf: ConfigRef; fileIdx: FileIndex): string = - if fileIdx.int32 < 0: result = "???" - else: result = conf.m.fileInfos[fileIdx.int32].fullPath + if fileIdx.int32 < 0 or conf == nil: + result = (if fileIdx == commandLineIdx: commandLineDesc else: "???") + else: + result = conf.m.fileInfos[fileIdx.int32].fullPath.string -proc setDirtyFile*(conf: ConfigRef; fileIdx: FileIndex; filename: string) = +proc setDirtyFile*(conf: ConfigRef; fileIdx: FileIndex; filename: AbsoluteFile) = assert fileIdx.int32 >= 0 conf.m.fileInfos[fileIdx.int32].dirtyFile = filename + setLen conf.m.fileInfos[fileIdx.int32].lines, 0 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): string = +proc toFullPathConsiderDirty*(conf: ConfigRef; fileIdx: FileIndex): AbsoluteFile = if fileIdx.int32 < 0: - result = "???" - elif not conf.m.fileInfos[fileIdx.int32].dirtyFile.isNil: + result = AbsoluteFile(if fileIdx == commandLineIdx: commandLineDesc else: "???") + elif not conf.m.fileInfos[fileIdx.int32].dirtyFile.isEmpty: result = conf.m.fileInfos[fileIdx.int32].dirtyFile else: result = conf.m.fileInfos[fileIdx.int32].fullPath @@ -184,16 +248,42 @@ proc toFullPathConsiderDirty*(conf: ConfigRef; fileIdx: FileIndex): string = template toFilename*(conf: ConfigRef; info: TLineInfo): string = toFilename(conf, info.fileIndex) +template toProjPath*(conf: ConfigRef; info: TLineInfo): string = + toProjPath(conf, info.fileIndex) + template toFullPath*(conf: ConfigRef; info: TLineInfo): string = toFullPath(conf, info.fileIndex) -proc toMsgFilename*(conf: ConfigRef; info: TLineInfo): string = - if info.fileIndex.int32 < 0: - result = "???" - elif optListFullPaths in conf.globalOptions: - result = conf.m.fileInfos[info.fileIndex.int32].fullPath - else: - result = conf.m.fileInfos[info.fileIndex.int32].projPath +template toFullPathConsiderDirty*(conf: ConfigRef; info: TLineInfo): string = + string toFullPathConsiderDirty(conf, info.fileIndex) + +proc toFilenameOption*(conf: ConfigRef, fileIdx: FileIndex, opt: FilenameOption): string = + case opt + of foAbs: result = toFullPath(conf, fileIdx) + of foRelProject: result = toProjPath(conf, fileIdx) + 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 (relPath.len > absPath.len) or (relPath.count("..") > 2): + absPath + else: + relPath + of foStacktrace: + if optExcessiveStackTrace in conf.globalOptions: + result = toFilenameOption(conf, fileIdx, foAbs) + else: + result = toFilenameOption(conf, fileIdx, foName) + +proc toMsgFilename*(conf: ConfigRef; fileIdx: FileIndex): string = + toFilenameOption(conf, fileIdx, conf.filenameOption) + +template toMsgFilename*(conf: ConfigRef; info: TLineInfo): string = + toMsgFilename(conf, info.fileIndex) proc toLinenumber*(info: TLineInfo): int {.inline.} = result = int info.line @@ -201,11 +291,13 @@ proc toLinenumber*(info: TLineInfo): int {.inline.} = proc toColumn*(info: TLineInfo): int {.inline.} = result = info.col -proc toFileLine*(conf: ConfigRef; info: TLineInfo): string {.inline.} = - result = toFilename(conf, info) & ":" & $info.line +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 = toFilename(conf, info) & "(" & $info.line & ", " & $info.col & ")" + result = "" + result.toLocation(toMsgFilename(conf, info), info.line.int, info.col.int + ColOffset) proc `$`*(conf: ConfigRef; info: TLineInfo): string = toFileLineCol(conf, info) @@ -219,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 = {}) = @@ -230,16 +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: - writeLine(stdout, s) + flushDot(conf) + write stdout, s + writeLine(stdout, sep) flushFile(stdout) else: if eStdErr in conf.m.errorOutputs: - writeLine(stderr, s) + flushDot(conf) + write stderr, s + writeLine(stderr, sep) # On Windows stderr is fully-buffered when piped, regardless of C std. when defined(windows): flushFile(stderr) @@ -267,66 +364,85 @@ macro callStyledWriteLineStderr(args: varargs[typed]): untyped = result.add(bindSym"stderr") for arg in children(args[0][1]): result.add(arg) + when false: + # not needed because styledWriteLine already ends with resetAttributes + result = newStmtList(result, newCall(bindSym"resetAttributes", bindSym"stderr")) template callWritelnHook(args: varargs[string, `$`]) = conf.writelnHook concat(args) -template styledMsgWriteln*(args: varargs[typed]) = +proc msgWrite(conf: ConfigRef; s: string) = + if conf.m.errorOutputs != {}: + let stdOrr = + if optStdout in conf.globalOptions: + stdout + else: + stderr + write(stdOrr, s) + flushFile(stdOrr) + conf.lastMsgWasDot.incl stdOrr.toStdOrrKind() # subsequent writes need `flushDot` + +template styledMsgWriteln(args: varargs[typed]) = if not isNil(conf.writelnHook): callIgnoringStyle(callWritelnHook, nil, args) elif optStdout in conf.globalOptions: if eStdOut in conf.m.errorOutputs: + flushDot(conf) callIgnoringStyle(writeLine, stdout, args) flushFile(stdout) - else: - if eStdErr in conf.m.errorOutputs: - if optUseColors in conf.globalOptions: - callStyledWriteLineStderr(args) - else: - callIgnoringStyle(writeLine, stderr, args) - # On Windows stderr is fully-buffered when piped, regardless of C std. - when defined(windows): - flushFile(stderr) - -proc coordToStr(coord: int): string = - if coord == -1: result = "???" - else: result = $coord + elif eStdErr in conf.m.errorOutputs: + flushDot(conf) + if optUseColors in conf.globalOptions: + callStyledWriteLineStderr(args) + else: + callIgnoringStyle(writeLine, stderr, args) + # On Windows stderr is fully-buffered when piped, regardless of C std. + when defined(windows): + flushFile(stderr) -proc msgKindToString*(kind: TMsgKind): string = +proc msgKindToString*(kind: TMsgKind): string = MsgKindToStr[kind] # later versions may provide translated error messages - result = MsgKindToStr[kind] -proc getMessageStr(msg: TMsgKind, arg: string): string = - result = msgKindToString(msg) % [arg] +proc getMessageStr(msg: TMsgKind, arg: string): string = msgKindToString(msg) % [arg] -type - TErrorHandling = enum doNothing, doAbort, doRaise +type TErrorHandling* = enum doNothing, doAbort, doRaise -proc log*(s: string) {.procvar.} = - var f: File +proc log*(s: string) = + var f: File = default(File) if open(f, getHomeDir() / "nimsuggest.log", fmAppend): f.writeLine(s) close(f) -proc quit(conf: ConfigRef; msg: TMsgKind) = - if defined(debug) or msg == errInternal or hintStackTrace in conf.notes: - if stackTraceAvailable() and isNil(conf.writelnHook): - writeStackTrace() - else: - styledMsgWriteln(fgRed, "No stack traceback available\n" & - "To create a stacktrace, rerun compilation with ./koch temp " & - conf.command & " <file>") +proc quit(conf: ConfigRef; msg: TMsgKind) {.gcsafe.} = + 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() + else: + 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.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 msg >= errMin and msg <= errMax: + if conf.cmd != cmdIdeTools or msg != errFatal: + quit(conf, msg) + if msg >= errMin and msg <= errMax or + (msg in warnMin..hintMax and msg in conf.warningAsErrors and not ignoreMsg): inc(conf.errorCounter) 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: @@ -340,220 +456,268 @@ proc exactEquals*(a, b: TLineInfo): bool = proc writeContext(conf: ConfigRef; lastinfo: TLineInfo) = const instantiationFrom = "template/generic instantiation from here" + const instantiationOfFrom = "template/generic instantiation of `$1` from here" var info = lastinfo - for i in 0 ..< len(conf.m.msgContext): - if conf.m.msgContext[i] != lastinfo and conf.m.msgContext[i] != info: + for i in 0..<conf.m.msgContext.len: + let context = conf.m.msgContext[i] + if context.info != lastinfo and context.info != info: if conf.structuredErrorHook != nil: - conf.structuredErrorHook(conf, conf.m.msgContext[i], instantiationFrom, - Severity.Error) + conf.structuredErrorHook(conf, context.info, instantiationFrom, + Severity.Hint) else: - styledMsgWriteln(styleBright, - PosFormat % [toMsgFilename(conf, conf.m.msgContext[i]), - coordToStr(conf.m.msgContext[i].line.int), - coordToStr(conf.m.msgContext[i].col+1)], - resetStyle, - instantiationFrom) - info = conf.m.msgContext[i] + let message = + if context.detail == "": + instantiationFrom + else: + instantiationOfFrom.format(context.detail) + styledMsgWriteln(styleBright, conf.toFileLineCol(context.info), " ", resetStyle, message) + info = context.info proc ignoreMsgBecauseOfIdeTools(conf: ConfigRef; msg: TMsgKind): bool = msg >= errGenerated and conf.cmd == cmdIdeTools and optIdeDebug notin conf.globalOptions -proc rawMessage*(conf: ConfigRef; msg: TMsgKind, args: openArray[string]) = - var - title: string - color: ForegroundColor - kind: string - sev: Severity - case msg - of errMin..errMax: - sev = Severity.Error - writeContext(conf, unknownLineInfo()) - title = ErrorTitle - color = ErrorColor - of warnMin..warnMax: - sev = Severity.Warning - if optWarns notin conf.options: return - if msg notin conf.notes: return - writeContext(conf, unknownLineInfo()) - title = WarningTitle - color = WarningColor - kind = WarningsToStr[ord(msg) - ord(warnMin)] - inc(conf.warnCounter) - of hintMin..hintMax: - sev = Severity.Hint - if optHints notin conf.options: return - if msg notin conf.notes: return - title = HintTitle - color = HintColor - if msg != hintUserRaw: kind = HintsToStr[ord(msg) - ord(hintMin)] - inc(conf.hintCounter) - let s = msgKindToString(msg) % args - - if conf.structuredErrorHook != nil: - conf.structuredErrorHook(conf, unknownLineInfo(), - s & (if kind != nil: KindFormat % kind else: ""), sev) - - if not ignoreMsgBecauseOfIdeTools(conf, msg): - if kind != nil: - styledMsgWriteln(color, title, resetStyle, s, - KindColor, `%`(KindFormat, kind)) - else: - styledMsgWriteln(color, title, resetStyle, s) - handleError(conf, msg, doAbort, s) - -proc rawMessage*(conf: ConfigRef; msg: TMsgKind, arg: string) = - rawMessage(conf, msg, [arg]) - -proc resetAttributes*(conf: ConfigRef) = - if {optUseColors, optStdout} * conf.globalOptions == {optUseColors}: - terminal.resetAttributes(stderr) - proc addSourceLine(conf: ConfigRef; fileIdx: FileIndex, line: string) = conf.m.fileInfos[fileIdx.int32].lines.add line -proc sourceLine*(conf: ConfigRef; i: TLineInfo): string = - if i.fileIndex.int32 < 0: return "" - - if not optPreserveOrigSource(conf) and conf.m.fileInfos[i.fileIndex.int32].lines.len == 0: +proc numLines*(conf: ConfigRef, fileIdx: FileIndex): int = + ## xxx there's an off by 1 error that should be fixed; if a file ends with "foo" or "foo\n" + ## it will return same number of lines (ie, a trailing empty line is discounted) + result = conf.m.fileInfos[fileIdx.int32].lines.len + if result == 0: try: - for line in lines(toFullPath(conf, i)): - addSourceLine conf, i.fileIndex, line.string + for line in lines(toFullPathConsiderDirty(conf, fileIdx).string): + addSourceLine conf, fileIdx, line except IOError: discard - assert i.fileIndex.int32 < conf.m.fileInfos.len + result = conf.m.fileInfos[fileIdx.int32].lines.len + +proc sourceLine*(conf: ConfigRef; i: TLineInfo): string = + ## 1-based index (matches editor line numbers); 1st line is for i.line = 1 + ## last valid line is `numLines` inclusive + if i.fileIndex.int32 < 0: return "" + let num = numLines(conf, i.fileIndex) # can happen if the error points to EOF: - if i.line.int > conf.m.fileInfos[i.fileIndex.int32].lines.len: return "" + if i.line.int > num: return "" 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)) - 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 of warnMin..warnMax: WarningTitle of hintMin..hintMax: HintTitle else: ErrorTitle - result = PosFormat % [toMsgFilename(conf, info), coordToStr(info.line.int), - coordToStr(info.col+1)] & - title & - getMessageStr(msg, arg) + conf.toFileLineCol(info) & " " & title & getMessageStr(msg, arg) -proc liMessage(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg: string, - eh: TErrorHandling) = +proc liMessage*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg: string, + eh: TErrorHandling, info2: InstantiationInfo, isRaw = false, + ignoreError = false) {.gcsafe, noinline.} = var title: string color: ForegroundColor - kind: string ignoreMsg = false sev: Severity + let errorOutputsOld = conf.m.errorOutputs + if msg in fatalMsgs: + # don't gag, refs bug #7080, bug #18278; this can happen with `{.fatal.}` + # or inside a `tryConstExpr`. + conf.m.errorOutputs = {eStdOut, eStdErr} + + let kind = if msg in warnMin..hintMax and msg != hintUserRaw: $msg else: "" # xxx not sure why hintUserRaw is special case msg of errMin..errMax: sev = Severity.Error writeContext(conf, info) title = ErrorTitle color = ErrorColor - # we try to filter error messages so that not two error message - # in the same file and line are produced: - #ignoreMsg = lastError == info and eh != doAbort - conf.m.lastError = info + when false: + # we try to filter error messages so that not two error message + # in the same file and line are produced: + # xxx `lastError` is only used in this disabled code; but could be useful to revive + ignoreMsg = conf.m.lastError == info and info != unknownLineInfo and eh != doAbort + if info != unknownLineInfo: conf.m.lastError = info of warnMin..warnMax: sev = Severity.Warning - ignoreMsg = optWarns notin conf.options or msg notin conf.notes + ignoreMsg = not conf.hasWarn(msg) + if not ignoreMsg and msg in conf.warningAsErrors: + title = ErrorTitle + color = ErrorColor + else: + title = WarningTitle + color = WarningColor if not ignoreMsg: writeContext(conf, info) - title = WarningTitle - color = WarningColor - kind = WarningsToStr[ord(msg) - ord(warnMin)] inc(conf.warnCounter) of hintMin..hintMax: sev = Severity.Hint - ignoreMsg = optHints notin conf.options or msg notin conf.notes - title = HintTitle - color = HintColor - if msg != hintUserRaw: kind = HintsToStr[ord(msg) - ord(hintMin)] + ignoreMsg = not conf.hasHint(msg) + if not ignoreMsg and msg in conf.warningAsErrors: + title = ErrorTitle + color = ErrorColor + else: + title = HintTitle + color = HintColor inc(conf.hintCounter) - # NOTE: currently line info line numbers start with 1, - # but column numbers start with 0, however most editors expect - # first column to be 1, so we need to +1 here - let x = PosFormat % [toMsgFilename(conf, info), coordToStr(info.line.int), - coordToStr(info.col+1)] - let s = getMessageStr(msg, arg) + let s = if isRaw: arg else: getMessageStr(msg, arg) if not ignoreMsg: + let loc = if info != unknownLineInfo: conf.toFileLineCol(info) & " " else: "" + # we could also show `conf.cmdInput` here for `projectIsCmd` + var kindmsg = if kind.len > 0: KindFormat % kind else: "" if conf.structuredErrorHook != nil: - conf.structuredErrorHook(conf, info, s & (if kind != nil: KindFormat % kind else: ""), sev) + conf.structuredErrorHook(conf, info, s & kindmsg, sev) if not ignoreMsgBecauseOfIdeTools(conf, msg): - if kind != nil: - styledMsgWriteln(styleBright, x, resetStyle, color, title, resetStyle, s, - KindColor, `%`(KindFormat, kind)) + if msg == hintProcessing and conf.hintProcessingDots: + msgWrite(conf, ".") else: - styledMsgWriteln(styleBright, x, resetStyle, color, title, resetStyle, s) - if hintSource in conf.notes: - conf.writeSurroundingSrc(info) - handleError(conf, msg, eh, s) - -proc 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} - liMessage(conf, info, msg, arg, doAbort) - -proc globalError*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg = "") = - liMessage(conf, info, msg, arg, doRaise) - -proc globalError*(conf: ConfigRef; info: TLineInfo, arg: string) = - liMessage(conf, info, errGenerated, arg, doRaise) - -proc localError*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg = "") = - liMessage(conf, info, msg, arg, doNothing) - -proc localError*(conf: ConfigRef; info: TLineInfo, arg: string) = - liMessage(conf, info, errGenerated, arg, doNothing) - -proc localError*(conf: ConfigRef; info: TLineInfo, format: string, params: openarray[string]) = - localError(conf, info, format % params) - -proc message*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg = "") = - liMessage(conf, info, msg, arg, doNothing) - -proc internalError*(conf: ConfigRef; info: TLineInfo, errMsg: string) = - if conf.cmd == cmdIdeTools and conf.structuredErrorHook.isNil: return + styledMsgWriteln(styleBright, loc, resetStyle, color, title, resetStyle, s, KindColor, kindmsg, + resetStyle, conf.getSurroundingSrc(info), conf.unitSep) + if hintMsgOrigin in conf.mainPackageNotes: + # xxx needs a bit of refactoring to honor `conf.filenameOption` + styledMsgWriteln(styleBright, toFileLineCol(info2), resetStyle, + " compiler msg initiated here", KindColor, + KindFormat % $hintMsgOrigin, + resetStyle, conf.unitSep) + 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 + liMessage(conf, unknownLineInfo, msg, arg, eh = doAbort, instLoc(), isRaw = true) + +template rawMessage*(conf: ConfigRef; msg: TMsgKind, arg: string) = + liMessage(conf, unknownLineInfo, msg, arg, eh = doAbort, instLoc()) + +template fatal*(conf: ConfigRef; info: TLineInfo, arg = "", msg = errFatal) = + liMessage(conf, info, msg, arg, doAbort, instLoc()) + +template globalAssert*(conf: ConfigRef; cond: untyped, info: TLineInfo = unknownLineInfo, arg = "") = + ## avoids boilerplate + if not cond: + var arg2 = "'$1' failed" % [astToStr(cond)] + if arg.len > 0: arg2.add "; " & astToStr(arg) & ": " & arg + liMessage(conf, info, errGenerated, arg2, doRaise, instLoc()) + +template globalError*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg = "") = + ## `local` means compilation keeps going until errorMax is reached (via `doNothing`), + ## `global` means it stops. + liMessage(conf, info, msg, arg, doRaise, instLoc()) + +template globalError*(conf: ConfigRef; info: TLineInfo, arg: string) = + liMessage(conf, info, errGenerated, arg, doRaise, instLoc()) + +template localError*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg = "") = + liMessage(conf, info, msg, arg, doNothing, instLoc()) + +template localError*(conf: ConfigRef; info: TLineInfo, arg: string) = + liMessage(conf, info, errGenerated, arg, doNothing, instLoc()) + +template message*(conf: ConfigRef; info: TLineInfo, msg: TMsgKind, arg = "") = + liMessage(conf, info, msg, arg, doNothing, instLoc()) + +proc warningDeprecated*(conf: ConfigRef, info: TLineInfo = gCmdLineInfo, msg = "") {.inline.} = + message(conf, info, warnDeprecated, msg) + +proc internalErrorImpl(conf: ConfigRef; info: TLineInfo, errMsg: string, info2: InstantiationInfo) = + if conf.cmd in {cmdIdeTools, cmdCheck} and conf.structuredErrorHook.isNil: return writeContext(conf, info) - liMessage(conf, info, errInternal, errMsg, doAbort) + liMessage(conf, info, errInternal, errMsg, doAbort, info2) -proc internalError*(conf: ConfigRef; errMsg: string) = - if conf.cmd == cmdIdeTools and conf.structuredErrorHook.isNil: return - writeContext(conf, unknownLineInfo()) - rawMessage(conf, errInternal, errMsg) +template internalError*(conf: ConfigRef; info: TLineInfo, errMsg: string) = + internalErrorImpl(conf, info, errMsg, instLoc()) -template assertNotNil*(conf: ConfigRef; e): untyped = - if e == nil: internalError(conf, $instantiationInfo()) - e +template internalError*(conf: ConfigRef; errMsg: string) = + internalErrorImpl(conf, unknownLineInfo, errMsg, instLoc()) template internalAssert*(conf: ConfigRef, e: bool) = - if not e: internalError(conf, $instantiationInfo()) + # xxx merge with `globalAssert` + if not e: + const info2 = instLoc() + let arg = info2.toFileLineCol + internalErrorImpl(conf, unknownLineInfo, arg, info2) + +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; fi: FileIndex): Rope = + if fi.int32 < 0: + result = makeCString "???" + elif optExcessiveStackTrace in conf.globalOptions: + result = conf.m.fileInfos[fi.int32].quotedFullName + else: + result = conf.m.fileInfos[fi.int32].quotedName proc quotedFilename*(conf: ConfigRef; i: TLineInfo): Rope = - assert i.fileIndex.int32 >= 0 - if optExcessiveStackTrace in conf.globalOptions: - result = conf.m.fileInfos[i.fileIndex.int32].quotedFullName + quotedFilename(conf, i.fileIndex) + +template listMsg(title, r) = + msgWriteln(conf, title, {msgNoUnitSep}) + for a in r: msgWriteln(conf, " [$1] $2" % [if a in conf.notes: "x" else: " ", $a], {msgNoUnitSep}) + +proc listWarnings*(conf: ConfigRef) = listMsg("Warnings:", warnMin..warnMax) +proc listHints*(conf: ConfigRef) = listMsg("Hints:", hintMin..hintMax) + +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: + 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: - result = conf.m.fileInfos[i.fileIndex.int32].quotedName - -proc listWarnings*(conf: ConfigRef) = - msgWriteln(conf, "Warnings:") - for warn in warnMin..warnMax: - msgWriteln(conf, " [$1] $2" % [ - if warn in conf.notes: "x" else: " ", - lineinfos.WarningsToStr[ord(warn) - ord(warnMin)] - ]) - -proc listHints*(conf: ConfigRef) = - msgWriteln(conf, "Hints:") - for hint in hintMin..hintMax: - msgWriteln(conf, " [$1] $2" % [ - if hint in conf.notes: "x" else: " ", - lineinfos.HintsToStr[ord(hint) - ord(hintMin)] + 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 9708c388d..cc18ab39f 100644 --- a/compiler/ndi.nim +++ b/compiler/ndi.nim @@ -10,31 +10,43 @@ ## This module implements the generation of ``.ndi`` files for better debugging ## support of Nim code. "ndi" stands for "Nim debug info". -import ast, msgs, ropes, options +import ast, msgs, ropes, options, pathutils + +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] type NdiFile* = object enabled: bool f: File buf: string + filename: AbsoluteFile + syms: seq[PSym] proc doWrite(f: var NdiFile; s: PSym; conf: ConfigRef) = f.buf.setLen 0 - f.buf.add s.info.line.int + f.buf.addInt s.info.line.int f.buf.add "\t" - f.buf.add s.info.col.int + 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) = - if f.enabled: doWrite(f, s, conf) + if f.enabled: f.syms.add s -proc open*(f: var NdiFile; filename: string; conf: ConfigRef) = - f.enabled = filename.len > 0 +proc open*(f: var NdiFile; filename: AbsoluteFile; conf: ConfigRef) = + f.enabled = not filename.isEmpty if f.enabled: - f.f = open(filename, fmWrite, 8000) + f.filename = filename f.buf = newStringOfCap(20) -proc close*(f: var NdiFile) = - if f.enabled: close(f.f) +proc close*(f: var NdiFile, conf: ConfigRef) = + if f.enabled: + f.f = open(f.filename.string, fmWrite, 8000) + doAssert f.f != nil, f.filename.string + for s in f.syms: + doWrite(f, s, conf) + close(f.f) + f.syms.reset + f.filename.reset diff --git a/compiler/nilcheck.nim b/compiler/nilcheck.nim new file mode 100644 index 000000000..7e0efc34b --- /dev/null +++ b/compiler/nilcheck.nim @@ -0,0 +1,1387 @@ +# +# +# The Nim Compiler +# (c) Copyright 2017 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +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 +# +# notes: +# +# Env: int => nilability +# a = b +# nilability a <- nilability b +# deref a +# if Nil error is nil +# if MaybeNil error might be nil, hint add if isNil +# if Safe fine +# fun(arg: A) +# nilability arg <- for ref MaybeNil, for not nil or others Safe +# map is env? +# a or b +# each one forks a different env +# result = union(envL, envR) +# a and b +# b forks a's env +# if a: code +# result = union(previousEnv after not a, env after code) +# if a: b else: c +# result = union(env after b, env after c) +# result = b +# nilability result <- nilability b, if return type is not nil and result not safe, error +# return b +# as result = b +# try: a except: b finally: c +# in b and c env is union of all possible try first n lines, after union of a and b and c +# keep in mind canRaise and finally +# case a: of b: c +# similar to if +# call(arg) +# if it returns ref, assume it's MaybeNil: hint that one can add not nil to the return type +# call(var arg) # zahary comment +# if arg is ref, assume it's MaybeNil after call +# loop +# union of env for 0, 1, 2 iterations as Herb Sutter's paper +# why 2? +# return +# if something: stop (break return etc) +# is equivalent to if something: .. else: remain +# new(ref) +# ref becomes Safe +# objConstr(a: b) +# returns safe +# each check returns its nilability and map + +type + SeqOfDistinct[T, U] = distinct seq[U] + +# TODO use distinct base type instead of int? +func `[]`[T, U](a: SeqOfDistinct[T, U], index: T): U = + (seq[U])(a)[index.int] + +proc `[]=`[T, U](a: var SeqOfDistinct[T, U], index: T, value: U) = + ((seq[U])(a))[index.int] = value + +func `[]`[T, U](a: var SeqOfDistinct[T, U], index: T): var U = + (seq[U])(a)[index.int] + +func len[T, U](a: SeqOfDistinct[T, U]): T = + (seq[U])(a).len.T + +func low[T, U](a: SeqOfDistinct[T, U]): T = + (seq[U])(a).low.T + +func high[T, U](a: SeqOfDistinct[T, U]): T = + (seq[U])(a).high.T + +proc setLen[T, U](a: var SeqOfDistinct[T, U], length: T) = + ((seq[U])(a)).setLen(length.Natural) + + +proc newSeqOfDistinct[T, U](length: T = 0.T): SeqOfDistinct[T, U] = + (SeqOfDistinct[T, U])(newSeq[U](length.int)) + +func newSeqOfDistinct[T, U](length: int = 0): SeqOfDistinct[T, U] = + # newSeqOfDistinct(length.T) + # ? newSeqOfDistinct[T, U](length.T) + (SeqOfDistinct[T, U])(newSeq[U](length)) + +iterator items[T, U](a: SeqOfDistinct[T, U]): U = + for element in (seq[U])(a): + yield element + +iterator pairs[T, U](a: SeqOfDistinct[T, U]): (T, U) = + for i, element in (seq[U])(a): + yield (i.T, element) + +func `$`[T, U](a: SeqOfDistinct[T, U]): string = + $((seq[U])(a)) + +proc add*[T, U](a: var SeqOfDistinct[T, U], value: U) = + ((seq[U])(a)).add(value) + +type + ## a hashed representation of a node: should be equal for structurally equal nodes + Symbol = distinct int + + ## the index of an expression in the pre-indexed sequence of those + ExprIndex = distinct int16 + + ## the set index + SetIndex = distinct int + + ## transition kind: + ## what was the reason for changing the nilability of an expression + ## useful for error messages and showing why an expression is being detected as nil / maybe nil + TransitionKind = enum TArg, TAssign, TType, TNil, TVarArg, TResult, TSafe, TPotentialAlias, TDependant + + ## keep history for each transition + History = object + info: TLineInfo ## the location + nilability: Nilability ## the nilability + kind: TransitionKind ## what kind of transition was that + node: PNode ## the node of the expression + + ## the context for the checker: an instance for each procedure + NilCheckerContext = ref object + # abstractTime: AbstractTime + # partitions: Partitions + # symbolGraphs: Table[Symbol, ] + symbolIndices: Table[Symbol, ExprIndex] ## index for each symbol + expressions: SeqOfDistinct[ExprIndex, PNode] ## a sequence of pre-indexed expressions + dependants: SeqOfDistinct[ExprIndex, IntSet] ## expr indices for expressions which are compound and based on others + warningLocations: HashSet[TLineInfo] ## warning locations to check we don't warn twice for stuff like warnings in for loops + idgen: IdGenerator ## id generator + config: ConfigRef ## the config of the compiler + + ## a map that is containing the current nilability for usually a branch + ## and is pointing optionally to a parent map: they make a stack of maps + NilMap = ref object + expressions: SeqOfDistinct[ExprIndex, Nilability] ## the expressions with the same order as in NilCheckerContext + history: SeqOfDistinct[ExprIndex, seq[History]] ## history for each of them + # what about gc and refs? + setIndices: SeqOfDistinct[ExprIndex, SetIndex] ## set indices for each expression + sets: SeqOfDistinct[SetIndex, IntSet] ## disjoint sets with the aliased expressions + parent: NilMap ## the parent map + + ## Nilability : if a value is nilable. + ## we have maybe nil and nil, so we can differentiate between + ## cases where we know for sure a value is nil and not + ## otherwise we can have Safe, MaybeNil + ## Parent: is because we just use a sequence with the same length + ## instead of a table, and we need to check if something was initialized + ## at all: if Parent is set, then you need to check the parent nilability + ## if the parent is nil, then for now we return MaybeNil + ## unreachable is the result of add(Safe, Nil) and others + ## it is a result of no states left, so it's usually e.g. in unreachable else branches? + Nilability* = enum Parent, Safe, MaybeNil, Nil, Unreachable + + ## check + Check = object + nilability: Nilability + map: NilMap + elements: seq[(PNode, Nilability)] + + +# useful to have known resultId so we can set it in the beginning and on return +const resultId: Symbol = (-1).Symbol +const resultExprIndex: ExprIndex = 0.ExprIndex +const noSymbol = (-2).Symbol + +func `<`*(a: ExprIndex, b: ExprIndex): bool = + a.int16 < b.int16 + +func `<=`*(a: ExprIndex, b: ExprIndex): bool = + a.int16 <= b.int16 + +func `>`*(a: ExprIndex, b: ExprIndex): bool = + a.int16 > b.int16 + +func `>=`*(a: ExprIndex, b: ExprIndex): bool = + a.int16 >= b.int16 + +func `==`*(a: ExprIndex, b: ExprIndex): bool = + a.int16 == b.int16 + +func `$`*(a: ExprIndex): string = + $(a.int16) + +func `+`*(a: ExprIndex, b: ExprIndex): ExprIndex = + (a.int16 + b.int16).ExprIndex + +# TODO overflowing / < 0? +func `-`*(a: ExprIndex, b: ExprIndex): ExprIndex = + (a.int16 - b.int16).ExprIndex + +func `$`*(a: SetIndex): string = + $(a.int) + +func `==`*(a: SetIndex, b: SetIndex): bool = + a.int == b.int + +func `+`*(a: SetIndex, b: SetIndex): SetIndex = + (a.int + b.int).SetIndex + +# TODO over / under limit? +func `-`*(a: SetIndex, b: SetIndex): SetIndex = + (a.int - b.int).SetIndex + +proc check(n: PNode, ctx: NilCheckerContext, map: NilMap): Check +proc checkCondition(n: PNode, ctx: NilCheckerContext, map: NilMap, reverse: bool, base: bool): NilMap + +# the NilMap structure + +proc newNilMap(parent: NilMap = nil, count: int = -1): NilMap = + var expressionsCount = 0 + if count != -1: + expressionsCount = count + elif not parent.isNil: + expressionsCount = parent.expressions.len.int + result = NilMap( + expressions: newSeqOfDistinct[ExprIndex, Nilability](expressionsCount), + history: newSeqOfDistinct[ExprIndex, seq[History]](expressionsCount), + setIndices: newSeqOfDistinct[ExprIndex, SetIndex](expressionsCount), + parent: parent) + if parent.isNil: + for i, expr in result.expressions: + result.setIndices[i] = i.SetIndex + var newSet = initIntSet() + newSet.incl(i.int) + result.sets.add(newSet) + else: + for i, exprs in parent.sets: + result.sets.add(exprs) + for i, index in parent.setIndices: + result.setIndices[i] = index + # result.sets = parent.sets + # if not parent.isNil: + # # optimize []? + # result.expressions = parent.expressions + # result.history = parent.history + # result.sets = parent.sets + # result.base = if parent.isNil: result else: parent.base + +proc `[]`(map: NilMap, index: ExprIndex): Nilability = + if index < 0.ExprIndex or index >= map.expressions.len: + return MaybeNil + var now = map + while not now.isNil: + if now.expressions[index] != Parent: + return now.expressions[index] + now = now.parent + return MaybeNil + +proc history(map: NilMap, index: ExprIndex): seq[History] = + if index < map.expressions.len: + map.history[index] + else: + @[] + + +# helpers for debugging + +# import macros + +# echo-s only when nilDebugInfo is defined +# macro aecho*(a: varargs[untyped]): untyped = +# var e = nnkCall.newTree(ident"echo") +# for b in a: +# e.add(b) +# result = quote: +# when defined(nilDebugInfo): +# `e` + +# end of helpers for debugging + + +proc symbol(n: PNode): Symbol +func `$`(map: NilMap): string +proc reverseDirect(map: NilMap): NilMap +proc checkBranch(n: PNode, ctx: NilCheckerContext, map: NilMap): Check +proc hasUnstructuredControlFlowJump(n: PNode): bool + +proc symbol(n: PNode): Symbol = + ## returns a Symbol for each expression + ## the goal is to get an unique Symbol + ## but we have to ensure hashTree does it as we expect + case n.kind: + of nkIdent: + # TODO ensure no idents get passed to symbol + result = noSymbol + of nkSym: + if n.sym.kind == skResult: # credit to disruptek for showing me that + result = resultId + else: + result = n.sym.id.Symbol + of nkHiddenAddr, nkAddr: + result = symbol(n[0]) + else: + result = hashTree(n).Symbol + # echo "symbol ", n, " ", n.kind, " ", result.int + +func `$`(map: NilMap): string = + result = "" + var now = map + var stack: seq[NilMap] = @[] + while not now.isNil: + stack.add(now) + now = now.parent + result.add("### start\n") + for i in 0 .. stack.len - 1: + now = stack[i] + result.add(" ###\n") + for index, value in now.expressions: + result.add(&" {index} {value}\n") + result.add "### end\n" + +proc namedMapDebugInfo(ctx: NilCheckerContext, map: NilMap): string = + result = "" + var now = map + var stack: seq[NilMap] = @[] + while not now.isNil: + stack.add(now) + now = now.parent + result.add("### start\n") + for i in 0 .. stack.len - 1: + now = stack[i] + result.add(" ###\n") + for index, value in now.expressions: + let name = ctx.expressions[index] + result.add(&" {name} {index} {value}\n") + result.add("### end\n") + +proc namedSetsDebugInfo(ctx: NilCheckerContext, map: NilMap): string = + result = "### sets " + for index, setIndex in map.setIndices: + var aliasSet = map.sets[setIndex] + result.add("{") + let expressions = aliasSet.mapIt($ctx.expressions[it.ExprIndex]) + result.add(join(expressions, ", ")) + result.add("} ") + result.add("\n") + +proc namedMapAndSetsDebugInfo(ctx: NilCheckerContext, map: NilMap): string = + result = namedMapDebugInfo(ctx, map) & namedSetsDebugInfo(ctx, map) + + + +const noExprIndex = (-1).ExprIndex +const noSetIndex = (-1).SetIndex + +proc `==`(a: Symbol, b: Symbol): bool = + a.int == b.int + +func `$`(a: Symbol): string = + $(a.int) + +template isConstBracket(n: PNode): bool = + n.kind == nkBracketExpr and n[1].kind in nkLiterals + +proc index(ctx: NilCheckerContext, n: PNode): ExprIndex = + # echo "n ", n, " ", n.kind + let a = symbol(n) + if ctx.symbolIndices.hasKey(a): + return ctx.symbolIndices[a] + else: + #for a, e in ctx.expressions: + # echo a, " ", e + #echo n.kind + # internalError(ctx.config, n.info, "expected " & $a & " " & $n & " to have a index") + return noExprIndex + # + #ctx.symbolIndices[symbol(n)] + + +proc aliasSet(ctx: NilCheckerContext, map: NilMap, n: PNode): IntSet = + result = map.sets[map.setIndices[ctx.index(n)]] + +proc aliasSet(ctx: NilCheckerContext, map: NilMap, index: ExprIndex): IntSet = + result = map.sets[map.setIndices[index]] + + + +proc store(map: NilMap, ctx: NilCheckerContext, index: ExprIndex, value: Nilability, kind: TransitionKind, info: TLineInfo, node: PNode = nil) = + if index == noExprIndex: + return + map.expressions[index] = value + map.history[index].add(History(info: info, kind: kind, node: node, nilability: value)) + #echo node, " ", index, " ", value + #echo ctx.namedMapAndSetsDebugInfo(map) + #for a, b in map.sets: + # echo a, " ", b + # echo map + + var exprAliases = aliasSet(ctx, map, index) + for a in exprAliases: + if a.ExprIndex != index: + #echo "alias ", a, " ", index + map.expressions[a.ExprIndex] = value + if value == Safe: + map.history[a.ExprIndex] = @[] + else: + map.history[a.ExprIndex].add(History(info: info, kind: TPotentialAlias, node: node, nilability: value)) + +proc moveOut(ctx: NilCheckerContext, map: NilMap, target: PNode) = + #echo "move out ", target + var targetIndex = ctx.index(target) + var targetSetIndex = map.setIndices[targetIndex] + if targetSetIndex != noSetIndex: + var targetSet = map.sets[targetSetIndex] + if targetSet.len > 1: + var other: ExprIndex = default(ExprIndex) + + for element in targetSet: + if element.ExprIndex != targetIndex: + other = element.ExprIndex + break + # map.sets[element].excl(targetIndex) + map.sets[map.setIndices[other]].excl(targetIndex.int) + var newSet = initIntSet() + newSet.incl(targetIndex.int) + map.sets.add(newSet) + map.setIndices[targetIndex] = map.sets.len - 1.SetIndex + +proc moveOutDependants(ctx: NilCheckerContext, map: NilMap, node: PNode) = + let index = ctx.index(node) + for dependant in ctx.dependants[index]: + moveOut(ctx, map, ctx.expressions[dependant.ExprIndex]) + +proc storeDependants(ctx: NilCheckerContext, map: NilMap, node: PNode, value: Nilability) = + let index = ctx.index(node) + for dependant in ctx.dependants[index]: + map.store(ctx, dependant.ExprIndex, value, TDependant, node.info, node) + +proc move(ctx: NilCheckerContext, map: NilMap, target: PNode, assigned: PNode) = + #echo "move ", target, " ", assigned + var targetIndex = ctx.index(target) + var assignedIndex: ExprIndex + var targetSetIndex = map.setIndices[targetIndex] + var assignedSetIndex: SetIndex + if assigned.kind == nkSym: + assignedIndex = ctx.index(assigned) + assignedSetIndex = map.setIndices[assignedIndex] + else: + assignedIndex = noExprIndex + assignedSetIndex = noSetIndex + if assignedIndex == noExprIndex: + moveOut(ctx, map, target) + elif targetSetIndex != assignedSetIndex: + map.sets[targetSetIndex].excl(targetIndex.int) + map.sets[assignedSetIndex].incl(targetIndex.int) + map.setIndices[targetIndex] = assignedSetIndex + +# proc hasKey(map: NilMap, ): bool = +# var now = map +# result = false +# while not now.isNil: +# if now.locals.hasKey(graphIndex): +# return true +# now = now.previous + +iterator pairs(map: NilMap): (ExprIndex, Nilability) = + for index, value in map.expressions: + yield (index, map[index]) + +proc copyMap(map: NilMap): NilMap = + if map.isNil: + return nil + result = newNilMap(map.parent) # no need for copy? if we change only this + result.expressions = map.expressions + result.history = map.history + result.sets = map.sets + result.setIndices = map.setIndices + +using + n: PNode + conf: ConfigRef + ctx: NilCheckerContext + map: NilMap + +proc typeNilability(typ: PType): Nilability + +# maybe: if canRaise, return MaybeNil ? +# no, because the target might be safe already +# with or without an exception +proc checkCall(n, ctx, map): Check = + # checks each call + # special case for new(T) -> result is always Safe + # for the others it depends on the return type of the call + # check args and handle possible mutations + + var isNew = false + result = Check(map: map) + for i, child in n: + discard check(child, ctx, map) + + if i > 0: + # var args make a new map with MaybeNil for our node + # 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.elementType.kind == tyRef: + if not isNew: + result.map = newNilMap(map) + isNew = true + # result.map[$child] = MaybeNil + var arg = child + while arg.kind == nkHiddenAddr: + arg = arg[0] + let a = ctx.index(arg) + if a != noExprIndex: + moveOut(ctx, result.map, arg) + moveOutDependants(ctx, result.map, arg) + result.map.store(ctx, a, MaybeNil, TVarArg, n.info, arg) + storeDependants(ctx, result.map, arg, MaybeNil) + elif not child.typ.isNil and child.typ.kind == tyRef: + if child.kind in {nkSym, nkDotExpr} or isConstBracket(child): + let a = ctx.index(child) + if ctx.dependants[a].len > 0: + if not isNew: + result.map = newNilMap(map) + isNew = true + moveOutDependants(ctx, result.map, child) + storeDependants(ctx, result.map, child, MaybeNil) + + if n[0].kind == nkSym and n[0].sym.magic == mNew: + # new hidden deref? + var value = if n[1].kind == nkHiddenDeref: n[1][0] else: n[1] + let b = ctx.index(value) + result.map.store(ctx, b, Safe, TAssign, value.info, value) + result.nilability = Safe + else: + # echo "n ", n, " ", n.typ.isNil + if not n.typ.isNil: + result.nilability = typeNilability(n.typ) + else: + result.nilability = Safe + # echo result.map + +template event(b: History): string = + case b.kind: + of TArg: "param with nilable type" + of TNil: "it returns true for isNil" + of TAssign: "assigns a value which might be nil" + of TVarArg: "passes it as a var arg which might change to nil" + of TResult: "it is nil by default" + of TType: "it has ref type" + of TSafe: "it is safe here as it returns false for isNil" + of TPotentialAlias: "it might be changed directly or through an alias" + of TDependant: "it might be changed because its base might be changed" + +proc derefWarning(n, ctx, map; kind: Nilability) = + ## a warning for potentially unsafe dereference + if n.info in ctx.warningLocations: + return + ctx.warningLocations.incl(n.info) + var a: seq[History] = @[] + if n.kind == nkSym: + a = history(map, ctx.index(n)) + var res = "" + var issue = case kind: + of Nil: "it is nil" + of MaybeNil: "it might be nil" + of Unreachable: "it is unreachable" + else: "" + res.add("can't deref " & $n & ", " & issue) + if a.len > 0: + res.add("\n") + for b in a: + res.add(" " & event(b) & " on line " & $b.info.line & ":" & $b.info.col) + message(ctx.config, n.info, warnStrictNotNil, res) + +proc handleNilability(check: Check; n, ctx, map) = + ## handle the check: + ## register a warning(error?) for Nil/MaybeNil + case check.nilability: + of Nil: + derefWarning(n, ctx, map, Nil) + of MaybeNil: + derefWarning(n, ctx, map, MaybeNil) + of Unreachable: + derefWarning(n, ctx, map, Unreachable) + else: + when defined(nilDebugInfo): + message(ctx.config, n.info, hintUser, "can deref " & $n) + +proc checkDeref(n, ctx, map): Check = + ## check dereference: deref n should be ok only if n is Safe + result = check(n[0], ctx, map) + + handleNilability(result, n[0], ctx, map) + + +proc checkRefExpr(n, ctx; check: Check): Check = + ## check ref expressions: TODO not sure when this happens + result = check + if n.typ.kind != tyRef: + result.nilability = typeNilability(n.typ) + elif tfNotNil notin n.typ.flags: + # echo "ref key ", n, " ", n.kind + if n.kind in {nkSym, nkDotExpr} or isConstBracket(n): + let key = ctx.index(n) + result.nilability = result.map[key] + elif n.kind == nkBracketExpr: + # sometimes false positive + result.nilability = MaybeNil + else: + # sometimes maybe false positive + result.nilability = MaybeNil + +proc checkDotExpr(n, ctx, map): Check = + ## check dot expressions: make sure we can dereference the base + result = check(n[0], ctx, map) + result = checkRefExpr(n, ctx, result) + +proc checkBracketExpr(n, ctx, map): Check = + ## check bracket expressions: make sure we can dereference the base + result = check(n[0], ctx, map) + # if might be deref: [] == *(a + index) for cstring + handleNilability(result, n[0], ctx, map) + result = check(n[1], ctx, result.map) + result = checkRefExpr(n, ctx, result) + # echo n, " ", result.nilability + + +template union(l: Nilability, r: Nilability): Nilability = + ## unify two states + if l == r: + l + else: + MaybeNil + +template add(l: Nilability, r: Nilability): Nilability = + if l == r: # Safe Safe -> Safe etc + l + elif l == Parent: # Parent Safe -> Safe etc + r + elif r == Parent: # Safe Parent -> Safe etc + l + elif l == Unreachable or r == Unreachable: # Safe Unreachable -> Unreachable etc + Unreachable + elif l == MaybeNil: # Safe MaybeNil -> Safe etc + r + elif r == MaybeNil: # MaybeNil Nil -> Nil etc + l + else: # Safe Nil -> Unreachable etc + Unreachable + +proc findCommonParent(l: NilMap, r: NilMap): NilMap = + result = l.parent + while not result.isNil: + var rparent = r.parent + while not rparent.isNil: + if result == rparent: + return result + rparent = rparent.parent + result = result.parent + +proc union(ctx: NilCheckerContext, l: NilMap, r: NilMap): NilMap = + ## unify two maps from different branches + ## combine their locals + ## what if they are from different parts of the same tree + ## e.g. + ## a -> b -> c + ## -> b1 + ## common then? + ## + if l.isNil: + return r + elif r.isNil: + return l + + let common = findCommonParent(l, r) + result = newNilMap(common, ctx.expressions.len.int) + + for index, value in l: + let h = history(r, index) + let info = if h.len > 0: h[^1].info else: TLineInfo(line: 0) # assert h.len > 0 + # echo "history", name, value, r[name], h[^1].info.line + result.store(ctx, index, union(value, r[index]), TAssign, info) + +proc add(ctx: NilCheckerContext, l: NilMap, r: NilMap): NilMap = + #echo "add " + #echo namedMapDebugInfo(ctx, l) + #echo " : " + #echo namedMapDebugInfo(ctx, r) + if l.isNil: + return r + elif r.isNil: + return l + + let common = findCommonParent(l, r) + result = newNilMap(common, ctx.expressions.len.int) + + for index, value in l: + let h = history(r, index) + let info = if h.len > 0: h[^1].info else: TLineInfo(line: 0) + # TODO: refactor and also think: is TAssign a good one + result.store(ctx, index, add(value, r[index]), TAssign, info) + + #echo "result" + #echo namedMapDebugInfo(ctx, result) + #echo "" + #echo "" + + +proc checkAsgn(target: PNode, assigned: PNode; ctx, map): Check = + ## check assignment + ## update map based on `assigned` + if assigned.kind != nkEmpty: + result = check(assigned, ctx, map) + else: + result = Check(nilability: typeNilability(target.typ), map: map) + + # we need to visit and check those, but we don't use the result for now + # is it possible to somehow have another event happen here? + discard check(target, ctx, map) + + if result.map.isNil: + result.map = map + if target.kind in {nkSym, nkDotExpr} or isConstBracket(target): + let t = ctx.index(target) + move(ctx, map, target, assigned) + case assigned.kind: + of nkNilLit: + result.map.store(ctx, t, Nil, TAssign, target.info, target) + else: + result.map.store(ctx, t, result.nilability, TAssign, target.info, target) + moveOutDependants(ctx, map, target) + storeDependants(ctx, map, target, MaybeNil) + if assigned.kind in {nkObjConstr, nkTupleConstr}: + for (element, value) in result.elements: + var elementNode = nkDotExpr.newTree(nkHiddenDeref.newTree(target), element) + if symbol(elementNode) in ctx.symbolIndices: + var elementIndex = ctx.index(elementNode) + result.map.store(ctx, elementIndex, value, TAssign, target.info, elementNode) + + +proc checkReturn(n, ctx, map): Check = + ## check return + # return n same as result = n; return ? + result = check(n[0], ctx, map) + result.map.store(ctx, resultExprIndex, result.nilability, TAssign, n.info) + + +proc checkIf(n, ctx, map): Check = + ## check branches based on condition + result = default(Check) + var mapIf: NilMap = map + + # first visit the condition + + # the structure is not If(Elif(Elif, Else), Else) + # it is + # If(Elif, Elif, Else) + + var mapCondition = checkCondition(n.sons[0].sons[0], ctx, mapIf, false, true) + + # the state of the conditions: negating conditions before the current one + var layerHistory = newNilMap(mapIf) + # the state after branch effects + var afterLayer: NilMap = nil + # the result nilability for expressions + var nilability = Safe + + for branch in n.sons: + var branchConditionLayer = newNilMap(layerHistory) + var branchLayer: NilMap + var code: PNode + if branch.kind in {nkIfStmt, nkElifBranch}: + var mapCondition = checkCondition(branch[0], ctx, branchConditionLayer, false, true) + let reverseMapCondition = reverseDirect(mapCondition) + layerHistory = ctx.add(layerHistory, reverseMapCondition) + branchLayer = mapCondition + code = branch[1] + else: + branchLayer = layerHistory + code = branch + + let branchCheck = checkBranch(code, ctx, branchLayer) + # handles nil afterLayer -> returns branchCheck.map + afterLayer = ctx.union(afterLayer, branchCheck.map) + nilability = if n.kind == nkIfStmt: Safe else: union(nilability, branchCheck.nilability) + if n.sons.len > 1: + result.map = afterLayer + result.nilability = nilability + else: + if not hasUnstructuredControlFlowJump(n[0][1]): + # here it matters what happend inside, because + # we might continue in the parent branch after entering this one + # either we enter the branch, so we get mapIf and effect of branch -> afterLayer + # or we dont , so we get mapIf and (not condition) effect -> layerHistory + result.map = ctx.union(layerHistory, afterLayer) + result.nilability = Safe # no expr? + else: + # similar to else: because otherwise we are jumping out of + # the branch, so no union with the mapIf (we dont continue if the condition was true) + # here it also doesn't matter for the parent branch what happened in the branch, e.g. assigning to nil + # as if we continue there, we haven't entered the branch probably + # so we don't do an union with afterLayer + # layerHistory has the effect of mapIf and (not condition) + result.map = layerHistory + result.nilability = Safe + +proc checkFor(n, ctx, map): Check = + ## check for loops + ## try to repeat the unification of the code twice + ## to detect what can change after a several iterations + ## approach based on discussions with Zahary/Araq + ## similar approach used for other loops + var m = map.copyMap() + var map0 = map.copyMap() + #echo namedMapDebugInfo(ctx, map) + m = check(n.sons[2], ctx, map).map.copyMap() + if n[0].kind == nkSym: + m.store(ctx, ctx.index(n[0]), typeNilability(n[0].typ), TAssign, n[0].info) + # echo namedMapDebugInfo(ctx, map) + var check2 = check(n.sons[2], ctx, m) + var map2 = check2.map + + result = Check(map: ctx.union(map0, m)) + result.map = ctx.union(result.map, map2) + result.nilability = Safe + +# check: +# while code: +# code2 + +# if code: +# code2 +# if code: +# code2 + +# if code: +# code2 + +# check(code), check(code2 in code's map) + +proc checkWhile(n, ctx, map): Check = + ## check while loops + ## try to repeat the unification of the code twice + var m = checkCondition(n[0], ctx, map, false, false) + var map0 = map.copyMap() + m = check(n.sons[1], ctx, m).map + var map1 = m.copyMap() + var check2 = check(n.sons[1], ctx, m) + var map2 = check2.map + + result = Check(map: ctx.union(map0, map1)) + result.map = ctx.union(result.map, map2) + result.nilability = Safe + +proc checkInfix(n, ctx, map): Check = + ## check infix operators in condition + ## a and b : map is based on a; next b + ## 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 = 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) + case n[0].sym.magic: + of mOr: + result.map = ctx.union(mapL, mapR) + of mAnd: + result.map = checkCondition(n[1], ctx, map, false, false) + result.map = checkCondition(n[2], ctx, result.map, false, false) + of mEqRef: + if n[2].kind == nkIntLit: + if $n[2] == "true": + result.map = checkCondition(n[1], ctx, map, false, false) + elif $n[2] == "false": + result.map = checkCondition(n[1], ctx, map, true, false) + elif n[1].kind == nkIntLit: + if $n[1] == "true": + result.map = checkCondition(n[2], ctx, map, false, false) + elif $n[1] == "false": + result.map = checkCondition(n[2], ctx, map, true, false) + + if result.map.isNil: + result.map = map + else: + result.map = map + else: + result.map = map + result.nilability = Safe + +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 = 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) + +proc infix(ctx: NilCheckerContext, l: PNode, r: PNode, magic: TMagic): PNode = + var name = case magic: + of mEqRef: "==" + of mAnd: "and" + of mOr: "or" + else: "" + + var cache = newIdentCache() + 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, ctx.idgen, nil) + +proc prefixNot(ctx: NilCheckerContext, node: PNode): PNode = + var cache = newIdentCache() + 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, ctx.idgen, nil) + +proc infixEq(ctx: NilCheckerContext, l: PNode, r: PNode): PNode = + infix(ctx, l, r, mEqRef) + +proc infixOr(ctx: NilCheckerContext, l: PNode, r: PNode): PNode = + infix(ctx, l, r, mOr) + +proc checkCase(n, ctx, map): Check = + # case a: + # of b: c + # of b2: c2 + # is like + # if a == b: + # c + # elif a == b2: + # c2 + # also a == true is a , a == false is not a + let base = n[0] + result = Check(map: map.copyMap()) + result.nilability = Safe + var a: PNode = nil + for child in n: + case child.kind: + of nkOfBranch: + if child.len < 2: + # echo "case with of with < 2 ", n + continue # TODO why does this happen + let branchBase = child[0] # TODO a, b or a, b..c etc + let code = child[^1] + let test = infixEq(ctx, base, branchBase) + if a.isNil: + a = test + else: + a = infixOr(ctx, a, test) + let conditionMap = checkCondition(test, ctx, map.copyMap(), false, false) + let newCheck = checkBranch(code, ctx, conditionMap) + result.map = ctx.union(result.map, newCheck.map) + result.nilability = union(result.nilability, newCheck.nilability) + of nkElifBranch: + discard "TODO: maybe adapt to be similar to checkIf" + of nkElse: + let mapElse = checkCondition(prefixNot(ctx, a), ctx, map.copyMap(), false, false) + let newCheck = checkBranch(child[0], ctx, mapElse) + result.map = ctx.union(result.map, newCheck.map) + result.nilability = union(result.nilability, newCheck.nilability) + else: + discard + +# notes +# try: +# a +# b +# except: +# c +# finally: +# d +# +# if a doesnt raise, this is not an exit point: +# so find what raises and update the map with that +# (a, b); c; d +# if nothing raises, except shouldn't happen +# .. might be a false positive tho, if canRaise is not conservative? +# so don't visit it +# +# nested nodes can raise as well: I hope nim returns canRaise for +# their parents +# +# a lot of stuff can raise +proc checkTry(n, ctx, map): Check = + var newMap = map.copyMap() + var currentMap = map + # we don't analyze except if nothing canRaise in try + var canRaise = false + var hasFinally = false + # var tryNodes: seq[PNode] + # if n[0].kind == nkStmtList: + # tryNodes = toSeq(n[0]) + # else: + # tryNodes = @[n[0]] + # for i, child in tryNodes: + # let (childNilability, childMap) = check(child, conf, currentMap) + # echo childMap + # currentMap = childMap + # # TODO what about nested + # if child.canRaise: + # newMap = union(newMap, childMap) + # canRaise = true + # else: + # newMap = childMap + let tryCheck = check(n[0], ctx, currentMap) + newMap = ctx.union(currentMap, tryCheck.map) + canRaise = n[0].canRaise + + var afterTryMap = newMap + for a, branch in n: + if a > 0: + case branch.kind: + of nkFinally: + newMap = ctx.union(afterTryMap, newMap) + let childCheck = check(branch[0], ctx, newMap) + newMap = ctx.union(newMap, childCheck.map) + hasFinally = true + of nkExceptBranch: + if canRaise: + let childCheck = check(branch[^1], ctx, newMap) + newMap = ctx.union(newMap, childCheck.map) + else: + discard + if not hasFinally: + # we might have not hit the except branches + newMap = ctx.union(afterTryMap, newMap) + result = Check(nilability: Safe, map: newMap) + +proc hasUnstructuredControlFlowJump(n: PNode): bool = + ## if the node contains a direct stop + ## as a continue/break/raise/return: then it means + ## we should reverse some of the map in the code after the condition + ## similar to else + # echo "n ", n, " ", n.kind + case n.kind: + of nkStmtList: + for child in n: + if hasUnstructuredControlFlowJump(child): + return true + of nkReturnStmt, nkBreakStmt, nkContinueStmt, nkRaiseStmt: + return true + of nkIfStmt, nkIfExpr, nkElifExpr, nkElse: + return false + else: + discard + return false + +proc reverse(value: Nilability): Nilability = + case value: + of Nil: Safe + of MaybeNil: MaybeNil + of Safe: Nil + of Parent: Parent + of Unreachable: Unreachable + +proc reverse(kind: TransitionKind): TransitionKind = + case kind: + of TNil: TSafe + of TSafe: TNil + of TPotentialAlias: TPotentialAlias + else: + kind + # raise newException(ValueError, "expected TNil or TSafe") + +proc reverseDirect(map: NilMap): NilMap = + # we create a new layer + # reverse the values only in this layer: + # because conditions should've stored their changes there + # b: Safe (not b.isNil) + # b: Parent Parent + # b: Nil (b.isNil) + + # layer block + # [ Parent ] [ Parent ] + # if -> if state + # layer -> reverse + # older older0 new + # older new + # [ b Nil ] [ Parent ] + # elif + # [ b Nil, c Nil] [ Parent ] + # + + # if b.isNil: + # # [ b Safe] + # c = A() # Safe + # elif not b.isNil: + # # [ b Safe ] + [b Nil] MaybeNil Unreachable + # # Unreachable defer can't deref b, it is unreachable + # discard + # else: + # b + + +# if + + + + # if: we just pass the map with a new layer for its block + # elif: we just pass the original map but with a new layer is the reverse of the previous popped layer (?) + # elif: + # else: we just pass the original map but with a new layer which is initialized as the reverse of the + # top layer of else + # else: + # + # [ b MaybeNil ] [b Parent] [b Parent] [b Safe] [b Nil] [] + # Safe + # c == 1 + # b Parent + # c == 2 + # b Parent + # not b.isNil + # b Safe + # c == 3 + # b Nil + # (else) + # b Nil + + result = map.copyMap() + for index, value in result.expressions: + result.expressions[index] = reverse(value) + if result.history[index].len > 0: + result.history[index][^1].kind = reverse(result.history[index][^1].kind) + result.history[index][^1].nilability = result.expressions[index] + +proc checkCondition(n, ctx, map; reverse: bool, base: bool): NilMap = + ## check conditions : used for if, some infix operators + ## isNil(a) + ## it returns a new map: you need to reverse all the direct elements for else + + # echo "condition ", n, " ", n.kind + if n.kind == nkCall: + result = newNilMap(map) + for element in n: + if element.kind == nkHiddenDeref and n[0].kind == nkSym and n[0].sym.magic == mIsNil: + result = check(element[0], ctx, result).map + else: + result = check(element, ctx, result).map + + if n[0].kind == nkSym and n[0].sym.magic == mIsNil: + # isNil(arg) + var arg = n[1] + while arg.kind == nkHiddenDeref: + arg = arg[0] + if arg.kind in {nkSym, nkDotExpr} or isConstBracket(arg): + let a = ctx.index(arg) + result.store(ctx, a, if not reverse: Nil else: Safe, if not reverse: TNil else: TSafe, n.info, arg) + else: + discard + else: + discard + elif n.kind == nkPrefix and n[0].kind == nkSym and n[0].sym.magic == mNot: + result = checkCondition(n[1], ctx, map, not reverse, false) + elif n.kind == nkInfix: + result = newNilMap(map) + result = checkInfix(n, ctx, result).map + else: + result = check(n, ctx, map).map + result = newNilMap(map) + assert not result.isNil + assert not result.parent.isNil + +proc checkResult(n, ctx, map) = + let resultNilability = map[resultExprIndex] + case resultNilability: + of Nil: + message(ctx.config, n.info, warnStrictNotNil, "return value is nil") + of MaybeNil: + message(ctx.config, n.info, warnStrictNotNil, "return value might be nil") + of Unreachable: + message(ctx.config, n.info, warnStrictNotNil, "return value is unreachable") + of Safe, Parent: + discard + +proc checkBranch(n: PNode, ctx: NilCheckerContext, map: NilMap): Check = + result = check(n, ctx, map) + + +# Faith! + +proc check(n: PNode, ctx: NilCheckerContext, map: NilMap): Check = + assert not map.isNil + + # echo "check n ", n, " ", n.kind + # echo "map ", namedMapDebugInfo(ctx, map) + case n.kind: + of nkSym: + result = Check(nilability: map[ctx.index(n)], map: map) + of nkCallKinds: + if n.sons[0].kind == nkSym: + let callSym = n.sons[0].sym + case callSym.magic: + of mAnd, mOr: + result = checkInfix(n, ctx, map) + of mIsNil: + result = checkIsNil(n, ctx, map) + else: + result = checkCall(n, ctx, map) + else: + result = checkCall(n, ctx, map) + of nkHiddenStdConv, nkHiddenSubConv, nkConv, nkExprColonExpr, nkExprEqExpr, + nkCast: + result = check(n.sons[1], ctx, map) + of nkStmtList, nkStmtListExpr, nkChckRangeF, nkChckRange64, nkChckRange, + nkBracket, nkCurly, nkPar, nkTupleConstr, nkClosure, nkObjConstr, nkElse: + result = Check(map: map) + if n.kind in {nkObjConstr, nkTupleConstr}: + # TODO deeper nested elements? + # A(field: B()) # + # field: Safe -> + var elements: seq[(PNode, Nilability)] = @[] + for i, child in n: + result = check(child, ctx, result.map) + if i > 0: + if child.kind == nkExprColonExpr: + elements.add((child[0], result.nilability)) + result.elements = elements + result.nilability = Safe + else: + for child in n: + result = check(child, ctx, result.map) + + of nkDotExpr: + result = checkDotExpr(n, ctx, map) + of nkDerefExpr, nkHiddenDeref: + result = checkDeref(n, ctx, map) + of nkAddr, nkHiddenAddr: + result = check(n.sons[0], ctx, map) + of nkIfStmt, nkIfExpr: + result = checkIf(n, ctx, map) + of nkAsgn, nkFastAsgn, nkSinkAsgn: + result = checkAsgn(n[0], n[1], ctx, map) + of nkVarSection, nkLetSection: + result = Check(map: map) + for child in n: + result = checkAsgn(child[0].skipPragmaExpr, child[2], ctx, result.map) + of nkForStmt: + result = checkFor(n, ctx, map) + of nkCaseStmt: + result = checkCase(n, ctx, map) + of nkReturnStmt: + result = checkReturn(n, ctx, map) + of nkBracketExpr: + result = checkBracketExpr(n, ctx, map) + of nkTryStmt: + result = checkTry(n, ctx, map) + of nkWhileStmt: + result = checkWhile(n, ctx, map) + of 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: + + discard "don't follow this : same as varpartitions" + result = Check(nilability: Nil, map: map) + else: + + var elementMap = map.copyMap() + var elementCheck = Check(map: elementMap) + for element in n: + elementCheck = check(element, ctx, elementCheck.map) + + result = Check(nilability: Nil, map: elementCheck.map) + + + + +proc typeNilability(typ: PType): Nilability = + assert not typ.isNil + # echo "typeNilability ", $typ.flags, " ", $typ.kind + result = if tfNotNil in typ.flags: + Safe + elif typ.kind in {tyRef, tyCstring, tyPtr, tyPointer}: + # + # tyVar ? tyVarargs ? tySink ? tyLent ? + # TODO spec? tests? + MaybeNil + else: + Safe + # echo " result ", result + +proc preVisitNode(ctx: NilCheckerContext, node: PNode, conf: ConfigRef) = + # echo "visit node ", node + if node.kind in {nkSym, nkDotExpr} or isConstBracket(node): + let nodeSymbol = symbol(node) + if not ctx.symbolIndices.hasKey(nodeSymbol): + ctx.symbolIndices[nodeSymbol] = ctx.expressions.len + ctx.expressions.add(node) + if node.kind in {nkDotExpr, nkBracketExpr}: + if node.kind == nkDotExpr and (not node.typ.isNil and node.typ.kind == tyRef and tfNotNil notin node.typ.flags) or + node.kind == nkBracketExpr: + let index = ctx.symbolIndices[nodeSymbol] + var baseIndex = noExprIndex + # deref usually? + # ok, we hit another case + var base = if node[0].kind notin {nkSym, nkIdent}: node[0][0] else: node[0] + if base.kind != nkIdent: + let baseSymbol = symbol(base) + if not ctx.symbolIndices.hasKey(baseSymbol): + baseIndex = ctx.expressions.len # next visit should add it + else: + baseIndex = ctx.symbolIndices[baseSymbol] + if ctx.dependants.len <= baseIndex: + ctx.dependants.setLen(baseIndex + 1.ExprIndex) + ctx.dependants[baseIndex].incl(index.int) + case node.kind: + of nkSym, nkEmpty, nkNilLit, nkType, nkIdent, nkCharLit .. nkUInt64Lit, nkFloatLit .. nkFloat64Lit, nkStrLit .. nkTripleStrLit: + discard + of nkDotExpr: + # visit only the base + ctx.preVisitNode(node[0], conf) + else: + for element in node: + ctx.preVisitNode(element, conf) + +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 = initIntSet() # set[ExprIndex] + ctx.dependants = SeqOfDistinct[ExprIndex, IntSet](@[emptySet]) + for i, arg in s.typ.n.sons: + if i > 0: + if arg.kind != nkSym: + continue + let argSymbol = symbol(arg) + if not ctx.symbolIndices.hasKey(argSymbol): + ctx.symbolIndices[argSymbol] = ctx.expressions.len + ctx.expressions.add(arg) + ctx.preVisitNode(body, conf) + if ctx.dependants.len < ctx.expressions.len: + ctx.dependants.setLen(ctx.expressions.len) + # echo ctx.symbolIndices + # echo ctx.expressions + # echo ctx.dependants + +proc checkNil*(s: PSym; body: PNode; conf: ConfigRef, idgen: IdGenerator) = + let line = s.ast.info.line + let fileIndex = s.ast.info.fileIndex.int + var filename = conf.m.fileInfos[fileIndex].fullPath.string + + var context = NilCheckerContext(config: conf, idgen: idgen) + context.preVisit(s, body, conf) + var map = newNilMap(nil, context.symbolIndices.len) + + for i, child in s.typ.n.sons: + if i > 0: + if child.kind != nkSym: + continue + map.store(context, context.index(child), typeNilability(child.typ), TArg, child.info, child) + + 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 + + let res = check(body, context, map) + var canCheck = resultExprIndex in res.map.history.low .. res.map.history.high + if res.nilability == Safe and canCheck and res.map.history[resultExprIndex].len <= 1: + res.map.store(context, resultExprIndex, Safe, TAssign, s.ast.info) + else: + if res.nilability == Safe: + res.map.store(context, resultExprIndex, Safe, TAssign, s.ast.info) + + # TODO check for nilability result + # (ANotNil, BNotNil) : + # do we check on asgn nilability at all? + + 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 1bd3fbfd6..ce5a22ad2 100644 --- a/compiler/nim.cfg +++ b/compiler/nim.cfg @@ -1,12 +1,17 @@ # Special configuration file for the Nim project hint[XDeclaredButNotUsed]:off -path:"llvm" -path:"$projectPath/.." define:booting define:nimcore -#define:nimIncremental +define:nimPreviewFloatRoundtrip +define:nimPreviewSlimSystem +define:nimPreviewCstringConversion +define:nimPreviewProcConversion +define:nimPreviewRangeDefault +define:nimPreviewNonVarDestructor +threads:off + #import:"$projectpath/testability" @if windows: @@ -15,5 +20,44 @@ define:nimcore define:useStdoutAsStdmsg +@if nimHasStyleChecks: + styleCheck:error +@end + + #define:useNodeIds #gc:markAndSweep + +@if nimHasWarningObservableStores: + 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 90049bdfb..005f11a58 100644 --- a/compiler/nim.nim +++ b/compiler/nim.nim @@ -7,21 +7,29 @@ # 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(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(windows): + when defined(gcc): + when defined(x86): + {.link: "../icons/nim.res".} + else: + {.link: "../icons/nim_icon.o".} + + 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, lexer, condsyms, options, msgs, nversion, nimconf, ropes, - extccomp, strutils, os, osproc, platform, main, parseopt, - nodejs, scriptconfig, idents, modulegraphs, lineinfos + commands, options, msgs, extccomp, main, idents, lineinfos, cmdlinehelper, + pathutils, modulegraphs + +from std/browsers import openDefaultBrowser +from nodejs import findNodeJs when hasTinyCBackend: import tccgen @@ -30,101 +38,129 @@ when defined(profiler) or defined(memProfiler): {.hint: "Profiling support is turned on!".} import nimprof -proc prependCurDir(f: string): string = - when defined(unix): - if os.isAbsolute(f): result = f - else: result = "./" & f - else: - result = f +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 + + config.commandLine.setLen 0 + # bugfix: otherwise, config.commandLine ends up duplicated + while true: parseopt.next(p) case p.kind of cmdEnd: break - of cmdLongoption, cmdShortOption: - if p.key == " ": + of cmdLongOption, cmdShortOption: + config.commandLine.add " " + config.commandLine.addCmdPrefix p.kind + config.commandLine.add p.key.quoteShell # quoteShell to be future proof + if p.val.len > 0: + config.commandLine.add ':' + config.commandLine.add p.val.quoteShell + + if p.key == "": # `-` was passed to indicate main project is stdin p.key = "-" if processArgument(pass, p, argsCount, config): break else: processSwitch(pass, p, config) of cmdArgument: + config.commandLine.add " " + config.commandLine.add p.key.quoteShell if processArgument(pass, p, argsCount, config): break if pass == passCmd2: - if optRun notin config.globalOptions and config.arguments.len > 0 and config.command.normalize != "run": + if {optRun, optWasNimscript} * config.globalOptions == {} and + 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) = - condsyms.initDefines(conf.symbols) + let self = NimProg( + supportsStdinFile: true, + processCmdLine: processCmdLine + ) + self.initDefinesProg(conf, "nim_compiler") if paramCount() == 0: - writeCommandLineUsage(conf, conf.helpWritten) - else: - # Process command line arguments: - processCmdLine(passCmd1, "", conf) - if conf.projectName == "-": - conf.projectName = "stdinfile" - conf.projectFull = "stdinfile" - conf.projectPath = canonicalizePath(conf, getCurrentDir()) - conf.projectIsStdin = true - elif conf.projectName != "": - try: - conf.projectFull = canonicalizePath(conf, conf.projectName) - except OSError: - conf.projectFull = conf.projectName - let p = splitFile(conf.projectFull) - let dir = if p.dir.len > 0: p.dir else: getCurrentDir() - conf.projectPath = canonicalizePath(conf, dir) - conf.projectName = p.name + writeCommandLineUsage(conf) + 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()) + if conf.errorCounter != 0: return + when hasTinyCBackend: + if conf.cmd == cmdTcc: + tccgen.run(conf, conf.arguments) + if optRun in conf.globalOptions: + 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 + 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]) + openDefaultBrowser($output) else: - conf.projectPath = canonicalizePath(conf, getCurrentDir()) - loadConfigs(DefaultConfig, cache, conf) # load all config files - let scriptFile = conf.projectFull.changeFileExt("nims") - if fileExists(scriptFile): - runNimScript(cache, scriptFile, freshDefines=false, conf) - # 'nim foo.nims' means to just run the NimScript file and do nothing more: - if scriptFile == conf.projectFull: return - elif fileExists(conf.projectPath / "config.nims"): - # directory wide NimScript file - runNimScript(cache, conf.projectPath / "config.nims", freshDefines=false, conf) - # now process command line arguments again, because some options in the - # command line can overwite the config file's settings - extccomp.initVars(conf) - processCmdLine(passCmd2, "", conf) - if conf.command == "": - rawMessage(conf, errGenerated, "command missing") - mainCommand(newModuleGraph(cache, conf)) - if optHints in conf.options and hintGCStats in conf.notes: echo(GC_getStatistics()) - #echo(GC_getStatistics()) - if conf.errorCounter == 0: - when hasTinyCBackend: - if conf.cmd == cmdRun: - tccgen.run(conf.arguments) - if optRun in conf.globalOptions: - if conf.cmd == cmdCompileToJS: - var ex: string - if conf.outFile.len > 0: - ex = conf.outFile.prependCurDir.quoteShell - else: - ex = quoteShell( - completeCFilePath(conf, changeFileExt(conf.projectFull, "js").prependCurDir)) - execExternalProgram(conf, findNodeJs() & " " & ex & ' ' & conf.arguments) - else: - var binPath: string - if conf.outFile.len > 0: - # If the user specified an outFile path, use that directly. - binPath = conf.outFile.prependCurDir - else: - # Figure out ourselves a valid binary name. - binPath = changeFileExt(conf.projectFull, ExeExt).prependCurDir - var ex = quoteShell(binPath) - execExternalProgram(conf, ex & ' ' & conf.arguments) + # support as needed + rawMessage(conf, errGenerated, "'$1 cannot handle --run" % [$conf.cmd]) when declared(GC_setMaxPause): GC_setMaxPause 2_000 -when compileOption("gc", "v2") or compileOption("gc", "refc"): +when compileOption("gc", "refc"): # the new correct mark&sweet collector is too slow :-/ GC_disableMarkAndSweep() diff --git a/compiler/nimblecmd.nim b/compiler/nimblecmd.nim index 9a23535bf..a5324ea76 100644 --- a/compiler/nimblecmd.nim +++ b/compiler/nimblecmd.nim @@ -9,15 +9,22 @@ ## Implements some helper procs for Nimble (Nim's package manager) support. -import parseutils, strutils, strtabs, os, options, msgs, sequtils, - lineinfos +import options, msgs, lineinfos, pathutils -proc addPath*(conf: ConfigRef; path: string, info: TLineInfo) = +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): conf.searchPaths.insert(path, 0) 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": @@ -48,7 +60,7 @@ proc `<`*(ver: Version, ver2: Version): bool = # Handling for normal versions such as "0.1.0" or "1.0". var sVer = string(ver).split('.') var sVer2 = string(ver2).split('.') - for i in 0..max(sVer.len, sVer2.len)-1: + for i in 0..<max(sVer.len, sVer2.len): var sVerI = 0 if i < sVer.len: discard parseInt(sVer[i], sVerI) @@ -62,42 +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")`` - const specialSeparator = "-#" - var sepIdx = p.find(specialSeparator) - if sepIdx == -1: - sepIdx = p.rfind('-') + result = ("", "", "") - if sepIdx == -1: - result.name = p - return + const checksumSeparator = '-' + const versionSeparator = '-' + const specialVersionSepartator = "-#" + const separatorNotFound = -1 - for i in sepIdx..<p.len: - if p[i] in {DirSep, AltSep}: - 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() - result.name = p[0 .. sepIdx - 1] - result.version = p.substr(sepIdx + 1) + 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 -proc addPackage(conf: ConfigRef; packages: StringTableRef, p: string; info: TLineInfo) = - let (name, ver) = getPathVersion(p) + result.name = p[0..<versionSeparatorIndex] + +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) = @@ -112,12 +148,12 @@ proc addNimblePath(conf: ConfigRef; p: string, info: TLineInfo) = if not path.isAbsolute(): path = p / path - if not contains(conf.searchPaths, path): + if not contains(conf.searchPaths, AbsoluteDir path): message(conf, info, hintPath, path) - conf.lazyPaths.insert(path, 0) + 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): @@ -126,32 +162,10 @@ proc addPathRec(conf: ConfigRef; dir: string, info: TLineInfo) = for p in packages.chosen: addNimblePath(conf, p, info) -proc nimblePath*(conf: ConfigRef; path: string, info: TLineInfo) = - addPathRec(conf, path, info) - addNimblePath(conf, path, info) - -when isMainModule: - proc v(s: string): Version = s.newVersion - # #head is special in the sense that it's assumed to always be newest. - doAssert v"1.0" < v"#head" - doAssert v"1.0" < v"1.1" - doAssert v"1.0.1" < v"1.1" - doAssert v"1" < v"1.1" - doAssert v"#aaaqwe" < v"1.1" # We cannot assume that a branch is newer. - doAssert v"#a111" < v"#head" - - var rr = newStringTable() - addPackage rr, "irc-#a111" - addPackage rr, "irc-#head" - addPackage rr, "irc-0.1.0" - addPackage rr, "irc" - addPackage rr, "another" - addPackage rr, "another-0.1" - - addPackage rr, "ab-0.1.3" - addPackage rr, "ab-0.1" - addPackage rr, "justone" - - doAssert toSeq(rr.chosen) == - @["irc-#head", "another-0.1", "ab-0.1.3", "justone"] - +proc nimblePath*(conf: ConfigRef; path: AbsoluteDir, info: TLineInfo) = + addPathRec(conf, path.string, info) + addNimblePath(conf, path.string, info) + let i = conf.nimblePaths.find(path) + if i != -1: + conf.nimblePaths.delete(i) + conf.nimblePaths.insert(path, 0) diff --git a/compiler/nimconf.nim b/compiler/nimconf.nim index d3b4645dc..5417cd1e9 100644 --- a/compiler/nimconf.nim +++ b/compiler/nimconf.nim @@ -10,46 +10,51 @@ # This module handles the reading of the config file. import - llstream, nversion, commands, os, strutils, msgs, platform, condsyms, lexer, - options, idents, wordrecg, strtabs, lineinfos + 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 TLexer, tok: var TToken) = +proc ppGetTok(L: var Lexer, tok: var Token) = # simple filter rawGetTok(L, tok) while tok.tokType in {tkComment}: rawGetTok(L, tok) -proc parseExpr(L: var TLexer, tok: var TToken; config: ConfigRef): bool -proc parseAtom(L: var TLexer, tok: var TToken; config: ConfigRef): bool = +proc parseExpr(L: var Lexer, tok: var Token; config: ConfigRef): bool +proc parseAtom(L: var Lexer, tok: var Token; config: ConfigRef): bool = if tok.tokType == tkParLe: ppGetTok(L, tok) result = parseExpr(L, tok, config) if tok.tokType == tkParRi: ppGetTok(L, tok) else: lexMessage(L, errGenerated, "expected closing ')'") - elif tok.ident.id == ord(wNot): + elif tok.tokType == tkNot: ppGetTok(L, tok) result = not parseAtom(L, tok, config) else: result = isDefined(config, tok.ident.s) ppGetTok(L, tok) -proc parseAndExpr(L: var TLexer, tok: var TToken; config: ConfigRef): bool = +proc parseAndExpr(L: var Lexer, tok: var Token; config: ConfigRef): bool = result = parseAtom(L, tok, config) - while tok.ident.id == ord(wAnd): + while tok.tokType == tkAnd: ppGetTok(L, tok) # skip "and" var b = parseAtom(L, tok, config) result = result and b -proc parseExpr(L: var TLexer, tok: var TToken; config: ConfigRef): bool = +proc parseExpr(L: var Lexer, tok: var Token; config: ConfigRef): bool = result = parseAndExpr(L, tok, config) - while tok.ident.id == ord(wOr): + while tok.tokType == tkOr: ppGetTok(L, tok) # skip "or" var b = parseAndExpr(L, tok, config) result = result or b -proc evalppIf(L: var TLexer, tok: var TToken; config: ConfigRef): bool = +proc evalppIf(L: var Lexer, tok: var Token; config: ConfigRef): bool = ppGetTok(L, tok) # skip 'if' or 'elif' result = parseExpr(L, tok, config) if tok.tokType == tkColon: ppGetTok(L, tok) @@ -57,7 +62,7 @@ proc evalppIf(L: var TLexer, tok: var TToken; config: ConfigRef): bool = #var condStack: seq[bool] = @[] -proc doEnd(L: var TLexer, tok: var TToken; condStack: var seq[bool]) = +proc doEnd(L: var Lexer, tok: var Token; condStack: var seq[bool]) = if high(condStack) < 0: lexMessage(L, errGenerated, "expected @if") ppGetTok(L, tok) # skip 'end' setLen(condStack, high(condStack)) @@ -66,21 +71,21 @@ type TJumpDest = enum jdEndif, jdElseEndif -proc jumpToDirective(L: var TLexer, tok: var TToken, dest: TJumpDest; config: ConfigRef; +proc jumpToDirective(L: var Lexer, tok: var Token, dest: TJumpDest; config: ConfigRef; condStack: var seq[bool]) -proc doElse(L: var TLexer, tok: var TToken; config: ConfigRef; condStack: var seq[bool]) = +proc doElse(L: var Lexer, tok: var Token; config: ConfigRef; condStack: var seq[bool]) = if high(condStack) < 0: lexMessage(L, errGenerated, "expected @if") ppGetTok(L, tok) if tok.tokType == tkColon: ppGetTok(L, tok) if condStack[high(condStack)]: jumpToDirective(L, tok, jdEndif, config, condStack) -proc doElif(L: var TLexer, tok: var TToken; config: ConfigRef; condStack: var seq[bool]) = +proc doElif(L: var Lexer, tok: var Token; config: ConfigRef; condStack: var seq[bool]) = if high(condStack) < 0: lexMessage(L, errGenerated, "expected @if") var res = evalppIf(L, tok, config) if condStack[high(condStack)] or not res: jumpToDirective(L, tok, jdElseEndif, config, condStack) else: condStack[high(condStack)] = true -proc jumpToDirective(L: var TLexer, tok: var TToken, dest: TJumpDest; config: ConfigRef; +proc jumpToDirective(L: var Lexer, tok: var Token, dest: TJumpDest; config: ConfigRef; condStack: var seq[bool]) = var nestedIfs = 0 while true: @@ -110,11 +115,11 @@ proc jumpToDirective(L: var TLexer, tok: var TToken, dest: TJumpDest; config: Co else: ppGetTok(L, tok) -proc parseDirective(L: var TLexer, tok: var TToken; config: ConfigRef; condStack: var seq[bool]) = +proc parseDirective(L: var Lexer, tok: var Token; config: ConfigRef; condStack: var seq[bool]) = ppGetTok(L, tok) # skip @ case whichKeyword(tok.ident) of wIf: - setLen(condStack, len(condStack) + 1) + setLen(condStack, condStack.len + 1) let res = evalppIf(L, tok, config) condStack[high(condStack)] = res if not res: jumpToDirective(L, tok, jdElseEndif, config, condStack) @@ -123,137 +128,165 @@ proc parseDirective(L: var TLexer, tok: var TToken; config: ConfigRef; condStack of wEnd: doEnd(L, tok, condStack) of wWrite: ppGetTok(L, tok) - msgs.msgWriteln(config, strtabs.`%`(tokToStr(tok), config.configVars, + msgs.msgWriteln(config, strtabs.`%`($tok, config.configVars, {useEnvironment, useKey})) ppGetTok(L, tok) else: case tok.ident.s.normalize of "putenv": ppGetTok(L, tok) - var key = tokToStr(tok) + var key = $tok ppGetTok(L, tok) - os.putEnv(key, tokToStr(tok)) + os.putEnv(key, $tok) ppGetTok(L, tok) of "prependenv": ppGetTok(L, tok) - var key = tokToStr(tok) + var key = $tok ppGetTok(L, tok) - os.putEnv(key, tokToStr(tok) & os.getEnv(key)) + os.putEnv(key, $tok & os.getEnv(key)) ppGetTok(L, tok) of "appendenv": ppGetTok(L, tok) - var key = tokToStr(tok) + var key = $tok ppGetTok(L, tok) - os.putEnv(key, os.getEnv(key) & tokToStr(tok)) + os.putEnv(key, os.getEnv(key) & $tok) ppGetTok(L, tok) else: - lexMessage(L, errGenerated, "invalid directive: '$1'" % tokToStr(tok)) + lexMessage(L, errGenerated, "invalid directive: '$1'" % $tok) -proc confTok(L: var TLexer, tok: var TToken; config: ConfigRef; condStack: var seq[bool]) = +proc confTok(L: var Lexer, tok: var Token; config: ConfigRef; condStack: var seq[bool]) = ppGetTok(L, tok) while tok.ident != nil and tok.ident.s == "@": parseDirective(L, tok, config, condStack) # else: give the token to the parser -proc checkSymbol(L: TLexer, tok: TToken) = +proc checkSymbol(L: Lexer, tok: Token) = if tok.tokType notin {tkSymbol..tkInt64Lit, tkStrLit..tkTripleStrLit}: - lexMessage(L, errGenerated, "expected identifier, but got: " & tokToStr(tok)) + lexMessage(L, errGenerated, "expected identifier, but got: " & $tok) -proc parseAssignment(L: var TLexer, tok: var TToken; - config: ConfigRef; condStack: var seq[bool]) = - if tok.ident.s == "-" or tok.ident.s == "--": - confTok(L, tok, config, condStack) # skip unnecessary prefix +proc parseAssignment(L: var Lexer, tok: var Token; + 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 var info = getLineInfo(L, tok) # save for later in case of an error checkSymbol(L, tok) - var s = tokToStr(tok) + var s = $tok confTok(L, tok, config, condStack) # skip symbol var val = "" while tok.tokType == tkDot: - add(s, '.') + s.add('.') confTok(L, tok, config, condStack) checkSymbol(L, tok) - add(s, tokToStr(tok)) + s.add($tok) confTok(L, tok, config, condStack) if tok.tokType == tkBracketLe: # BUGFIX: val, not s! - # BUGFIX: do not copy '['! confTok(L, tok, config, condStack) checkSymbol(L, tok) - add(val, tokToStr(tok)) + val.add('[') + val.add($tok) confTok(L, tok, config, condStack) if tok.tokType == tkBracketRi: confTok(L, tok, config, condStack) else: lexMessage(L, errGenerated, "expected closing ']'") - add(val, ']') + val.add(']') let percent = tok.ident != nil and tok.ident.s == "%=" if tok.tokType in {tkColon, tkEquals} or percent: - if len(val) > 0: add(val, ':') + if val.len > 0: val.add(':') confTok(L, tok, config, condStack) # skip ':' or '=' or '%' checkSymbol(L, tok) - add(val, tokToStr(tok)) + val.add($tok) confTok(L, tok, config, condStack) # skip symbol + if tok.tokType in {tkColon, tkEquals}: + val.add($tok) # add the : + confTok(L, tok, config, condStack) # skip symbol + checkSymbol(L, tok) + val.add($tok) # add the token after it + confTok(L, tok, config, condStack) # skip symbol while tok.ident != nil and tok.ident.s == "&": confTok(L, tok, config, condStack) checkSymbol(L, tok) - add(val, tokToStr(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) else: processSwitch(s, val, passPP, info, config) -proc readConfigFile( - filename: string; cache: IdentCache; config: ConfigRef): bool = +proc readConfigFile*(filename: AbsoluteFile; cache: IdentCache; + config: ConfigRef): bool = var - L: TLexer - tok: TToken + 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) - if len(condStack) > 0: lexMessage(L, errGenerated, "expected @end") + 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: string): string = - result = joinPath(getConfigDir(), filename) +proc getUserConfigPath*(filename: RelativeFile): AbsoluteFile = + result = getConfigDir().AbsoluteDir / RelativeDir"nim" / filename -proc getSystemConfigPath(conf: ConfigRef; filename: string): string = +proc getSystemConfigPath*(conf: ConfigRef; filename: RelativeFile): AbsoluteFile = # try standard configuration file (installation did not distribute files # the UNIX way) let p = getPrefixDir(conf) - result = joinPath([p, "config", filename]) + result = p / RelativeDir"config" / filename when defined(unix): - if not existsFile(result): result = joinPath([p, "etc", filename]) - if not existsFile(result): result = "/etc/" & filename + if not fileExists(result): result = p / RelativeDir"etc/nim" / filename + if not fileExists(result): result = AbsoluteDir"/etc/nim" / filename -proc loadConfigs*(cfg: string; cache: IdentCache; conf: ConfigRef) = +proc loadConfigs*(cfg: RelativeFile; cache: IdentCache; conf: ConfigRef; idgen: IdGenerator) = setDefaultLibpath(conf) - - var configFiles = newSeq[string]() - - template readConfigFile(path: string) = + template readConfigFile(path) = let configPath = path if readConfigFile(configPath, cache, conf): - add(configFiles, configPath) + conf.configFiles.add(configPath) + + template runNimScriptIfExists(path: AbsoluteFile, isMain = false) = + let p = path # eval once + 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: + conf.configFiles.add(p) + runNimScript(cache, p, idgen, freshDefines = false, conf, s) - if optSkipConfigFile notin conf.globalOptions: + if optSkipSystemConfigFile notin conf.globalOptions: readConfigFile(getSystemConfigPath(conf, cfg)) + if cfg == DefaultConfig: + runNimScriptIfExists(getSystemConfigPath(conf, DefaultConfigNims)) + if optSkipUserConfigFile notin conf.globalOptions: readConfigFile(getUserConfigPath(cfg)) - let pd = if conf.projectPath.len > 0: conf.projectPath else: getCurrentDir() + if cfg == DefaultConfig: + runNimScriptIfExists(getUserConfigPath(DefaultConfigNims)) + + let pd = if not conf.projectPath.isEmpty: conf.projectPath else: AbsoluteDir(getCurrentDir()) if optSkipParentConfigFiles notin conf.globalOptions: - for dir in parentDirs(pd, fromRoot=true, inclusive=false): - readConfigFile(dir / cfg) + for dir in parentDirs(pd.string, fromRoot=true, inclusive=false): + readConfigFile(AbsoluteDir(dir) / cfg) + + if cfg == DefaultConfig: + runNimScriptIfExists(AbsoluteDir(dir) / DefaultConfigNims) if optSkipProjConfigFile notin conf.globalOptions: readConfigFile(pd / cfg) + if cfg == DefaultConfig: + runNimScriptIfExists(pd / DefaultConfigNims) if conf.projectName.len != 0: # new project wide config file: @@ -262,5 +295,26 @@ proc loadConfigs*(cfg: string; cache: IdentCache; conf: ConfigRef) = projectConfig = changeFileExt(conf.projectFull, "nim.cfg") readConfigFile(projectConfig) - for filename in configFiles: - rawMessage(conf, hintConf, filename) + + let scriptFile = conf.projectFull.changeFileExt("nims") + let scriptIsProj = scriptFile == conf.projectFull + template showHintConf = + for filename in conf.configFiles: + # delayed to here so that `hintConf` is honored + rawMessage(conf, hintConf, filename.string) + if conf.cmd == cmdNimscript: + showHintConf() + 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 f20b5642c..0833cfeb3 100644 --- a/compiler/nimeval.nim +++ b/compiler/nimeval.nim @@ -9,24 +9,29 @@ ## exposes the Nim VM to clients. import - ast, astalgo, modules, passes, condsyms, - options, sem, semdata, llstream, vm, vmdef, - modulegraphs, idents, os + 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 mainModule: PSym graph: ModuleGraph scriptName: string + idgen: IdGenerator iterator exportedSymbols*(i: Interpreter): PSym = assert i != nil assert i.mainModule != nil, "no main module selected" - var it: TTabIter - var s = initTabIter(it, i.mainModule.tab) - while s != nil: + for s in modulegraphs.allSyms(i.graph, i.mainModule): yield s - s = nextIter(it, i.mainModule.tab) proc selectUniqueSymbol*(i: Interpreter; name: string; symKinds: set[TSymKind] = {skLet, skVar}): PSym = @@ -35,17 +40,17 @@ 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: TIdentIter - var s = initIdentIter(it, i.mainModule.tab, n) + var it: ModuleIter = default(ModuleIter) + var s = initModuleIter(it, i.graph, i.mainModule, n) result = nil while s != nil: if s.kind in symKinds: if result == nil: result = s else: return nil # ambiguous - s = nextIdentIter(it, i.mainModule.tab) + s = nextModuleIter(it, i.graph) proc selectRoutine*(i: Interpreter; name: string): PSym = - ## Selects a declared rountine (proc/func/etc) from the main module. + ## Selects a declared routine (proc/func/etc) from the main module. ## The routine needs to have the export marker ``*``. The only matching ## routine is returned and ``nil`` if it is overloaded. result = selectUniqueSymbol(i, name, {skTemplate, skMacro, skFunc, @@ -58,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 @@ -68,18 +77,24 @@ 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.tab) + 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, s) + discard processPipelineModule(i.graph, i.mainModule, i.idgen, s) proc findNimStdLib*(): string = ## Tries to find a path to a valid "system.nim" file. ## Returns "" on failure. try: let nimexe = os.findExe("nim") + # this can't work with choosenim shims, refs https://github.com/dom96/choosenim/issues/189 + # it'd need `nim dump --dump.format:json . | jq -r .libpath` + # which we should simplify as `nim dump --key:libpath` if nimexe.len == 0: return "" result = nimexe.splitPath()[0] /../ "lib" if not fileExists(result / "system.nim"): @@ -89,32 +104,74 @@ proc findNimStdLib*(): string = except OSError, ValueError: return "" +proc findNimStdLibCompileTime*(): string = + ## Same as `findNimStdLib` but uses source files used at compile time, + ## and asserts on error. + result = querySetting(libPath) + doAssert fileExists(result / "system.nim"), "result:" & result + proc createInterpreter*(scriptName: string; searchPaths: openArray[string]; - flags: TSandboxFlags = {}): Interpreter = + flags: TSandboxFlags = {}, + defines = @[("nimscript", "true")], + registerOps = true): Interpreter = var conf = newConfigRef() var cache = newIdentCache() var graph = newModuleGraph(cache, conf) - connectCallbacks(graph) + connectPipelineCallbacks(graph) initDefines(conf.symbols) - defineSymbol(conf.symbols, "nimscript") - defineSymbol(conf.symbols, "nimconfig") - registerPass(graph, semPass) - registerPass(graph, evalPass) + for define in defines: + defineSymbol(conf.symbols, define[0], define[1]) for p in searchPaths: - conf.searchPaths.add(p) - if conf.libpath.len == 0: conf.libpath = p + conf.searchPaths.add(AbsoluteDir p) + if conf.libpath.isEmpty: conf.libpath = AbsoluteDir p var m = graph.makeModule(scriptName) incl(m.flags, sfMainModule) - var vm = newCtx(m, cache, graph) + var idgen = idGeneratorFromModule(m) + var vm = newCtx(m, cache, graph, idgen) vm.mode = emRepl vm.features = flags + if registerOps: + vm.registerAdditionalOps() # Required to register parts of stdlib modules graph.vm = vm - graph.compileSystemModule() - result = Interpreter(mainModule: m, graph: graph, scriptName: scriptName) + setPipeLinePass(graph, EvalPass) + graph.compilePipelineSystemModule() + result = Interpreter(mainModule: m, graph: graph, scriptName: scriptName, idgen: idgen) proc destroyInterpreter*(i: Interpreter) = ## destructor. discard "currently nothing to do." + +proc registerErrorHook*(i: Interpreter, hook: + proc (config: ConfigRef; info: TLineInfo; msg: string; + severity: Severity) {.gcsafe.}) = + i.graph.config.structuredErrorHook = hook + +proc runRepl*(r: TLLRepl; + searchPaths: openArray[string]; + supportNimscript: bool) = + ## deadcode but please don't remove... might be revived + var conf = newConfigRef() + var cache = newIdentCache() + var graph = newModuleGraph(cache, conf) + + for p in searchPaths: + conf.searchPaths.add(AbsoluteDir p) + if conf.libpath.isEmpty: conf.libpath = AbsoluteDir p + + conf.cmd = cmdInteractive # see also `setCmd` + conf.setErrorMaxHighMaybe + initDefines(conf.symbols) + defineSymbol(conf.symbols, "nimscript") + if supportNimscript: defineSymbol(conf.symbols, "nimconfig") + when hasFFI: defineSymbol(graph.config.symbols, "nimffi") + var m = graph.makeStdinModule() + incl(m.flags, sfMainModule) + var idgen = idGeneratorFromModule(m) + + if supportNimscript: graph.vm = setupVM(m, cache, "stdin", graph, idgen) + 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 58b019cd3..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.cmd = cmdPretty - 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 overwite the config file's settings - extccomp.initVars() - processCmdLine(passCmd2, "", config) - mainCommand() - -when compileOption("gc", "v2") or 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 c3e16e5ba..000000000 --- a/compiler/nimfix/prettybase.nim +++ /dev/null @@ -1,41 +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 lexbase, streams -import ".." / [ast, msgs, lineinfos, idents, options, linter] -from os import splitFile - -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 2e7416645..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* = ' ' @@ -40,7 +44,8 @@ type TBaseLexer* = object of RootObj bufpos*: int buf*: cstring - bufLen*: int # length of buffer in characters + bufStorage: string + bufLen: int stream*: PLLStream # we read from this stream lineNumber*: int # the current line number # private data: @@ -60,16 +65,12 @@ proc handleCR*(L: var TBaseLexer, pos: int): int # position to continue the scanning from. `pos` must be the position # of the CR. proc handleLF*(L: var TBaseLexer, pos: int): int - # Call this if you scanned over LF in the buffer; it returns the the + # Call this if you scanned over LF in the buffer; it returns the # position to continue the scanning from. `pos` must be the position # of the LF. # implementation -const - chrSize = sizeof(char) - proc closeBaseLexer(L: var TBaseLexer) = - dealloc(L.buf) llStreamClose(L.stream) proc fillBuffer(L: var TBaseLexer) = @@ -84,10 +85,9 @@ proc fillBuffer(L: var TBaseLexer) = toCopy = L.bufLen - L.sentinel - 1 assert(toCopy >= 0) if toCopy > 0: - moveMem(L.buf, addr(L.buf[L.sentinel + 1]), toCopy * chrSize) + moveMem(addr L.buf[0], addr L.buf[L.sentinel + 1], toCopy) # "moveMem" handles overlapping regions - charsRead = llStreamRead(L.stream, addr(L.buf[toCopy]), - (L.sentinel + 1) * chrSize) div chrSize + charsRead = llStreamRead(L.stream, addr L.buf[toCopy], L.sentinel + 1) s = toCopy + charsRead if charsRead < L.sentinel + 1: L.buf[s] = EndOfFile # set end marker @@ -107,10 +107,11 @@ proc fillBuffer(L: var TBaseLexer) = # double the buffer's size and try again: oldBufLen = L.bufLen L.bufLen = L.bufLen * 2 - L.buf = cast[cstring](realloc(L.buf, L.bufLen * chrSize)) + L.bufStorage.setLen(L.bufLen) + L.buf = L.bufStorage.cstring assert(L.bufLen - oldBufLen == oldBufLen) charsRead = llStreamRead(L.stream, addr(L.buf[oldBufLen]), - oldBufLen * chrSize) div chrSize + oldBufLen) if charsRead < oldBufLen: L.buf[oldBufLen + charsRead] = EndOfFile L.sentinel = oldBufLen + charsRead @@ -149,8 +150,9 @@ proc openBaseLexer(L: var TBaseLexer, inputstream: PLLStream, bufLen = 8192) = assert(bufLen > 0) L.bufpos = 0 L.offsetBase = 0 + L.bufStorage = newString(bufLen) + L.buf = L.bufStorage.cstring L.bufLen = bufLen - L.buf = cast[cstring](alloc(bufLen * chrSize)) L.sentinel = bufLen - 1 L.lineStart = 0 L.lineNumber = 1 # lines start at 1 @@ -164,9 +166,9 @@ proc getColNumber(L: TBaseLexer, pos: int): int = proc getCurrentLine(L: TBaseLexer, marker: bool = true): string = result = "" var i = L.lineStart - while not (L.buf[i] in {CR, LF, EndOfFile}): - add(result, L.buf[i]) - inc(i) - result.add("\n") + while L.buf[i] notin {CR, LF, EndOfFile}: + result.add L.buf[i] + inc i + result.add "\n" if marker: - result.add(spaces(getColNumber(L, L.bufpos)) & '^' & "\n") + result.add spaces(getColNumber(L, L.bufpos)) & '^' & "\n" diff --git a/compiler/nimpaths.nim b/compiler/nimpaths.nim new file mode 100644 index 000000000..0a66c3c1f --- /dev/null +++ b/compiler/nimpaths.nim @@ -0,0 +1,54 @@ +##[ +Represents absolute paths, but using a symbolic variables (eg $nimr) which can be +resolved at runtime; this avoids hardcoding at compile time absolute paths so +that the project root can be relocated. + +xxx factor pending https://github.com/timotheecour/Nim/issues/616, see also +$nim/testament/lib/stdtest/specialpaths.nim +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) + in compiler, it's obtainable via getPrefixDir(); for other tools (eg koch), + this could be getCurrentDir() or getAppFilename().parentDir.parentDir, + depending on use case + +Unstable API +]## + +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 + # if this changes, make sure it's consistent with `esc` and `escapeLink` + # lots of other obvious options won't work, see #14454; `_` could work too + +proc interp*(path: string, nimr: string): string = + result = path % ["nimr", nimr] + doAssert '$' notin result, $(path, nimr, result) # avoids un-interpolated variables in output + +proc getDocHacksJs*(nimr: string, nim = getCurrentCompilerExe(), forceRebuild = false): string = + ## return absolute path to dochack.js, rebuilding if it doesn't exist or if + ## `forceRebuild`. + let docHackJs2 = docHackJs.interp(nimr = nimr) + if forceRebuild or not docHackJs2.fileExists: + let cmd = "$nim js -d:release $file" % ["nim", nim.quoteShell, "file", docHackNim.interp(nimr = nimr).quoteShell] + echo "getDocHacksJs: cmd: " & cmd + doAssert execShellCmd(cmd) == 0, $(cmd) + doAssert docHackJs2.fileExists + result = docHackJs2 diff --git a/compiler/nimsets.nim b/compiler/nimsets.nim index b00353e20..7edf55278 100644 --- a/compiler/nimsets.nim +++ b/compiler/nimsets.nim @@ -10,21 +10,23 @@ # this unit handles Nim sets; it implements symbolic sets import - ast, astalgo, trees, nversion, lineinfos, platform, bitsets, types, renderer, - options + 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: #internalError(s.info, "inSet") return false - for i in countup(0, sonsLen(s) - 1): - if s.sons[i].kind == nkRange: - if leValue(s.sons[i].sons[0], elem) and - leValue(elem, s.sons[i].sons[1]): + for i in 0..<s.len: + if s[i].kind == nkRange: + if leValue(s[i][0], elem) and + leValue(elem, s[i][1]): return true else: - if sameValue(s.sons[i], elem): + if sameValue(s[i], elem): return true result = false @@ -32,13 +34,13 @@ proc overlap*(a, b: PNode): bool = if a.kind == nkRange: if b.kind == nkRange: # X..Y and C..D overlap iff (X <= D and C <= Y) - result = leValue(a.sons[0], b.sons[1]) and - leValue(b.sons[0], a.sons[1]) + result = leValue(a[0], b[1]) and + leValue(b[0], a[1]) else: - result = leValue(a.sons[0], b) and leValue(b, a.sons[1]) + result = leValue(a[0], b) and leValue(b, a[1]) else: if b.kind == nkRange: - result = leValue(b.sons[0], a) and leValue(a, b.sons[1]) + result = leValue(b[0], a) and leValue(a, b[1]) else: result = sameValue(a, b) @@ -48,68 +50,69 @@ proc someInSet*(s: PNode, a, b: PNode): bool = if s.kind != nkCurly: #internalError(s.info, "SomeInSet") return false - for i in countup(0, sonsLen(s) - 1): - if s.sons[i].kind == nkRange: - if leValue(s.sons[i].sons[0], b) and leValue(b, s.sons[i].sons[1]) or - leValue(s.sons[i].sons[0], a) and leValue(a, s.sons[i].sons[1]): + for i in 0..<s.len: + if s[i].kind == nkRange: + if leValue(s[i][0], b) and leValue(b, s[i][1]) or + leValue(s[i][0], a) and leValue(a, s[i][1]): return true else: # a <= elem <= b - if leValue(a, s.sons[i]) and leValue(s.sons[i], b): + if leValue(a, s[i]) and leValue(s[i], b): return true result = false -proc toBitSet*(conf: ConfigRef; s: PNode, b: var TBitSet) = - var first, j: BiggestInt - first = firstOrd(conf, s.typ.sons[0]) - bitSetInit(b, int(getSize(conf, s.typ))) - for i in countup(0, sonsLen(s) - 1): - if s.sons[i].kind == nkRange: - j = getOrdValue(s.sons[i].sons[0]) - while j <= getOrdValue(s.sons[i].sons[1]): - bitSetIncl(b, j - first) +proc toBitSet*(conf: ConfigRef; s: PNode): TBitSet = + 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: + j = getOrdValue(s[i][0], first) + while j <= getOrdValue(s[i][1], first): + bitSetIncl(result, toInt64(j - first)) inc(j) else: - bitSetIncl(b, getOrdValue(s.sons[i]) - first) + bitSetIncl(result, toInt64(getOrdValue(s[i]) - first)) proc toTreeSet*(conf: ConfigRef; s: TBitSet, settype: PType, info: TLineInfo): PNode = var a, b, e, first: BiggestInt # a, b are interval borders elemType: PType n: PNode - elemType = settype.sons[0] - first = firstOrd(conf, elemType) + elemType = settype[0] + first = firstOrd(conf, elemType).toInt64 result = newNodeI(nkCurly, info) result.typ = settype result.info = info e = 0 - while e < len(s) * ElemSize: + while e < s.len * ElemSize: if bitSetIn(s, e): a = e b = e while true: inc(b) - if (b >= len(s) * ElemSize) or not bitSetIn(s, b): break + if (b >= s.len * ElemSize) or not bitSetIn(s, b): break dec(b) - let aa = newIntTypeNode(nkIntLit, a + first, elemType) + let aa = newIntTypeNode(a + first, elemType) aa.info = info if a == b: - addSon(result, aa) + result.add aa else: n = newNodeI(nkRange, info) n.typ = elemType - addSon(n, aa) - let bb = newIntTypeNode(nkIntLit, b + first, elemType) + n.add aa + let bb = newIntTypeNode(b + first, elemType) bb.info = info - addSon(n, bb) - addSon(result, n) + n.add bb + result.add n e = b inc(e) template nodeSetOp(a, b: PNode, op: untyped) {.dirty.} = - var x, y: TBitSet - toBitSet(conf, a, x) - toBitSet(conf, b, y) + var x = toBitSet(conf, a) + let y = toBitSet(conf, b) op(x, y) result = toTreeSet(conf, x, a.typ, a.info) @@ -119,39 +122,34 @@ proc intersectSets*(conf: ConfigRef; a, b: PNode): PNode = nodeSetOp(a, b, bitSe proc symdiffSets*(conf: ConfigRef; a, b: PNode): PNode = nodeSetOp(a, b, bitSetSymDiff) proc containsSets*(conf: ConfigRef; a, b: PNode): bool = - var x, y: TBitSet - toBitSet(conf, a, x) - toBitSet(conf, b, y) + let x = toBitSet(conf, a) + let y = toBitSet(conf, b) result = bitSetContains(x, y) proc equalSets*(conf: ConfigRef; a, b: PNode): bool = - var x, y: TBitSet - toBitSet(conf, a, x) - toBitSet(conf, b, y) + let x = toBitSet(conf, a) + let y = toBitSet(conf, b) result = bitSetEquals(x, y) proc complement*(conf: ConfigRef; a: PNode): PNode = - var x: TBitSet - toBitSet(conf, a, x) - for i in countup(0, high(x)): x[i] = not x[i] + var x = toBitSet(conf, a) + for i in 0..high(x): x[i] = not x[i] result = toTreeSet(conf, x, a.typ, a.info) proc deduplicate*(conf: ConfigRef; a: PNode): PNode = - var x: TBitSet - toBitSet(conf, a, x) + let x = toBitSet(conf, a) result = toTreeSet(conf, x, a.typ, a.info) proc cardSet*(conf: ConfigRef; a: PNode): BiggestInt = - var x: TBitSet - toBitSet(conf, a, x) + let x = toBitSet(conf, a) result = bitSetCard(x) proc setHasRange*(s: PNode): bool = assert s.kind == nkCurly if s.kind != nkCurly: return false - for i in countup(0, sonsLen(s) - 1): - if s.sons[i].kind == nkRange: + for i in 0..<s.len: + if s[i].kind == nkRange: return true result = false diff --git a/compiler/nodejs.nim b/compiler/nodejs.nim index 7f9f28aaf..9753e1c99 100644 --- a/compiler/nodejs.nim +++ b/compiler/nodejs.nim @@ -1,8 +1,10 @@ -import os +import std/os -proc findNodeJs*(): string = +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 == "": - result = findExe("iojs") + 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 4b8cf7100..811008989 100644 --- a/compiler/nversion.nim +++ b/compiler/nversion.nim @@ -12,9 +12,11 @@ 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! - NimCompilerApiVersion* = 2 ## Check for the existance of this before accessing it + NimCompilerApiVersion* = 3 ## Check for the existence of this before accessing it ## as older versions of the compiler API do not ## declare this. diff --git a/compiler/optimizer.nim b/compiler/optimizer.nim new file mode 100644 index 000000000..34e8ec80f --- /dev/null +++ b/compiler/optimizer.nim @@ -0,0 +1,290 @@ +# +# +# The Nim Compiler +# (c) Copyright 2020 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Optimizer: +## - elide 'wasMoved(x); destroy(x)' pairs +## - recognize "all paths lead to 'wasMoved(x)'" + +import + ast, renderer, idents + +from trees import exprStructuralEquivalent + +import std/[strutils, intsets] + +const + nfMarkForDeletion = nfNone # faster than a lookup table + +type + BasicBlock = object + wasMovedLocs: seq[PNode] + kind: TNodeKind + hasReturn, hasBreak: bool + label: PSym # can be nil + parent: ptr BasicBlock + + Con = object + somethingTodo: bool + inFinally: int + +proc nestedBlock(parent: var BasicBlock; kind: TNodeKind): BasicBlock = + BasicBlock(wasMovedLocs: @[], kind: kind, hasReturn: false, hasBreak: false, + label: nil, parent: addr(parent)) + +proc breakStmt(b: var BasicBlock; n: PNode) = + var it = addr(b) + while it != nil: + it.wasMovedLocs.setLen 0 + it.hasBreak = true + + if n.kind == nkSym: + if it.label == n.sym: break + else: + # unnamed break leaves the block is nkWhileStmt or the like: + if it.kind in {nkWhileStmt, nkBlockStmt, nkBlockExpr}: break + + it = it.parent + +proc returnStmt(b: var BasicBlock) = + b.hasReturn = true + var it = addr(b) + while it != nil: + it.wasMovedLocs.setLen 0 + it = it.parent + +proc mergeBasicBlockInfo(parent: var BasicBlock; this: BasicBlock) {.inline.} = + if this.hasReturn: + parent.wasMovedLocs.setLen 0 + parent.hasReturn = true + +proc wasMovedTarget(matches: var IntSet; branch: seq[PNode]; moveTarget: PNode): bool = + result = false + for i in 0..<branch.len: + if exprStructuralEquivalent(branch[i][1].skipHiddenAddr, moveTarget, + strictSymEquality = true): + result = true + matches.incl i + +proc intersect(summary: var seq[PNode]; branch: seq[PNode]) = + # keep all 'wasMoved(x)' calls in summary that are also in 'branch': + var i = 0 + var matches = initIntSet() + while i < summary.len: + if wasMovedTarget(matches, branch, summary[i][1].skipHiddenAddr): + inc i + else: + summary.del i + for m in matches: + summary.add branch[m] + + +proc invalidateWasMoved(c: var BasicBlock; x: PNode) = + var i = 0 + while i < c.wasMovedLocs.len: + if exprStructuralEquivalent(c.wasMovedLocs[i][1].skipHiddenAddr, x, + strictSymEquality = true): + c.wasMovedLocs.del i + else: + inc i + +proc wasMovedDestroyPair(c: var Con; b: var BasicBlock; d: PNode) = + var i = 0 + while i < b.wasMovedLocs.len: + if exprStructuralEquivalent(b.wasMovedLocs[i][1].skipHiddenAddr, d[1].skipHiddenAddr, + strictSymEquality = true): + b.wasMovedLocs[i].flags.incl nfMarkForDeletion + c.somethingTodo = true + d.flags.incl nfMarkForDeletion + b.wasMovedLocs.del i + else: + inc i + +proc analyse(c: var Con; b: var BasicBlock; n: PNode) = + case n.kind + of nkCallKinds: + var special = false + var reverse = false + if n[0].kind == nkSym: + let s = n[0].sym + let name = s.name.s.normalize + if name == "=wasmoved": + b.wasMovedLocs.add n + special = true + 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 name == "=sink": + reverse = true + + if not special: + if not reverse: + for i in 0 ..< n.len: + analyse(c, b, n[i]) + else: + #[ Test destructor/tmatrix.test3: + Prevent this from being elided. We should probably + find a better solution... + + `=sink`(b, - + let blitTmp = b; + wasMoved(b); + blitTmp + a) + `=destroy`(b) + + ]# + for i in countdown(n.len-1, 0): + analyse(c, b, n[i]) + if canRaise(n[0]): returnStmt(b) + + of nkSym: + # any usage of the location before destruction implies we + # cannot elide the 'wasMoved(x)': + b.invalidateWasMoved n + + of 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: + discard "do not follow the construct" + + of nkAsgn, nkFastAsgn, nkSinkAsgn: + # reverse order, see remark for `=sink`: + analyse(c, b, n[1]) + analyse(c, b, n[0]) + + of nkIfStmt, nkIfExpr: + let isExhaustive = n[^1].kind in {nkElse, nkElseExpr} + var wasMovedSet: seq[PNode] = @[] + + for i in 0 ..< n.len: + var branch = nestedBlock(b, n[i].kind) + + analyse(c, branch, n[i]) + mergeBasicBlockInfo(b, branch) + if isExhaustive: + if i == 0: + wasMovedSet = move(branch.wasMovedLocs) + else: + wasMovedSet.intersect(branch.wasMovedLocs) + for i in 0..<wasMovedSet.len: + b.wasMovedLocs.add wasMovedSet[i] + + of nkCaseStmt: + let isExhaustive = skipTypes(n[0].typ, + abstractVarRange-{tyTypeDesc}).kind notin {tyFloat..tyFloat128, tyString, tyCstring} or + n[^1].kind == nkElse + + analyse(c, b, n[0]) + + var wasMovedSet: seq[PNode] = @[] + + for i in 1 ..< n.len: + var branch = nestedBlock(b, n[i].kind) + + analyse(c, branch, n[i]) + mergeBasicBlockInfo(b, branch) + if isExhaustive: + if i == 1: + wasMovedSet = move(branch.wasMovedLocs) + else: + wasMovedSet.intersect(branch.wasMovedLocs) + for i in 0..<wasMovedSet.len: + b.wasMovedLocs.add wasMovedSet[i] + + of nkTryStmt: + for i in 0 ..< n.len: + var tryBody = nestedBlock(b, nkTryStmt) + + analyse(c, tryBody, n[i]) + mergeBasicBlockInfo(b, tryBody) + + of nkWhileStmt: + analyse(c, b, n[0]) + var loopBody = nestedBlock(b, nkWhileStmt) + analyse(c, loopBody, n[1]) + mergeBasicBlockInfo(b, loopBody) + + of nkBlockStmt, nkBlockExpr: + var blockBody = nestedBlock(b, n.kind) + if n[0].kind == nkSym: + blockBody.label = n[0].sym + analyse(c, blockBody, n[1]) + mergeBasicBlockInfo(b, blockBody) + + of nkBreakStmt: + breakStmt(b, n[0]) + + of nkReturnStmt, nkRaiseStmt: + for child in n: analyse(c, b, child) + returnStmt(b) + + of nkFinally: + inc c.inFinally + for child in n: analyse(c, b, child) + dec c.inFinally + + else: + for child in n: analyse(c, b, child) + +proc opt(c: Con; n, parent: PNode; parentPos: int) = + template recurse() = + let x = shallowCopy(n) + for i in 0 ..< n.len: + opt(c, n[i], x, i) + parent[parentPos] = x + + case n.kind + of nkCallKinds: + if nfMarkForDeletion in n.flags: + parent[parentPos] = newNodeI(nkEmpty, n.info) + else: + recurse() + + of nkNone..nkNilLit, nkTypeSection, nkProcDef, nkConverterDef, + nkMethodDef, nkIteratorDef, nkMacroDef, nkTemplateDef, nkLambda, nkDo, + nkFuncDef, nkConstSection, nkConstDef, nkIncludeStmt, nkImportStmt, + nkExportStmt, nkPragma, nkCommentStmt, nkBreakState, nkTypeOfExpr, + nkMixinStmt, nkBindStmt: + parent[parentPos] = n + + else: + recurse() + + +proc optimize*(n: PNode): PNode = + # optimize away simple 'wasMoved(x); destroy(x)' pairs. + #[ Unfortunately this optimization is only really safe when no exceptions + are possible, see for example: + + proc main(inp: string; cond: bool) = + if cond: + try: + var s = ["hi", inp & "more"] + for i in 0..4: + use s + consume(s) + wasMoved(s) + finally: + destroy(s) + + Now assume 'use' raises, then we shouldn't do the 'wasMoved(s)' + ]# + var c: Con = Con() + var b: BasicBlock = default(BasicBlock) + analyse(c, b, n) + if c.somethingTodo: + result = shallowCopy(n) + for i in 0 ..< n.safeLen: + opt(c, n[i], result, i) + else: + result = n diff --git a/compiler/options.nim b/compiler/options.nim index 1d6ddb09f..b77bdd2a3 100644 --- a/compiler/options.nim +++ b/compiler/options.nim @@ -8,132 +8,269 @@ # import - os, strutils, strtabs, osproc, sets, lineinfos, platform, - prefixmatches + 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 const hasTinyCBackend* = defined(tinyc) useEffectSystem* = true useWriteTracking* = false - hasFFI* = defined(useFFI) - newScopeForIf* = true - useCaas* = not defined(noCaas) - copyrightYear* = "2018" + hasFFI* = defined(nimHasLibFFI) + copyrightYear* = "2024" + + nimEnableCovariance* = defined(nimEnableCovariance) type # please make sure we have under 32 options # (improves code efficiency a lot!) TOption* = enum # **keep binary compatible** optNone, optObjCheck, optFieldCheck, optRangeCheck, optBoundsCheck, - optOverflowCheck, optNilCheck, - optNaNCheck, optInfCheck, optMoveCheck, + optOverflowCheck, optRefCheck, + optNaNCheck, optInfCheck, optStaticBoundsCheck, optStyleCheck, optAssert, optLineDir, optWarns, optHints, - optOptimizeSpeed, optOptimizeSize, optStackTrace, # stack tracing support + optOptimizeSpeed, optOptimizeSize, + optStackTrace, # stack tracing support + optStackTraceMsgs, # enable custom runtime msgs via `setFrameMsg` optLineTrace, # line tracing support (includes stack tracing) - optEndb, # embedded debugger optByRef, # use pass by ref for objects # (for interfacing with C) optProfiler, # profiler turned on optImplicitStatic, # optimization: implicit at compile time # evaluation - optPatterns, # en/disable pattern matching + optTrMacros, # en/disable pattern matching optMemTracker, - optHotCodeReloading, - optLaxStrings + optSinkInference # 'sink T' inference + optCursorInference + optImportHidden + optQuirky TOptions* = set[TOption] - TGlobalOption* = enum # **keep binary compatible** + TGlobalOption* = enum gloptNone, optForceFullMake, - optDeadCodeElimUnused, # deprecated, always on + optWasNimscript, # redundant with `cmdNimscript`, could be removed optListCmd, optCompileOnly, optNoLinking, optCDebug, # turn on debugging information optGenDynLib, # generate a dynamic library optGenStaticLib, # generate a static library optGenGuiApp, # generate a GUI application optGenScript, # generate a script file to compile the *.c files + optGenCDeps, # generate a list of *.c files to be read by CMake optGenMapping, # generate a mapping file optRun, # run the compiled project - optCheckNep1, # check that the names adhere to NEP-1 - optSkipConfigFile, # skip the general config file - optSkipProjConfigFile, # skip the project's config file - optSkipUserConfigFile, # skip the users's config file - optSkipParentConfigFiles, # skip parent dir's config files + optUseNimcache, # save artifacts (including binary) in $nimcache + optStyleHint, # check that the names adhere to NEP-1 + optStyleError, # enforce that the names adhere to NEP-1 + optStyleUsages, # only enforce consistent **usages** of the symbol + optSkipSystemConfigFile, # skip the system's cfg/nims config file + optSkipProjConfigFile, # skip the project's cfg/nims config file + optSkipUserConfigFile, # skip the users's cfg/nims config file + optSkipParentConfigFiles, # skip parent dir's cfg/nims config files optNoMain, # do not generate a "main" proc optUseColors, # use colors for hints, warnings, and errors optThreads, # support for multi-threading optStdout, # output to stdout optThreadAnalysis, # thread analysis pass - optTaintMode, # taint mode turned on 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 - optNoCppExceptions # use C exception handling even with CPP + optIdeExceptionInlayHints optExcessiveStackTrace # fully qualified module filenames - optWholeProject # for 'doc2': output any dependency + 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 + optDeclaredLocs # show declaration locations in messages optNoNimblePath + optHotCodeReloading optDynlibOverrideAll - optUseNimNamespace + optSeqDestructors # active if the implementation uses the new + # string/seq implementation based on destructors + optTinyRtti # active if we use the new "tiny RTTI" + # implementation + optOwnedRefs # active if the Nim compiler knows about 'owned'. + optMultiMethods + optBenchmarkVM # Enables cpuTime() in the VM + optProduceAsm # produce assembler code + optPanics # turn panics (sysFatal) into a process termination + 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] const - harmlessOptions* = {optForceFullMake, optNoLinking, optRun, - optUseColors, optStdout} + harmlessOptions* = {optForceFullMake, optNoLinking, optRun, optUseColors, optStdout} + genSubDir* = RelativeDir"nimcache" + NimExt* = "nim" + RodExt* = "rod" + HtmlExt* = "html" + JsonExt* = "json" + TagsExt* = "tags" + TexExt* = "tex" + IniExt* = "ini" + DefaultConfig* = RelativeFile"nim.cfg" + DefaultConfigNims* = RelativeFile"config.nims" + DocConfig* = RelativeFile"nimdoc.cfg" + DocTexConfig* = RelativeFile"nimdoc.tex.cfg" + htmldocsDir* = htmldocsDirname.RelativeDir + docRootDefault* = "@default" # using `@` instead of `$` to avoid shell quoting complications + oKeepVariableNames* = true + spellSuggestSecretSauce* = -1 + +type + TBackend* = enum + backendInvalid = "" # for parseEnum + backendC = "c" + backendCpp = "cpp" + backendJs = "js" + backendObjc = "objc" + # backendNimscript = "nimscript" # this could actually work + # backendLlvm = "llvm" # probably not well supported; was cmdCompileToLLVM + + Command* = enum ## Nim's commands + cmdNone # not yet processed command + cmdUnknown # command unmapped + cmdCompileToC, cmdCompileToCpp, cmdCompileToOC, cmdCompileToJS, + cmdCrun # compile and run in nimache + cmdTcc # run the project via TCC backend + cmdCheck # semantic checking for whole project + 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 + 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 + cmdBuildindex + cmdGendepend + cmdDump + cmdInteractive # start interactive session + cmdNop + cmdJsonscript # compile a .json build file + # old unused: cmdInterpret, cmdDef: def feature (find definition for IDEs) + +const + cmdBackends* = {cmdCompileToC, cmdCompileToCpp, cmdCompileToOC, + cmdCompileToJS, cmdCrun} + cmdDocLike* = {cmdDoc0, cmdDoc, cmdDoc2tex, cmdJsondoc0, cmdJsondoc, + cmdCtags, cmdBuildindex} type - TCommands* = enum # Nim's commands - # **keep binary compatible** - cmdNone, cmdCompileToC, cmdCompileToCpp, cmdCompileToOC, - cmdCompileToJS, - cmdCompileToLLVM, cmdInterpret, cmdPretty, cmdDoc, - cmdGenDepend, cmdDump, - cmdCheck, # semantic checking for whole project - cmdParse, # parse a single file (for debugging) - cmdScan, # scan a single file (for debugging) - cmdIdeTools, # ide tools - cmdDef, # def feature (find definition for IDEs) - cmdRst2html, # convert a reStructuredText file to HTML - cmdRst2tex, # convert a reStructuredText file to TeX - cmdInteractive, # start interactive session - cmdRun, # run the project via TCC backend - cmdJsonScript # compile a .json build file TStringSeq* = seq[string] TGCMode* = enum # the selected GC - gcNone, gcBoehm, gcGo, gcRegions, gcMarkAndSweep, gcRefc, - gcV2, gcGenerational + 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 + 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 - implicitDeref, + Feature* = enum ## experimental features; DO NOT RENAME THESE! dotOperators, callOperator, parallel, destructor, - notnil + notnil, + dynamicBindSym, + forLoopMacros, # not experimental anymore; remains here for backwards compatibility + caseStmtMacros, # ditto + codeReordering, + compiletimeFFI, + ## This requires building nim with `-d:nimHasLibFFI` + ## which itself requires `koch installdeps libffi`, see #10150 + ## Note: this feature can't be localized with {.push.} + vmopsDanger, + strictFuncs, + views, + 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, + ## Allows to modify a NimNode where the type has already been + ## flagged with nfSem. If you actually do this, it will cause + ## bugs. + checkUnsignedConversions + ## 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 + disabledSf, writeOnlySf, readOnlySf, v2Sf, stressTest TSystemCC* = enum - ccNone, ccGcc, ccLLVM_Gcc, ccCLang, ccLcc, ccBcc, ccDmc, ccWcc, ccVcc, - ccTcc, ccPcc, ccUcc, ccIcl, ccIcc + ccNone, ccGcc, ccNintendoSwitch, ccLLVM_Gcc, ccCLang, ccBcc, ccVcc, + ccTcc, ccEnv, ccIcl, ccIcc, ccClangCl, ccHipcc, ccNvcc + + ExceptionSystem* = enum + excNone, # no exception system selected yet + excSetjmp, # setjmp based exception handling + excCpp, # use C++'s native exception handling + excGoto, # exception handling based on goto (should become the new default for C) + excQuirky # quirky exception handling CfileFlag* {.pure.} = enum Cached, ## no need to recompile this time External ## file was introduced via .compile pragma Cfile* = object - cname*, obj*: string - flags*: set[CFileFlag] + nimname*: string + cname*, obj*: AbsoluteFile + flags*: set[CfileFlag] + customArgs*: string CfileList* = seq[Cfile] Suggest* = ref object @@ -154,73 +291,133 @@ type scope*, localUsages*, globalUsages*: int # more usages is better tokenLen*: int version*: int + endLine*: uint16 + endCol*: int + inlayHintInfo*: SuggestInlayHint + Suggestions* = seq[Suggest] - ConfigRef* = ref object ## every global configuration + 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 + + ProfileData* = ref object + data*: TableRef[TLineInfo, ProfileInfo] + + StdOrrKind* = enum + stdOrrStdout + stdOrrStderr + + FilenameOption* = enum + foAbs # absolute path, e.g.: /pathto/bar/foo.nim + foRelProject # relative to project path, e.g.: ../foo.nim + foCanonical # canonical module name + foLegacyRelProj # legacy, shortest of (foAbs, foRelProject) + foName # lastPathPart, e.g.: foo.nim + foStacktrace # if optExcessiveStackTrace: foAbs else: foName + + ConfigRef* {.acyclic.} = ref object ## every global configuration ## fields marked with '*' are subject to ## the incremental compilation mechanisms ## (+) means "part of the dependency" + backend*: TBackend # set via `nim x` or `nim --backend:x` target*: Target # (+) - linesCompiled*: int # all lines that have been compiled + linesCompiled*: int # all lines that have been compiled options*: TOptions # (+) globalOptions*: TGlobalOptions # (+) + macrosToExpand*: StringTableRef + arcToExpand*: StringTableRef m*: MsgConfig + filenameOption*: FilenameOption # how to render paths in compiler messages + unitSep*: string evalTemplateCounter*: int evalMacroCounter*: int exitcode*: int8 - cmd*: TCommands # the command + cmd*: Command # raw command parsed as enum + cmdInput*: string # input command + projectIsCmd*: bool # whether we're compiling from a command input + implicitCmd*: bool # whether some flag triggered an implicit `command` selectedGC*: TGCMode # the selected GC (+) + exc*: ExceptionSystem + hintProcessingDots*: bool # true for dots, false for filenames verbosity*: int # how verbose the compiler is numberOfProcessors*: int # number of processors - evalExpr*: string # expression for idetools --eval lastCmdTime*: float # when caas is enabled, we measure each command symbolFiles*: SymbolFilesOption + spellSuggestMax*: int # max number of spelling suggestions for typos 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 - helpWritten*: bool ideCmd*: IdeCmd - oldNewlines*: bool - cCompiler*: TSystemCC - enableNotes*: TNoteKinds - disableNotes*: TNoteKinds + cCompiler*: TSystemCC # the used compiler + modifiedyNotes*: TNoteKinds # notes that have been set/unset from either cmdline/configs + cmdlineNotes*: TNoteKinds # notes that have been set/unset from cmdline foreignPackageNotes*: TNoteKinds - notes*: TNoteKinds + notes*: TNoteKinds # notes after resolving all logic(defaults, verbosity)/cmdline/configs + warningAsErrors*: TNoteKinds mainPackageNotes*: TNoteKinds mainPackageId*: int errorCounter*: int hintCounter*: int 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 ## insensitive. Otherwise hell would break lose. packageCache*: StringTableRef - searchPaths*: seq[string] - lazyPaths*: seq[string] - outFile*, prefixDir*, libpath*, nimcacheDir*: string - dllOverrides, moduleOverrides*: StringTableRef + nimblePaths*: seq[AbsoluteDir] + searchPaths*: seq[AbsoluteDir] + lazyPaths*: seq[AbsoluteDir] + outFile*: RelativeFile + outDir*: AbsoluteDir + jsonBuildFile*: AbsoluteFile + prefixDir*, libpath*, nimcacheDir*: AbsoluteDir + dllOverrides*, moduleOverrides*, cfileSpecificOptions*: StringTableRef projectName*: string # holds a name like 'nim' - projectPath*: string # holds a path like /home/alice/projects/nim/compiler/ - projectFull*: string # projectPath/projectName + projectPath*: AbsoluteDir # holds a path like /home/alice/projects/nim/compiler/ + projectFull*: AbsoluteFile # projectPath/projectName projectIsStdin*: bool # whether we're compiling from stdin + lastMsgWasDot*: set[StdOrrKind] # the last compiler message was a single '.' projectMainIdx*: FileIndex # the canonical path id of the main module + projectMainIdx2*: FileIndex # consider merging with projectMainIdx command*: string # the main command (e.g. cc, check, scan, etc) commandArgs*: seq[string] # any arguments after the main command - keepComments*: bool # whether the parser needs to keep comments + commandLine*: string + extraCmds*: seq[string] # for writeJsonBuildInstructions implicitImports*: seq[string] # modules that are to be implicitly imported implicitIncludes*: seq[string] # modules that are to be implicitly included docSeeSrcUrl*: string # if empty, no seeSrc will be generated. \ # The string uses the formatting variables `path` and `line`. + docRoot*: string ## see nim --fullhelp for --docRoot + docCmd*: string ## see nim --fullhelp for --docCmd - # the used compiler - cIncludes*: seq[string] # directories to search for included files - cLibs*: seq[string] # directories to search for lib files - cLinkedLibs*: seq[string] # libraries to link + configFiles*: seq[AbsoluteFile] # config files (cfg,nims) + cIncludes*: seq[AbsoluteDir] # directories to search for included files + cLibs*: seq[AbsoluteDir] # directories to search for lib files + cLinkedLibs*: seq[string] # libraries to link externalToLink*: seq[string] # files to link in addition to the file # we compiled (*) @@ -228,34 +425,101 @@ type compileOptionsCmd*: seq[string] linkOptions*: string # (*) compileOptions*: string # (*) - ccompilerpath*: string + cCompilerPath*: string toCompile*: CfileList # (*) suggestionResultHook*: proc (result: Suggest) {.closure.} suggestVersion*: int suggestMaxResults*: int lastLineInfo*: TLineInfo - writelnHook*: proc (output: string) {.closure.} + writelnHook*: proc (output: string) {.closure, gcsafe.} structuredErrorHook*: proc (config: ConfigRef; info: TLineInfo; msg: string; - severity: Severity) {.closure.} + 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 + +template setErrorMaxHighMaybe*(conf: ConfigRef) = + ## do not stop after first error (but honor --errorMax if provided) + assignIfDefault(conf.errorMax, high(int)) + +proc setNoteDefaults*(conf: ConfigRef, note: TNoteKind, enabled = true) = + template fun(op) = + conf.notes.op note + conf.mainPackageNotes.op note + conf.foreignPackageNotes.op note + if enabled: fun(incl) else: fun(excl) -template depConfigFields*(fn) {.dirty.} = - fn(target) - fn(options) - fn(globalOptions) - fn(selectedGC) +proc setNote*(conf: ConfigRef, note: TNoteKind, enabled = true) = + # see also `prepareConfigNotes` which sets notes + if note notin conf.cmdlineNotes: + if enabled: incl(conf.notes, note) else: excl(conf.notes, note) -const oldExperimentalFeatures* = {implicitDeref, dotOperators, callOperator, parallel} +proc hasHint*(conf: ConfigRef, note: TNoteKind): bool = + # ternary states instead of binary states would simplify logic + if optHints notin conf.options: false + elif note in {hintConf, hintProcessing}: + # could add here other special notes like hintSource + # these notes apply globally. + note in conf.mainPackageNotes + else: note in conf.notes + +proc hasWarn*(conf: ConfigRef, note: TNoteKind): bool {.inline.} = + optWarns in conf.options and note in conf.notes + +proc hcrOn*(conf: ConfigRef): bool = return optHotCodeReloading in conf.globalOptions + +when false: + template depConfigFields*(fn) {.dirty.} = # deadcode + fn(target) + fn(options) + fn(globalOptions) + fn(selectedGC) + +const oldExperimentalFeatures* = {dotOperators, callOperator, parallel} const - ChecksOptions* = {optObjCheck, optFieldCheck, optRangeCheck, optNilCheck, + ChecksOptions* = {optObjCheck, optFieldCheck, optRangeCheck, optOverflowCheck, optBoundsCheck, optAssert, optNaNCheck, optInfCheck, - optMoveCheck} + optStyleCheck} DefaultOptions* = {optObjCheck, optFieldCheck, optRangeCheck, - optBoundsCheck, optOverflowCheck, optAssert, optWarns, - optHints, optStackTrace, optLineTrace, - optPatterns, optNilCheck, optMoveCheck} - DefaultGlobalOptions* = {optThreadAnalysis} + optBoundsCheck, optOverflowCheck, optAssert, optWarns, optRefCheck, + optHints, optStackTrace, optLineTrace, # consider adding `optStackTraceMsgs` + optTrMacros, optStyleCheck, optCursorInference} + DefaultGlobalOptions* = {optThreadAnalysis, optExcessiveStackTrace, + optJsBigInt64} + +proc getSrcTimestamp(): DateTime = + try: + result = utc(fromUnix(parseInt(getEnv("SOURCE_DATE_EPOCH", + "not a number")))) + except ValueError: + # Environment variable malformed. + # https://reproducible-builds.org/specs/source-date-epoch/: "If the + # value is malformed, the build process SHOULD exit with a non-zero + # error code", which this doesn't do. This uses local time, because + # that maintains compatibility with existing usage. + result = utc getTime() + +proc getDateStr*(): string = + result = format(getSrcTimestamp(), "yyyy-MM-dd") + +proc getClockStr*(): string = + result = format(getSrcTimestamp(), "HH:mm:ss") template newPackageCache*(): untyped = newStringTable(when FileSystemCaseSensitive: @@ -263,42 +527,66 @@ template newPackageCache*(): untyped = else: modeCaseSensitive) +proc newProfileData(): ProfileData = + ProfileData(data: newTable[TLineInfo, ProfileInfo]()) + +const foreignPackageNotesDefault* = { + hintProcessing, warnUnknownMagic, hintQuitCalled, hintExecuting, hintUser, warnUser} + +proc isDefined*(conf: ConfigRef; symbol: string): bool + +when defined(nimDebugUtils): + # this allows inserting debugging utilties in all modules that import `options` + # with a single switch, which is useful when debugging compiler. + import debugutils + export debugutils + +proc initConfigRefCommon(conf: ConfigRef) = + conf.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(), - evalExpr: "", - cppDefines: initSet[string](), - headerFile: "", features: {}, foreignPackageNotes: {hintProcessing, warnUnknownMagic, - hintQuitCalled, hintExecuting}, - notes: NotesVerbosity[1], mainPackageNotes: NotesVerbosity[1], + cppDefines: initHashSet[string](), + headerFile: "", features: {}, legacyFeatures: {}, configVars: newStringTable(modeStyleInsensitive), symbols: newStringTable(modeStyleInsensitive), packageCache: newPackageCache(), searchPaths: @[], lazyPaths: @[], - outFile: "", prefixDir: "", libpath: "", nimcacheDir: "", + outFile: RelativeFile"", + outDir: AbsoluteDir"", + prefixDir: AbsoluteDir"", + libpath: AbsoluteDir"", nimcacheDir: AbsoluteDir"", dllOverrides: newStringTable(modeCaseInsensitive), moduleOverrides: newStringTable(modeStyleInsensitive), + cfileSpecificOptions: newStringTable(modeCaseSensitive), projectName: "", # holds a name like 'nim' - projectPath: "", # holds a path like /home/alice/projects/nim/compiler/ - projectFull: "", # projectPath/projectName + projectPath: AbsoluteDir"", # holds a path like /home/alice/projects/nim/compiler/ + projectFull: AbsoluteFile"", # projectPath/projectName projectIsStdin: false, # whether we're compiling from stdin projectMainIdx: FileIndex(0'i32), # the canonical path id of the main module command: "", # the main command (e.g. cc, check, scan, etc) commandArgs: @[], # any arguments after the main command - keepComments: true, # whether the parser needs to keep comments + commandLine: "", implicitImports: @[], # modules that are to be implicitly imported implicitIncludes: @[], # modules that are to be implicitly included docSeeSrcUrl: "", cIncludes: @[], # directories to search for included files cLibs: @[], # directories to search for lib files cLinkedLibs: @[], # libraries to link - + backend: backendInvalid, externalToLink: @[], linkOptionsCmd: "", compileOptionsCmd: @[], @@ -307,30 +595,34 @@ proc newConfigRef*(): ConfigRef = ccompilerpath: "", toCompile: @[], arguments: "", - suggestMaxResults: 10_000 + suggestMaxResults: 10_000, + 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: {hintProcessing, warnUnknownMagic, - hintQuitCalled, hintExecuting}, - 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 proc isDefined*(conf: ConfigRef; symbol: string): bool = if conf.symbols.hasKey(symbol): - result = conf.symbols[symbol] != "false" + result = true elif cmpIgnoreStyle(symbol, CPU[conf.target.targetCPU].name) == 0: result = true elif cmpIgnoreStyle(symbol, platform.OS[conf.target.targetOS].name) == 0: @@ -344,20 +636,33 @@ proc isDefined*(conf: ConfigRef; symbol: string): bool = result = conf.target.targetOS in {osLinux, osMorphos, osSkyos, osIrix, osPalmos, osQnx, osAtari, osAix, osHaiku, osVxWorks, osSolaris, osNetbsd, - osFreebsd, osOpenbsd, osDragonfly, osMacosx, - osAndroid} + osFreebsd, osOpenbsd, osDragonfly, osMacosx, osIos, + 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 of "mswindows", "win32": result = conf.target.targetOS == osWindows - of "macintosh": result = conf.target.targetOS in {osMacos, osMacosx} + of "macintosh": + result = conf.target.targetOS in {osMacos, osMacosx, osIos} + of "osx", "macosx": + result = conf.target.targetOS in {osMacosx, osIos} of "sunos": result = conf.target.targetOS == osSolaris - of "littleendian": result = CPU[conf.target.targetCPU].endian == platform.littleEndian - of "bigendian": result = CPU[conf.target.targetCPU].endian == platform.bigEndian + of "nintendoswitch": + result = conf.target.targetOS == osNintendoSwitch + of "freertos", "lwip": + result = conf.target.targetOS == osFreeRTOS + 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 @@ -365,35 +670,25 @@ 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 -proc importantComments*(conf: ConfigRef): bool {.inline.} = conf.cmd in {cmdDoc, cmdIdeTools} -proc usesNativeGC*(conf: ConfigRef): bool {.inline.} = conf.selectedGC >= gcRefc +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 template compilationCachePresent*(conf: ConfigRef): untyped = - conf.symbolFiles in {v2Sf, writeOnlySf} + false +# conf.symbolFiles in {v2Sf, writeOnlySf} template optPreserveOrigSource*(conf: ConfigRef): untyped = optEmbedOrigSrc in conf.globalOptions -const - genSubDir* = "nimcache" - NimExt* = "nim" - RodExt* = "rod" - HtmlExt* = "html" - JsonExt* = "json" - TagsExt* = "tags" - TexExt* = "tex" - IniExt* = "ini" - DefaultConfig* = "nim.cfg" - DocConfig* = "nimdoc.cfg" - DocTexConfig* = "nimdoc.tex.cfg" - -const oKeepVariableNames* = true - -template compilingLib*(conf: ConfigRef): bool = - gGlobalOptions * {optGenGuiApp, optGenDynLib} != {} - proc mainCommandArg*(conf: ConfigRef): string = ## This is intended for commands like check or parse ## which will work on the main project file unless @@ -406,186 +701,318 @@ proc mainCommandArg*(conf: ConfigRef): string = proc existsConfigVar*(conf: ConfigRef; key: string): bool = result = hasKey(conf.configVars, key) -proc getConfigVar*(conf: ConfigRef; key: string): string = - result = conf.configVars.getOrDefault key +proc getConfigVar*(conf: ConfigRef; key: string, default = ""): string = + result = conf.configVars.getOrDefault(key, default) proc setConfigVar*(conf: ConfigRef; key, val: string) = conf.configVars[key] = val -proc getOutFile*(conf: ConfigRef; filename, ext: string): string = - if conf.outFile != "": result = conf.outFile - else: result = changeFileExt(filename, ext) - -proc getPrefixDir*(conf: ConfigRef): string = +proc getOutFile*(conf: ConfigRef; filename: RelativeFile, ext: string): AbsoluteFile = + # explains regression https://github.com/nim-lang/Nim/issues/6583#issuecomment-625711125 + # Yet another reason why "" should not mean "."; `""/something` should raise + # instead of implying "" == "." as it's bug prone. + doAssert conf.outDir.string.len > 0 + result = conf.outDir / changeFileExt(filename, ext) + +proc absOutFile*(conf: ConfigRef): AbsoluteFile = + doAssert not conf.outDir.isEmpty + doAssert not conf.outFile.isEmpty + result = conf.outDir / conf.outFile + when defined(posix): + if dirExists(result.string): result.string.add ".out" + +proc prepareToWriteOutput*(conf: ConfigRef): AbsoluteFile = + ## Create the output directory and returns a full path to the output file + result = conf.absOutFile + createDir result.string.parentDir + +proc getPrefixDir*(conf: ConfigRef): AbsoluteDir = ## Gets the prefix dir, usually the parent directory where the binary resides. ## ## This is overridden by some tools (namely nimsuggest) via the ``conf.prefixDir`` - ## global. - if conf.prefixDir != "": result = conf.prefixDir - else: result = splitPath(getAppDir()).head + ## field. + ## This should resolve to root of nim sources, whether running nim from a local + ## 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: + 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 == "": + if conf.libpath.isEmpty: # choose default libpath: var prefix = getPrefixDir(conf) - when defined(posix): - if prefix == "/usr": conf.libpath = "/usr/lib/nim" - elif prefix == "/usr/local": conf.libpath = "/usr/local/lib/nim" - else: conf.libpath = joinPath(prefix, "lib") - else: conf.libpath = joinPath(prefix, "lib") + conf.libpath = prefix / RelativeDir"lib" # Special rule to support other tools (nimble) which import the compiler # modules and make use of them. let realNimPath = findExe("nim") # Find out if $nim/../../lib/system.nim exists. let parentNimLibPath = realNimPath.parentDir.parentDir / "lib" - if not fileExists(conf.libpath / "system.nim") and - fileExists(parentNimlibPath / "system.nim"): - conf.libpath = parentNimLibPath - -proc canonicalizePath*(conf: ConfigRef; path: string): string = - # on Windows, 'expandFilename' calls getFullPathName which doesn't do - # case corrections, so we have to use this convoluted way of retrieving - # the true filename (see tests/modules and Nimble uses 'import Uri' instead - # of 'import uri'): - when defined(windows): - result = path.expandFilename - for x in walkFiles(result): - return x - else: - result = path.expandFilename - -proc shortenDir*(conf: ConfigRef; dir: string): string = - ## returns the interesting part of a dir - var prefix = conf.projectPath & DirSep - if startsWith(dir, prefix): - return substr(dir, len(prefix)) - prefix = getPrefixDir(conf) & DirSep - if startsWith(dir, prefix): - return substr(dir, len(prefix)) - result = dir + if not fileExists(conf.libpath.string / "system.nim") and + fileExists(parentNimLibPath / "system.nim"): + conf.libpath = AbsoluteDir parentNimLibPath + +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 (len(path) > 0) and (path[len(path) - 1] == DirSep): - result = substr(path, 0, len(path) - 2) + if (path.len > 0) and (path[^1] == DirSep): + result = substr(path, 0, path.len - 2) else: result = path proc disableNimblePath*(conf: ConfigRef) = incl conf.globalOptions, optNoNimblePath conf.lazyPaths.setLen(0) + conf.nimblePaths.setLen(0) + +proc clearNimblePath*(conf: ConfigRef) = + conf.lazyPaths.setLen(0) + conf.nimblePaths.setLen(0) include packagehandling -proc getNimcacheDir*(conf: ConfigRef): string = - result = if conf.nimcacheDir.len > 0: conf.nimcacheDir - else: shortenDir(conf, conf.projectPath) / genSubDir +proc getOsCacheDir(): string = + when defined(posix): + result = getEnv("XDG_CACHE_HOME", getHomeDir() / ".cache") / "nim" + else: + 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: + 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()) result = unixToNativePath(p % [ - "nim", getPrefixDir(conf), - "lib", conf.libpath, + "nim", getPrefixDir(conf).string, + "lib", conf.libpath.string, "home", home, "config", config, "projectname", conf.projectName, - "projectpath", conf.projectPath, - "projectdir", conf.projectPath, - "nimcache", getNimcacheDir(conf)]) - if "~/" in result: - result = result.replace("~/", home & '/') + "projectpath", conf.projectPath.string, + "projectdir", conf.projectPath.string, + "nimcache", getNimcacheDir(conf).string]).expandTilde + +iterator nimbleSubs*(conf: ConfigRef; p: string): string = + let pl = p.toLowerAscii + if "$nimblepath" in pl or "$nimbledir" in pl: + for i in countdown(conf.nimblePaths.len-1, 0): + let nimblePath = removeTrailingDirSep(conf.nimblePaths[i].string) + yield p % ["nimblepath", nimblePath, "nimbledir", nimblePath] + else: + yield p -proc toGeneratedFile*(conf: ConfigRef; path, ext: string): string = +proc toGeneratedFile*(conf: ConfigRef; path: AbsoluteFile, + ext: string): AbsoluteFile = ## converts "/home/a/mymodule.nim", "rod" to "/home/a/nimcache/mymodule.rod" - var (head, tail) = splitPath(path) - #if len(head) > 0: head = shortenDir(head & dirSep) - result = joinPath([getNimcacheDir(conf), changeFileExt(tail, ext)]) - #echo "toGeneratedFile(", path, ", ", ext, ") = ", result - -proc completeGeneratedFilePath*(conf: ConfigRef; f: string, createSubDir: bool = true): string = - var (head, tail) = splitPath(f) - #if len(head) > 0: head = removeTrailingDirSep(shortenDir(head & dirSep)) - var subdir = getNimcacheDir(conf) # / head + result = getNimcacheDir(conf) / RelativeFile path.string.splitPath.tail.changeFileExt(ext) + +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) + createDir(subdir.string) except OSError: - writeLine(stdout, "cannot create directory: " & subdir) - quit(1) - result = joinPath(subdir, tail) - #echo "completeGeneratedFilePath(", f, ") = ", result + conf.quitOrRaise "cannot create directory: " & subdir.string + result = subdir / RelativeFile f.string.splitPath.tail -proc rawFindFile(conf: ConfigRef; f: string; suppressStdlib: bool): string = +proc rawFindFile(conf: ConfigRef; f: RelativeFile; suppressStdlib: bool): AbsoluteFile = for it in conf.searchPaths: - if suppressStdlib and it.startsWith(conf.libpath): + if suppressStdlib and it.string.startsWith(conf.libpath.string): continue - result = joinPath(it, f) - if existsFile(result): + result = it / f + if fileExists(result): return canonicalizePath(conf, result) - result = "" + result = AbsoluteFile"" -proc rawFindFile2(conf: ConfigRef; f: string): string = +proc rawFindFile2(conf: ConfigRef; f: RelativeFile): AbsoluteFile = for i, it in conf.lazyPaths: - result = joinPath(it, f) - if existsFile(result): + result = it / f + if fileExists(result): # bring to front - for j in countDown(i,1): + for j in countdown(i, 1): swap(conf.lazyPaths[j], conf.lazyPaths[j-1]) return canonicalizePath(conf, result) - result = "" + result = AbsoluteFile"" template patchModule(conf: ConfigRef) {.dirty.} = - if result.len > 0 and conf.moduleOverrides.len > 0: - let key = getPackageName(conf, result) & "_" & splitFile(result).name + if not result.isEmpty and conf.moduleOverrides.len > 0: + let key = getPackageName(conf, result.string) & "_" & splitFile(result).name if conf.moduleOverrides.hasKey(key): let ov = conf.moduleOverrides[key] - if ov.len > 0: result = ov + if ov.len > 0: result = AbsoluteFile(ov) + +const stdlibDirs* = [ + "pure", "core", "arch", + "pure/collections", + "pure/concurrency", + "pure/unidecode", "impure", + "wrappers", "wrappers/linenoise", + "windows", "posix", "js", + "deprecated/pure"] -proc findFile*(conf: ConfigRef; f: string; suppressStdlib = false): string {.procvar.} = +const + pkgPrefix = "pkg/" + stdPrefix* = "std/" + +proc getRelativePathFromConfigPath*(conf: ConfigRef; f: AbsoluteFile, isTitle = false): RelativeFile = + result = RelativeFile("") + let f = $f + if isTitle: + for dir in stdlibDirs: + let path = conf.libpath.string / dir / f.lastPathPart + if path.cmpPaths(f) == 0: + return RelativeFile(stdPrefix & f.splitFile.name) + template search(paths) = + for it in paths: + let it = $it + if f.isRelativeTo(it): + return relativePath(f, it).RelativeFile + search(conf.searchPaths) + search(conf.lazyPaths) + +proc findFile*(conf: ConfigRef; f: string; suppressStdlib = false): AbsoluteFile = if f.isAbsolute: - result = if f.existsFile: f else: "" + result = if f.fileExists: AbsoluteFile(f) else: AbsoluteFile"" else: - result = rawFindFile(conf, f, suppressStdlib) - if result.len == 0: - result = rawFindFile(conf, f.toLowerAscii, suppressStdlib) - if result.len == 0: - result = rawFindFile2(conf, f) - if result.len == 0: - result = rawFindFile2(conf, f.toLowerAscii) + result = rawFindFile(conf, RelativeFile f, suppressStdlib) + if result.isEmpty: + result = rawFindFile(conf, RelativeFile f.toLowerAscii, suppressStdlib) + if result.isEmpty: + result = rawFindFile2(conf, RelativeFile f) + if result.isEmpty: + result = rawFindFile2(conf, RelativeFile f.toLowerAscii) patchModule(conf) -proc findModule*(conf: ConfigRef; modulename, currentModule: string): string = +proc findModule*(conf: ConfigRef; modulename, currentModule: string): AbsoluteFile = # returns path to module - const pkgPrefix = "pkg/" - let m = addFileExt(modulename, NimExt) + var m = addFileExt(modulename, NimExt) + var hasRelativeDot = false if m.startsWith(pkgPrefix): result = findFile(conf, m.substr(pkgPrefix.len), suppressStdlib = true) else: - let currentPath = currentModule.splitFile.dir - result = currentPath / m - if not existsFile(result): + 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): + result = AbsoluteFile path + break + 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) proc findProjectNimFile*(conf: ConfigRef; pkg: string): string = const extensions = [".nims", ".cfg", ".nimcfg", ".nimble"] - var candidates: seq[string] = @[] - for k, f in os.walkDir(pkg, relative=true): - if k == pcFile and f != "config.nims": - let (_, name, ext) = splitFile(f) - if ext in extensions: - let x = changeFileExt(pkg / name, ".nim") - if fileExists(x): - candidates.add x - for c in candidates: - # nim-foo foo or foo nfoo - if (pkg in c) or (c in pkg): return c - if candidates.len >= 1: - return candidates[0] + var + candidates: seq[string] = @[] + dir = pkg + prev = dir + nimblepkg = "" + let pkgname = pkg.lastPathPart() + while true: + for k, f in os.walkDir(dir, relative = true): + if k == pcFile and f != "config.nims": + let (_, name, ext) = splitFile(f) + if ext in extensions: + let x = changeFileExt(dir / name, ".nim") + if fileExists(x): + candidates.add x + if ext == ".nimble": + if nimblepkg.len == 0: + nimblepkg = name + # Since nimble packages can have their source in a subfolder, + # check the last folder we were in for a possible match. + if dir != prev: + let x = prev / x.extractFilename() + if fileExists(x): + candidates.add x + else: + # If we found more than one nimble file, chances are that we + # missed the real project file, or this is an invalid nimble + # package. Either way, bailing is the better choice. + return "" + let pkgname = if nimblepkg.len > 0: nimblepkg else: pkgname + for c in candidates: + if pkgname in c.extractFilename(): return c + if candidates.len > 0: + return candidates[0] + prev = dir + dir = parentDir(dir) + 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, {'(', ')', '.'}) @@ -601,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 @@ -609,11 +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 = @@ -624,9 +1063,28 @@ 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" of ideOutline: "outline" 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. + if conf != nil and conf.target.targetCPU == cpuI386: + #on Linux/BSD i386, double are aligned to 4bytes (except with -malign-double) + if conf.target.targetOS != osWindows: + # on i386 for all known POSIX systems, 64bits ints are aligned + # to 4bytes (except with -malign-double) + return 4 + return 8 diff --git a/compiler/packagehandling.nim b/compiler/packagehandling.nim index 2efab58b0..30f407792 100644 --- a/compiler/packagehandling.nim +++ b/compiler/packagehandling.nim @@ -15,10 +15,9 @@ iterator myParentDirs(p: string): string = if current.len == 0: break yield current -proc resetPackageCache*(conf: ConfigRef) = - conf.packageCache = newPackageCache() - -proc getPackageName*(conf: ConfigRef; path: 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): @@ -27,23 +26,19 @@ proc getPackageName*(conf: ConfigRef; path: string): string = return conf.packageCache[d] inc parents for file in walkFiles(d / "*.nimble"): - result = file.splitFile.name - break packageSearch - for file in walkFiles(d / "*.babel"): - result = file.splitFile.name + result = file break packageSearch # we also store if we didn't find anything: - if result.isNil: result = "" for d in myParentDirs(path): #echo "set cache ", d, " |", result, "|", parents conf.packageCache[d] = result dec parents if parents <= 0: break -proc withPackageName*(conf: ConfigRef; path: string): string = - let x = getPackageName(conf, path) - if x.len == 0: - result = path +proc getPackageName*(conf: ConfigRef; path: string): string = + ## returns nimble package name, e.g.: `cligen` + let path = getNimbleFile(conf, path) + if path.len > 0: + return path.splitFile.name else: - let (p, file, ext) = path.splitFile - result = (p / (x & '_' & file)) & ext + 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 944aec048..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, astalgo, 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. @@ -46,7 +48,7 @@ proc patternError(n: PNode; conf: ConfigRef) = localError(conf, n.info, "illformed AST: " & renderTree(n, {renderNoComments})) proc add(code: var TPatternCode, op: TOpcode) {.inline.} = - add(code, chr(ord(op))) + code.add chr(ord(op)) proc whichAlias*(p: PSym): TAliasRequest = if p.constraint != nil: @@ -57,29 +59,29 @@ proc whichAlias*(p: PSym): TAliasRequest = proc compileConstraints(p: PNode, result: var TPatternCode; conf: ConfigRef) = case p.kind of nkCallKinds: - if p.sons[0].kind != nkIdent: - patternError(p.sons[0], conf) + if p[0].kind != nkIdent: + patternError(p[0], conf) return - let op = p.sons[0].ident + let op = p[0].ident if p.len == 3: if op.s == "|" or op.id == ord(wOr): - compileConstraints(p.sons[1], result, conf) - compileConstraints(p.sons[2], result, conf) + compileConstraints(p[1], result, conf) + compileConstraints(p[2], result, conf) result.add(ppOr) elif op.s == "&" or op.id == ord(wAnd): - compileConstraints(p.sons[1], result, conf) - compileConstraints(p.sons[2], result, conf) + compileConstraints(p[1], result, conf) + compileConstraints(p[2], result, conf) result.add(ppAnd) else: patternError(p, conf) elif p.len == 2 and (op.s == "~" or op.id == ord(wNot)): - compileConstraints(p.sons[1], result, conf) + compileConstraints(p[1], result, conf) result.add(ppNot) else: patternError(p, conf) of nkAccQuoted, nkPar: if p.len == 1: - compileConstraints(p.sons[0], result, conf) + compileConstraints(p[0], result, conf) else: patternError(p, conf) of nkIdent: @@ -99,14 +101,14 @@ proc compileConstraints(p: PNode, result: var TPatternCode; conf: ConfigRef) = else: # check all symkinds: internalAssert conf, int(high(TSymKind)) < 255 - for i in low(TSymKind)..high(TSymKind): - if cmpIgnoreStyle(($i).substr(2), spec) == 0: + for i in TSymKind: + if cmpIgnoreStyle(i.toHumanStr, spec) == 0: result.add(ppSymKind) result.add(chr(i.ord)) return # check all nodekinds: internalAssert conf, int(high(TNodeKind)) < 255 - for i in low(TNodeKind)..high(TNodeKind): + for i in TNodeKind: if cmpIgnoreStyle($i, spec) == 0: result.add(ppNodeKind) result.add(chr(i.ord)) @@ -115,20 +117,19 @@ proc compileConstraints(p: PNode, result: var TPatternCode; conf: ConfigRef) = else: patternError(p, conf) -proc semNodeKindConstraints*(p: PNode; conf: ConfigRef): PNode = +proc semNodeKindConstraints*(n: PNode; conf: ConfigRef; start: Natural): PNode = ## does semantic checking for a node kind pattern and compiles it into an ## efficient internal format. - assert p.kind == nkCurlyExpr - result = newNodeI(nkStrLit, p.info) + result = newNodeI(nkStrLit, n.info) result.strVal = newStringOfCap(10) result.strVal.add(chr(aqNone.ord)) - if p.len >= 2: - for i in 1..<p.len: - compileConstraints(p.sons[i], result.strVal, conf) + if n.len >= 2: + for i in start..<n.len: + compileConstraints(n[i], result.strVal, conf) if result.strVal.len > MaxStackSize-1: - internalError(conf, p.info, "parameter pattern too complex") + internalError(conf, n.info, "parameter pattern too complex") else: - patternError(p, conf) + patternError(n, conf) result.strVal.add(ppEof) type @@ -139,13 +140,16 @@ proc checkForSideEffects*(n: PNode): TSideEffectAnalysis = case n.kind of nkCallKinds: # only calls can produce side effects: - let op = n.sons[0] + let op = n[0] if op.kind == nkSym and isRoutine(op.sym): 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 @@ -153,8 +157,8 @@ proc checkForSideEffects*(n: PNode): TSideEffectAnalysis = # indirect call: assume side effect: return seSideEffect # we need to check n[0] too: (FwithSideEffectButReturnsProcWithout)(args) - for i in 0 ..< n.len: - let ret = checkForSideEffects(n.sons[i]) + for i in 0..<n.len: + let ret = checkForSideEffects(n[i]) if ret == seSideEffect: return ret elif ret == seUnknown and result == seNoSideEffect: result = seUnknown @@ -164,8 +168,8 @@ proc checkForSideEffects*(n: PNode): TSideEffectAnalysis = else: # assume no side effect: result = seNoSideEffect - for i in 0 ..< n.len: - let ret = checkForSideEffects(n.sons[i]) + for i in 0..<n.len: + let ret = checkForSideEffects(n[i]) if ret == seSideEffect: return ret elif ret == seUnknown and result == seNoSideEffect: result = seUnknown @@ -177,9 +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 == tyVar 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,67 +216,91 @@ 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 of nkEmpty: - if n.typ != nil and n.typ.kind == tyVar: + if n.typ != nil and n.typ.kind in {tyVar}: result = arLValue of nkSym: - let kinds = if isUnsafeAddr: {skVar, skResult, skTemp, skParam, skLet} - else: {skVar, skResult, skTemp} - if n.sym.kind in kinds: - if owner != nil and owner == n.sym.owner and - sfGlobal notin n.sym.flags: - result = arLocalLValue + 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 n.sym.kind in {skParam, skLet, skForVar}: + result = arAddressableConst else: - result = arLValue - elif n.sym.kind == skParam and n.sym.typ.kind == tyVar: - 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 == tyVar: result = arStrange + if t.kind in {tyVar}: result = arStrange of nkDotExpr: - if skipTypes(n.sons[0].typ, abstractInst-{tyTypeDesc}).kind in - {tyVar, tyPtr, tyRef}: + let t = skipTypes(n[0].typ, abstractInst-{tyTypeDesc}) + if t.kind in {tyVar, tySink, tyPtr, tyRef}: result = arLValue + elif t.kind == tyLent: + result = arAddressableConst else: - result = isAssignable(owner, n.sons[0], isUnsafeAddr) + result = isAssignable(owner, n[0]) if result != arNone and n[1].kind == nkSym and sfDiscriminant in n[1].sym.flags: result = arDiscriminant of nkBracketExpr: - if skipTypes(n.sons[0].typ, abstractInst-{tyTypeDesc}).kind in - {tyVar, tyPtr, tyRef}: + let t = skipTypes(n[0].typ, abstractInst-{tyTypeDesc}) + if t.kind in {tyVar, tySink, tyPtr, tyRef}: result = arLValue + elif t.kind == tyLent: + result = arAddressableConst else: - result = isAssignable(owner, n.sons[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.sons[1], isUnsafeAddr) - elif compareTypes(n.typ, n.sons[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.sons[1], isUnsafeAddr) + result = isAssignable(owner, n[1]) of nkHiddenDeref: - if n[0].typ.kind == tyLent: result = arDiscriminant - else: result = arLValue + let n0 = n[0] + if n0.typ.kind == tyLent: + if n0.kind == nkSym and n0.sym.kind == skResult: + result = arLValue + else: + result = arLentValue + else: + result = arLValue of nkDerefExpr, nkHiddenAddr: result = arLValue of nkObjUpConv, nkObjDownConv, nkCheckedFieldExpr: - result = isAssignable(owner, n.sons[0], isUnsafeAddr) + result = isAssignable(owner, n[0]) of nkCallKinds: - # builtin slice keeps lvalue-ness: - if getMagic(n) in {mArrGet, mSlice}: - result = isAssignable(owner, n.sons[1], isUnsafeAddr) - elif n.typ != nil and n.typ.kind == tyVar: - 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 f575f3d7e..747505097 100644 --- a/compiler/parser.nim +++ b/compiler/parser.nim @@ -16,118 +16,166 @@ # 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 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, astalgo, 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(nimpretty2): +when defined(nimpretty): import layouter +when defined(nimPreviewSlimSystem): + import std/assertions + type - TParser* = object # A TParser object represents a file that - # is being parsed - currInd: int # current indentation level - firstTok, strongSpaces: bool # Has the first token been read? - # Is strongSpaces on? - hasProgress: bool # some while loop requires progress ensurance - lex*: TLexer # The lexer that is used for parsing - tok*: TToken # The current token - inPragma*: int # Pragma level + Parser* = object # A Parser object represents a file that + # is being parsed + currInd: int # current indentation level + firstTok: bool # Has the first token been read? + 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 defined(nimpretty2): - em: Emitter + when not defined(nimCustomAst): + emptyNode: PNode + when defined(nimpretty): + em*: Emitter SymbolMode = enum smNormal, smAllowNil, smAfterDot -proc parseAll*(p: var TParser): PNode -proc closeParser*(p: var TParser) -proc parseTopLevelStmt*(p: var TParser): PNode + PrimaryMode = enum + pmNormal, pmTypeDesc, pmTypeDef, pmTrySimple + +when defined(nimCustomAst): + # For the `customast` version we cannot share nodes, not even empty nodes: + template emptyNode(p: Parser): PNode = newNode(nkEmpty) # helpers for the other parsers -proc isOperator*(tok: TToken): bool -proc getTok*(p: var TParser) -proc parMessage*(p: TParser, msg: TMsgKind, arg: string = "") -proc skipComment*(p: var TParser, node: PNode) -proc newNodeP*(kind: TNodeKind, p: TParser): PNode -proc newIntNodeP*(kind: TNodeKind, intVal: BiggestInt, p: TParser): PNode -proc newFloatNodeP*(kind: TNodeKind, floatVal: BiggestFloat, p: TParser): PNode -proc newStrNodeP*(kind: TNodeKind, strVal: string, p: TParser): PNode -proc newIdentNodeP*(ident: PIdent, p: TParser): PNode -proc expectIdentOrKeyw*(p: TParser) -proc expectIdent*(p: TParser) -proc parLineInfo*(p: TParser): TLineInfo -proc eat*(p: var TParser, tokType: TTokType) -proc skipInd*(p: var TParser) -proc optPar*(p: var TParser) -proc optInd*(p: var TParser, n: PNode) -proc indAndComment*(p: var TParser, n: PNode) -proc setBaseFlags*(n: PNode, base: TNumericalBase) -proc parseSymbol*(p: var TParser, mode = smNormal): PNode -proc parseTry(p: var TParser; isExpr: bool): PNode -proc parseCase(p: var TParser): PNode -proc parseStmtPragma(p: var TParser): PNode -proc parsePragma(p: var TParser): PNode -proc postExprBlocks(p: var TParser, x: PNode): PNode -proc parseExprStmt(p: var TParser): PNode -proc parseBlock(p: var TParser): PNode +proc isOperator*(tok: Token): bool +proc getTok*(p: var Parser) +proc parMessage*(p: Parser, msg: TMsgKind, arg: string = "") +proc skipComment*(p: var Parser, node: PNode) +proc newNodeP*(kind: TNodeKind, p: Parser): PNode +proc newIntNodeP*(kind: TNodeKind, intVal: BiggestInt, p: Parser): PNode +proc newFloatNodeP*(kind: TNodeKind, floatVal: BiggestFloat, 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) +proc parLineInfo*(p: Parser): TLineInfo +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, maybeMissEquals = false) +proc setBaseFlags*(n: PNode, base: NumericalBase) +proc parseSymbol*(p: var Parser, mode = smNormal): PNode +proc parseTry(p: var Parser; isExpr: bool): PNode +proc parseCase(p: var Parser): PNode +proc parseStmtPragma(p: var Parser): PNode +proc parsePragma(p: var Parser): PNode +proc postExprBlocks(p: var Parser, x: PNode): PNode +proc parseExprStmt(p: var Parser): PNode +proc parseBlock(p: var Parser): PNode +proc primary(p: var Parser, mode: PrimaryMode): PNode +proc simpleExprAux(p: var Parser, limit: int, mode: PrimaryMode): PNode + # implementation -proc getTok(p: var TParser) = +template prettySection(body) = + when defined(nimpretty): beginSection(p.em) + body + when defined(nimpretty): endSection(p.em) + +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(nimpretty2): + when defined(nimpretty): emitTok(p.em, p.lex, p.tok) + # skip the additional tokens that nimpretty needs but the parser has no + # interest in: while p.tok.tokType == tkComment: rawGetTok(p.lex, p.tok) emitTok(p.em, p.lex, p.tok) -proc openParser*(p: var TParser, fileIdx: FileIndex, inputStream: PLLStream, - cache: IdentCache; config: ConfigRef; - strongSpaces=false) = +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(nimpretty2): + when defined(nimpretty): openEmitter(p.em, cache, config, fileIdx) getTok(p) # read the first token p.firstTok = true - p.strongSpaces = strongSpaces - p.emptyNode = newNode(nkEmpty) + when not defined(nimCustomAst): + p.emptyNode = newNode(nkEmpty) -proc openParser*(p: var TParser, filename: string, inputStream: PLLStream, - cache: IdentCache; config: ConfigRef; - strongSpaces=false) = - openParser(p, fileInfoIdx(config, filename), inputStream, cache, config, strongSpaces) +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 TParser) = +proc closeParser*(p: var Parser) = ## Close a parser, freeing up its resources. closeLexer(p.lex) - when defined(nimpretty2): - closeEmitter(p.em) -proc parMessage(p: TParser, msg: TMsgKind, arg = "") = +proc parMessage(p: Parser, msg: TMsgKind, arg = "") = ## Produce and emit the parser message `arg` to output. lexMessageTok(p.lex, msg, p.tok, arg) -proc parMessage(p: TParser, msg: string, tok: TToken) = +proc parMessage(p: Parser, msg: string, tok: Token) = ## Produce and emit a parser message to output about the token `tok` parMessage(p, errGenerated, msg % prettyTok(tok)) -proc parMessage(p: TParser, arg: string) = +proc parMessage(p: Parser, arg: string) = ## Produce and emit the parser message `arg` to output. lexMessageTok(p.lex, errGenerated, p.tok, arg) @@ -137,169 +185,135 @@ template withInd(p, body: untyped) = body p.currInd = oldInd +template newlineWasSplitting(p: var Parser) = + when defined(nimpretty): + layouter.newlineWasSplitting(p.em) + template realInd(p): bool = p.tok.indent > p.currInd template sameInd(p): bool = p.tok.indent == p.currInd template sameOrNoInd(p): bool = p.tok.indent == p.currInd or p.tok.indent < 0 -proc rawSkipComment(p: var TParser, node: PNode) = +proc validInd(p: var Parser): bool {.inline.} = + result = p.tok.indent < 0 or p.tok.indent > p.currInd + +proc rawSkipComment(p: var Parser, node: PNode) = if p.tok.tokType == tkComment: if node != nil: - if node.comment == nil: node.comment = "" + var rhs = node.comment when defined(nimpretty): if p.tok.commentOffsetB > p.tok.commentOffsetA: - add node.comment, 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: - add node.comment, p.tok.literal + rhs.add p.tok.literal else: - add(node.comment, p.tok.literal) + rhs.add p.tok.literal + node.comment = move rhs else: parMessage(p, errInternal, "skipComment") getTok(p) -proc skipComment(p: var TParser, node: PNode) = +proc skipComment(p: var Parser, node: PNode) = if p.tok.indent < 0: rawSkipComment(p, node) -proc flexComment(p: var TParser, node: PNode) = +proc flexComment(p: var Parser, node: PNode) = if p.tok.indent < 0 or realInd(p): rawSkipComment(p, node) const errInvalidIndentation = "invalid indentation" errIdentifierExpected = "identifier expected, but got '$1'" errExprExpected = "expression expected, but found '$1'" - errTokenExpected = "'$1' expected" -proc skipInd(p: var TParser) = +proc skipInd(p: var Parser) = if p.tok.indent >= 0: if not realInd(p): parMessage(p, errInvalidIndentation) -proc optPar(p: var TParser) = +proc optPar(p: var Parser) = if p.tok.indent >= 0: if p.tok.indent < p.currInd: parMessage(p, errInvalidIndentation) -proc optInd(p: var TParser, n: PNode) = +proc optInd(p: var Parser, n: PNode) = skipComment(p, n) skipInd(p) -proc getTokNoInd(p: var TParser) = +proc getTokNoInd(p: var Parser) = getTok(p) if p.tok.indent >= 0: parMessage(p, errInvalidIndentation) -proc expectIdentOrKeyw(p: TParser) = +proc expectIdentOrKeyw(p: Parser) = if p.tok.tokType != tkSymbol and not isKeyword(p.tok.tokType): lexMessage(p.lex, errGenerated, errIdentifierExpected % prettyTok(p.tok)) -proc expectIdent(p: TParser) = +proc expectIdent(p: Parser) = if p.tok.tokType != tkSymbol: lexMessage(p.lex, errGenerated, errIdentifierExpected % prettyTok(p.tok)) -proc eat(p: var TParser, tokType: TTokType) = +proc eat(p: var Parser, tokType: TokType) = ## Move the parser to the next token if the current token is of type ## `tokType`, otherwise error. if p.tok.tokType == tokType: getTok(p) else: lexMessage(p.lex, errGenerated, - "expected: '" & TokTypeToStr[tokType] & "', but got: '" & prettyTok(p.tok) & "'") + "expected: '" & $tokType & "', but got: '" & prettyTok(p.tok) & "'") -proc parLineInfo(p: TParser): TLineInfo = +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 TParser, 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: TParser): PNode = - result = newNodeI(kind, parLineInfo(p)) +proc newNodeP(kind: TNodeKind, p: Parser): PNode = + result = newNode(kind, parLineInfo(p)) -proc newIntNodeP(kind: TNodeKind, intVal: BiggestInt, p: TParser): PNode = - result = newNodeP(kind, p) - result.intVal = intVal +proc newIntNodeP(kind: TNodeKind, intVal: BiggestInt, p: Parser): PNode = + result = newAtom(kind, intVal, parLineInfo(p)) proc newFloatNodeP(kind: TNodeKind, floatVal: BiggestFloat, - p: TParser): PNode = - result = newNodeP(kind, p) - result.floatVal = floatVal + p: Parser): PNode = + result = newAtom(kind, floatVal, parLineInfo(p)) -proc newStrNodeP(kind: TNodeKind, strVal: string, p: TParser): 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: TParser): PNode = - result = newNodeP(nkIdent, p) - result.ident = ident +proc newIdentNodeP(ident: PIdent, p: Parser): PNode = + result = newAtom(ident, parLineInfo(p)) -proc parseExpr(p: var TParser): PNode -proc parseStmt(p: var TParser): PNode -proc parseTypeDesc(p: var TParser): PNode -proc parseParamList(p: var TParser, retColon = true): PNode +proc parseExpr(p: var Parser): PNode +proc parseStmt(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: TToken): bool {.inline.} = +proc isSigilLike(tok: Token): bool {.inline.} = result = tok.tokType == tkOpr and tok.ident.s[0] == '@' -proc isRightAssociative(tok: TToken): bool {.inline.} = +proc isRightAssociative(tok: Token): bool {.inline.} = ## Determines whether the token is right assocative. result = tok.tokType == tkOpr and tok.ident.s[0] == '^' - # or (let L = tok.ident.s.len; L > 1 and tok.ident.s[L-1] == '>')) - -proc getPrecedence(tok: TToken, strongSpaces: bool): int = - ## Calculates the precedence of the given token. - template considerStrongSpaces(x): untyped = - x + (if strongSpaces: 100 - tok.strongSpaceA.int*10 else: 0) - - case tok.tokType - of tkOpr: - let L = tok.ident.s.len - let relevantChar = tok.ident.s[0] - - # arrow like? - if L > 1 and tok.ident.s[L-1] == '>' and - tok.ident.s[L-2] in {'-', '~', '='}: return considerStrongSpaces(1) - - template considerAsgn(value: untyped) = - result = if tok.ident.s[L-1] == '=': 1 else: value - - case relevantChar - of '$', '^': considerAsgn(10) - of '*', '%', '/', '\\': considerAsgn(9) - of '~': result = 8 - of '+', '-', '|': considerAsgn(8) - of '&': considerAsgn(7) - of '=', '<', '>', '!': result = 5 - of '.': considerAsgn(6) - of '?': result = 2 - else: considerAsgn(2) - of tkDiv, tkMod, tkShl, tkShr: result = 9 - of tkIn, tkNotin, tkIs, tkIsnot, tkNot, tkOf, tkAs: result = 5 - of tkDotDot: result = 6 - of tkAnd: result = 4 - of tkOr, tkXor, tkPtr, tkRef: result = 3 - else: return -10 - result = considerStrongSpaces(result) - -proc isOperator(tok: TToken): 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, tkDotDot, tkAnd, tkOr, tkXor} + # or (tok.ident.s.len > 1 and tok.ident.s[^1] == '>') -proc isUnary(p: TParser): bool = - ## Check if the current parser token is a unary operator - if p.tok.tokType in {tkOpr, tkDotDot} and - p.tok.strongSpaceB == 0 and - p.tok.strongSpaceA > 0: - result = true +proc isUnary(tok: Token): bool = + ## Check if the given token is a unary operator + tok.tokType in {tkOpr, tkDotDot} and + tok.spacing == {tsLeading} -proc checkBinary(p: TParser) {.inline.} = +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 != p.tok.strongSpaceB: + if p.tok.spacing == {tsTrailing}: parMessage(p, warnInconsistentSpacing, prettyTok(p.tok)) -#| module = stmt ^* (';' / IND{=}) +#| module = complexOrSimpleStmt ^* (';' / IND{=}) #| #| comma = ',' COMMENT? #| semicolon = ';' COMMENT? @@ -308,12 +322,12 @@ proc checkBinary(p: TParser) {.inline.} = #| #| operator = OP0 | OP1 | OP2 | OP3 | OP4 | OP5 | OP6 | OP7 | OP8 | OP9 #| | 'or' | 'xor' | 'and' -#| | 'is' | 'isnot' | 'in' | 'notin' | 'of' -#| | 'div' | 'mod' | 'shl' | 'shr' | 'not' | 'static' | '..' +#| | 'is' | 'isnot' | 'in' | 'notin' | 'of' | 'as' | 'from' +#| | 'div' | 'mod' | 'shl' | 'shr' | 'not' | '..' #| #| prefixOperator = operator #| -#| optInd = COMMENT? +#| optInd = COMMENT? IND? #| optPar = (IND{>} | IND{=})? #| #| simpleExpr = arrowExpr (OP0 optInd arrowExpr)* pragma? @@ -328,19 +342,36 @@ proc checkBinary(p: TParser) {.inline.} = #| mulExpr = dollarExpr (OP9 optInd dollarExpr)* #| dollarExpr = primary (OP10 optInd primary)* -proc colcom(p: var TParser, n: PNode) = +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) -proc parseSymbol(p: var TParser, mode = smNormal): PNode = +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) getTok(p) of tokKeywordLow..tokKeywordHigh: - if p.tok.tokType == tkAddr or p.tok.tokType == tkType or mode == smAfterDot: + if p.tok.tokType in tkBuiltInMagics or mode == smAfterDot: # for backwards compatibility these 2 are always valid: result = newIdentNodeP(p.tok.ident, p) getTok(p) @@ -357,18 +388,20 @@ proc parseSymbol(p: var TParser, 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: + let lineinfo = parLineInfo(p) var accm = "" while p.tok.tokType in {tkOpr, tkDot, tkDotDot, tkEquals, tkParLe..tkParDotRi}: - accm.add(tokToStr(p.tok)) + accm.add($p.tok) getTok(p) - result.add(newIdentNodeP(p.lex.cache.getIdent(accm), p)) - of tokKeywordLow..tokKeywordHigh, tkSymbol, tkIntLit..tkCharLit: - result.add(newIdentNodeP(p.lex.cache.getIdent(tokToStr(p.tok)), p)) + let node = newAtom(p.lex.cache.getIdent(accm), lineinfo) + result.add(node) + of tokKeywordLow..tokKeywordHigh, tkSymbol, tkIntLit..tkCustomLit: + result.add(newIdentNodeP(p.lex.cache.getIdent($p.tok), p)) getTok(p) else: parMessage(p, errIdentifierExpected, p.tok) @@ -381,180 +414,251 @@ proc parseSymbol(p: var TParser, mode = smNormal): PNode = # if it is a keyword: #if not isKeyword(p.tok.tokType): getTok(p) result = p.emptyNode + setEndInfo() -proc colonOrEquals(p: var TParser, a: PNode): PNode = - if p.tok.tokType == tkColon: - result = newNodeP(nkExprColonExpr, p) - getTok(p) - #optInd(p, result) - addSon(result, a) - addSon(result, parseExpr(p)) - elif p.tok.tokType == tkEquals: +proc equals(p: var Parser, a: PNode): PNode = + if p.tok.tokType == tkEquals: result = newNodeP(nkExprEqExpr, p) getTok(p) #optInd(p, result) - addSon(result, a) - addSon(result, parseExpr(p)) + result.add(a) + result.add(parseExpr(p)) else: result = a -proc exprColonEqExpr(p: var TParser): PNode = - #| exprColonEqExpr = expr (':'|'=' expr)? +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 = equals(p, a) + +proc exprColonEqExpr(p: var Parser): PNode = + #| exprColonEqExpr = expr ((':'|'=') expr + #| / doBlock extraPostExprBlock*)? var a = parseExpr(p) if p.tok.tokType == tkDo: result = postExprBlocks(p, a) else: result = colonOrEquals(p, a) -proc exprList(p: var TParser, endTok: TTokType, result: PNode) = +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(nimpretty2): + when defined(nimpretty): + inc p.em.doIndentMore + 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) - addSon(result, a) + result.add(a) if p.tok.tokType != tkComma: break getTok(p) optInd(p, a) - when defined(nimpretty2): + when defined(nimpretty): dec p.em.doIndentMore -proc exprColonEqExprListAux(p: var TParser, endTok: TTokType, result: PNode) = +proc exprColonEqExprListAux(p: var Parser, endTok: TokType, result: PNode) = assert(endTok in {tkCurlyRi, tkCurlyDotRi, tkBracketRi, tkParRi}) getTok(p) - optInd(p, result) + flexComment(p, result) + optPar(p) # progress guaranteed while p.tok.tokType != endTok and p.tok.tokType != tkEof: var a = exprColonEqExpr(p) - addSon(result, a) + result.add(a) if p.tok.tokType != tkComma: break + elif result.kind == nkPar: + result.transitionSonsKind(nkTupleConstr) getTok(p) - # (1,) produces a tuple expression - if endTok == tkParRi and p.tok.tokType == tkParRi and result.kind == nkPar: - result.kind = nkTupleConstr skipComment(p, a) optPar(p) eat(p, endTok) -proc exprColonEqExprList(p: var TParser, kind: TNodeKind, - endTok: TTokType): PNode = +proc exprColonEqExprList(p: var Parser, kind: TNodeKind, + endTok: TokType): PNode = #| exprColonEqExprList = exprColonEqExpr (comma exprColonEqExpr)* (comma)? result = newNodeP(kind, p) exprColonEqExprListAux(p, endTok, result) -proc dotExpr(p: var TParser, a: PNode): PNode = - #| dotExpr = expr '.' optInd (symbol | '[:' exprList ']') - #| explicitGenericInstantiation = '[:' exprList ']' ( '(' exprColonEqExpr ')' )? +proc dotExpr(p: var Parser, a: PNode): PNode = var info = p.parLineInfo getTok(p) - result = newNodeI(nkDotExpr, info) + result = newNode(nkDotExpr, info) optInd(p, result) - addSon(result, a) - addSon(result, parseSymbol(p, smAfterDot)) - if p.tok.tokType == tkBracketLeColon and p.tok.strongSpaceA <= 0: - var x = newNodeI(nkBracketExpr, p.parLineInfo) + result.add(a) + result.add(parseSymbol(p, smAfterDot)) + 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 qualifiedIdent(p: var TParser): PNode = - #| qualifiedIdent = symbol ('.' optInd symbol)? +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 symbolOrKeyword)? result = parseSymbol(p) if p.tok.tokType == tkDot: result = dotExpr(p, result) -proc setOrTableConstr(p: var TParser): PNode = +proc setOrTableConstr(p: var Parser): PNode = #| setOrTableConstr = '{' ((exprColonEqExpr comma)* | ':' ) '}' result = newNodeP(nkCurly, p) getTok(p) # skip '{' optInd(p, result) if p.tok.tokType == tkColon: getTok(p) # skip ':' - result.kind = nkTableConstr + result.transitionSonsKind(nkTableConstr) else: # progress guaranteed while p.tok.tokType notin {tkCurlyRi, tkEof}: var a = exprColonEqExpr(p) - if a.kind == nkExprColonExpr: result.kind = nkTableConstr - addSon(result, a) + if a.kind == nkExprColonExpr: result.transitionSonsKind(nkTableConstr) + result.add(a) if p.tok.tokType != tkComma: break getTok(p) skipComment(p, a) optPar(p) eat(p, tkCurlyRi) # skip '}' -proc parseCast(p: var TParser): PNode = - #| castExpr = 'cast' '[' optInd typeDesc optPar ']' '(' optInd expr optPar ')' +proc parseCast(p: var Parser): PNode = + #| castExpr = 'cast' ('[' optInd typeDesc optPar ']' '(' optInd expr optPar ')') / + # ('(' optInd exprColonEqExpr optPar ')') result = newNodeP(nkCast, p) getTok(p) - eat(p, tkBracketLe) - optInd(p, result) - addSon(result, parseTypeDesc(p)) - optPar(p) - eat(p, tkBracketRi) - eat(p, tkParLe) - optInd(p, result) - addSon(result, parseExpr(p)) + if p.tok.tokType == tkBracketLe: + getTok(p) + optInd(p, result) + result.add(parseTypeDesc(p)) + optPar(p) + eat(p, tkBracketRi) + eat(p, tkParLe) + optInd(p, result) + result.add(parseExpr(p)) + else: + result.add p.emptyNode + eat(p, tkParLe) + optInd(p, result) + 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: TNumericalBase) = +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 TParser, a: PNode): PNode = +proc parseGStrLit(p: var Parser, a: PNode): PNode = case p.tok.tokType of tkGStrLit: result = newNodeP(nkCallStrLit, p) - addSon(result, a) - addSon(result, newStrNodeP(nkRStrLit, p.tok.literal, p)) + result.add(a) + result.add(newStrNodeP(nkRStrLit, p.tok.literal, p)) getTok(p) of tkGTripleStrLit: result = newNodeP(nkCallStrLit, p) - addSon(result, a) - addSon(result, newStrNodeP(nkTripleStrLit, p.tok.literal, p)) + result.add(a) + result.add(newStrNodeP(nkTripleStrLit, p.tok.literal, p)) getTok(p) else: result = a + setEndInfo() -type - TPrimaryMode = enum pmNormal, pmTypeDesc, pmTypeDef, pmSkipSuffix - -proc complexOrSimpleStmt(p: var TParser): PNode -proc simpleExpr(p: var TParser, mode = pmNormal): PNode +proc complexOrSimpleStmt(p: var Parser): PNode +proc simpleExpr(p: var Parser, mode = pmNormal): PNode +proc parseIfOrWhenExpr(p: var Parser, kind: TNodeKind): PNode -proc semiStmtList(p: var TParser, result: PNode) = +proc semiStmtList(p: var Parser, result: PNode) = inc p.inSemiStmtList - result.add(complexOrSimpleStmt(p)) - # progress guaranteed - while p.tok.tokType == tkSemiColon: - getTok(p) - optInd(p, result) - result.add(complexOrSimpleStmt(p)) + withInd(p): + # Be lenient with the first stmt/expr + 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: + if p.tok.tokType == tkSemiColon: + getTok(p) + if p.tok.tokType == tkParRi: + break + elif not (sameInd(p) or realInd(p)): + parMessage(p, errInvalidIndentation) + let a = complexOrSimpleStmt(p) + if a.kind == nkEmpty: + parMessage(p, errExprExpected, p.tok) + getTok(p) + else: + result.add a dec p.inSemiStmtList - result.kind = nkStmtListExpr + result.transitionSonsKind(nkStmtListExpr) -proc parsePar(p: var TParser): PNode = +proc parsePar(p: var Parser): PNode = #| parKeyw = 'discard' | 'include' | 'if' | 'while' | 'case' | 'try' #| | 'finally' | 'except' | 'for' | 'block' | 'const' | 'let' #| | 'when' | 'var' | 'mixin' #| par = '(' optInd - #| ( &parKeyw complexOrSimpleStmt ^+ ';' - #| | ';' complexOrSimpleStmt ^+ ';' + #| ( &parKeyw (ifExpr / complexOrSimpleStmt) ^+ ';' + #| | ';' (ifExpr / complexOrSimpleStmt) ^+ ';' #| | pragmaStmt - #| | simpleExpr ( ('=' expr (';' complexOrSimpleStmt ^+ ';' )? ) + #| | simpleExpr ( (doBlock extraPostExprBlock*) + #| | ('=' expr (';' (ifExpr / complexOrSimpleStmt) ^+ ';' )? ) #| | (':' expr (',' exprColonEqExpr ^+ ',' )? ) ) ) #| optPar ')' # @@ -563,9 +667,10 @@ proc parsePar(p: var TParser): PNode = result = newNodeP(nkPar, p) getTok(p) optInd(p, result) + flexComment(p, result) if p.tok.tokType in {tkDiscard, tkInclude, tkIf, tkWhile, tkCase, - tkTry, tkDefer, tkFinally, tkExcept, tkFor, tkBlock, - tkConst, tkLet, tkWhen, tkVar, + tkTry, tkDefer, tkFinally, tkExcept, tkBlock, + tkConst, tkLet, tkWhen, tkVar, tkFor, tkMixin}: # XXX 'bind' used to be an expression, so we exclude it here; # tests/reject/tbind2 fails otherwise. @@ -577,7 +682,10 @@ proc parsePar(p: var TParser): 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) @@ -598,38 +706,40 @@ proc parsePar(p: var TParser): 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.kind = nkTupleConstr + result.transitionSonsKind(nkTupleConstr) # progress guaranteed while p.tok.tokType != tkParRi and p.tok.tokType != tkEof: var a = exprColonEqExpr(p) - addSon(result, a) + result.add(a) if p.tok.tokType != tkComma: break getTok(p) skipComment(p, a) optPar(p) eat(p, tkParRi) + setEndInfo() -proc identOrLiteral(p: var TParser, mode: TPrimaryMode): PNode = +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 ']' case p.tok.tokType - of tkSymbol, tkType, tkAddr: + of tkSymbol, tkBuiltInMagics, tkOut: result = newIdentNodeP(p.tok.ident, p) getTok(p) result = parseGStrLit(p, result) @@ -703,6 +813,14 @@ proc identOrLiteral(p: var TParser, mode: TPrimaryMode): 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) @@ -722,286 +840,254 @@ proc identOrLiteral(p: var TParser, mode: TPrimaryMode): PNode = result = parseCast(p) else: parMessage(p, errExprExpected, p.tok) - getTok(p) # we must consume a token here to prevend endless loops! + getTok(p) # we must consume a token here to prevent endless loops! result = p.emptyNode -proc namedParams(p: var TParser, callee: PNode, - kind: TNodeKind, endTok: TTokType): PNode = +proc namedParams(p: var Parser, callee: PNode, + kind: TNodeKind, endTok: TokType): PNode = let a = callee result = newNodeP(kind, p) - addSon(result, a) + result.add(a) # progress guaranteed exprColonEqExprListAux(p, endTok, result) -proc commandParam(p: var TParser, isFirstParam: var bool): PNode = - 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) - addSon(result, lhs) - addSon(result, parseExpr(p)) +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) isFirstParam = false -proc primarySuffix(p: var TParser, r: PNode, baseIndent: int): PNode = - #| primarySuffix = '(' (exprColonEqExpr comma?)* ')' doBlocks? - #| | doBlocks - #| | '.' optInd symbol generalizedLit? - #| | '[' optInd indexExprList optPar ']' - #| | '{' optInd indexExprList optPar '}' - #| | &( '`'|IDENT|literal|'cast'|'addr'|'type') expr # command syntax +proc commandExpr(p: var Parser; r: PNode; mode: PrimaryMode): PNode = + 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 symbolOrKeyword ('[:' exprList ']' ( '(' exprColonEqExpr ')' )?)? generalizedLit? + #| | DOTLIKEOP optInd symbolOrKeyword generalizedLit? + #| | '[' optInd exprColonEqExprList optPar ']' + #| | '{' optInd exprColonEqExprList optPar '}' + # XXX strong spaces need to be reflected above result = r - template somePar() = - if p.tok.strongSpaceA > 0: break # progress guaranteed while p.tok.indent < 0 or (p.tok.tokType == tkDot and p.tok.indent >= baseIndent): case p.tok.tokType of tkParLe: # progress guaranteed - somePar() + if tsLeading in p.tok.spacing: + result = commandExpr(p, result, mode) + break result = namedParams(p, result, nkCall, tkParRi) - if result.len > 1 and result.sons[1].kind == nkExprColonExpr: - result.kind = nkObjConstr + if result.has2Sons and result.secondSon.kind == nkExprColonExpr: + result.transitionSonsKind(nkObjConstr) of tkDot: # progress guaranteed result = dotExpr(p, result) result = parseGStrLit(p, result) of tkBracketLe: # progress guaranteed - somePar() + if tsLeading in p.tok.spacing: + result = commandExpr(p, result, mode) + break result = namedParams(p, result, nkBracketExpr, tkBracketRi) of tkCurlyLe: # progress guaranteed - somePar() + 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, tkAddr, tkType, - tkOpr, tkDotDot: - if p.inPragma == 0 and (isUnary(p) 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 - let a = result - result = newNodeP(nkCommand, p) - addSon(result, a) - var isFirstParam = true - when true: - # progress NOT guaranteed - p.hasProgress = false - addSon result, commandParam(p, isFirstParam) - if not p.hasProgress: break - else: - while p.tok.tokType != tkEof: - let x = parseExpr(p) - addSon(result, x) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, x) - result = postExprBlocks(p, result) - break + 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 + # command syntax, with the exception of expressions such as + # `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. + 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 -proc primary(p: var TParser, mode: TPrimaryMode): PNode -proc simpleExprAux(p: var TParser, limit: int, mode: TPrimaryMode): PNode - -proc parseOperators(p: var TParser, headNode: PNode, - limit: int, mode: TPrimaryMode): PNode = +proc parseOperators(p: var Parser, headNode: PNode, + limit: int, mode: PrimaryMode): PNode = result = headNode # expand while operators have priorities higher than 'limit' - var opPrec = getPrecedence(p.tok, p.strongSpaces) + var opPrec = getPrecedence(p.tok) let modeB = if mode == pmTypeDef: pmTypeDesc else: mode # the operator itself must not start on a new line: # progress guaranteed - while opPrec >= limit and p.tok.indent < 0 and not isUnary(p): + while opPrec >= limit and p.tok.indent < 0 and not isUnary(p.tok): checkBinary(p) - var leftAssoc = 1-ord(isRightAssociative(p.tok)) + let leftAssoc = ord(not isRightAssociative(p.tok)) var a = newNodeP(nkInfix, p) var opNode = newIdentNodeP(p.tok.ident, p) # skip operator: getTok(p) - optInd(p, a) + flexComment(p, a) + optPar(p) # read sub-expression with higher priority: var b = simpleExprAux(p, opPrec + leftAssoc, modeB) - addSon(a, opNode) - addSon(a, result) - addSon(a, b) + a.add(opNode) + a.add(result) + a.add(b) result = a - opPrec = getPrecedence(p.tok, p.strongSpaces) + opPrec = getPrecedence(p.tok) + setEndInfo() -proc simpleExprAux(p: var TParser, limit: int, mode: TPrimaryMode): PNode = +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) - pragmaExp.addSon result - pragmaExp.addSon p.parsePragma + pragmaExp.add result + pragmaExp.add p.parsePragma result = pragmaExp result = parseOperators(p, result, limit, mode) -proc simpleExpr(p: var TParser, mode = pmNormal): PNode = - when defined(nimpretty2): +proc simpleExpr(p: var Parser, mode = pmNormal): PNode = + when defined(nimpretty): inc p.em.doIndentMore result = simpleExprAux(p, -1, mode) - when defined(nimpretty2): + when defined(nimpretty): dec p.em.doIndentMore -proc parseIfExpr(p: var TParser, kind: TNodeKind): PNode = - #| condExpr = expr colcom expr optInd - #| ('elif' expr colcom expr optInd)* - #| 'else' colcom expr - #| ifExpr = 'if' condExpr - #| whenExpr = 'when' condExpr - when true: - result = newNodeP(kind, p) - while true: - getTok(p) # skip `if`, `when`, `elif` - var branch = newNodeP(nkElifExpr, p) - optInd(p, branch) - addSon(branch, parseExpr(p)) - colcom(p, branch) - addSon(branch, parseStmt(p)) - skipComment(p, branch) - addSon(result, branch) - if p.tok.tokType != tkElif: break # or not sameOrNoInd(p): break - if p.tok.tokType == tkElse: # and sameOrNoInd(p): - var branch = newNodeP(nkElseExpr, p) - eat(p, tkElse) - colcom(p, branch) - addSon(branch, parseStmt(p)) - addSon(result, branch) - else: - var - b: PNode - wasIndented = false - result = newNodeP(kind, p) - - getTok(p) - let branch = newNodeP(nkElifExpr, p) - addSon(branch, parseExpr(p)) - colcom(p, branch) - let oldInd = p.currInd - if realInd(p): - p.currInd = p.tok.indent - wasIndented = true - addSon(branch, parseExpr(p)) - result.add branch - while sameInd(p) or not wasIndented: - case p.tok.tokType - of tkElif: - b = newNodeP(nkElifExpr, p) - getTok(p) - optInd(p, b) - addSon(b, parseExpr(p)) - of tkElse: - b = newNodeP(nkElseExpr, p) - getTok(p) - else: break - colcom(p, b) - addSon(b, parseStmt(p)) - addSon(result, b) - if b.kind == nkElseExpr: break - if wasIndented: - p.currInd = oldInd - -proc parsePragma(p: var TParser): PNode = - #| pragma = '{.' optInd (exprColonExpr comma?)* optPar ('.}' | '}') +proc parsePragma(p: var Parser): PNode = + #| pragma = '{.' optInd (exprColonEqExpr comma?)* optPar ('.}' | '}') result = newNodeP(nkPragma, p) inc p.inPragma + when defined(nimpretty): + inc p.em.doIndentMore + inc p.em.keepIndents getTok(p) optInd(p, result) while p.tok.tokType notin {tkCurlyDotRi, tkCurlyRi, tkEof}: p.hasProgress = false var a = exprColonEqExpr(p) if not p.hasProgress: break - addSon(result, a) + result.add(a) if p.tok.tokType == tkComma: getTok(p) skipComment(p, a) optPar(p) if p.tok.tokType in {tkCurlyDotRi, tkCurlyRi}: - when defined(nimpretty2): + when defined(nimpretty): if p.tok.tokType == tkCurlyRi: curlyRiWasPragma(p.em) getTok(p) else: parMessage(p, "expected '.}'") dec p.inPragma + when defined(nimpretty): + dec p.em.doIndentMore + dec p.em.keepIndents + setEndInfo() -proc identVis(p: var TParser; allowDot=false): PNode = - #| identVis = symbol opr? # postfix position - #| identVisDot = symbol '.' optInd symbol opr? +proc identVis(p: var Parser; allowDot=false): PNode = + #| identVis = symbol OPR? # postfix position + #| identVisDot = symbol '.' optInd symbolOrKeyword OPR? var a = parseSymbol(p) if p.tok.tokType == tkOpr: - when defined(nimpretty2): + when defined(nimpretty): starWasExportMarker(p.em) result = newNodeP(nkPostfix, p) - addSon(result, newIdentNodeP(p.tok.ident, p)) - addSon(result, a) + result.add(newIdentNodeP(p.tok.ident, p)) + result.add(a) getTok(p) elif p.tok.tokType == tkDot and allowDot: result = dotExpr(p, a) else: result = a -proc identWithPragma(p: var TParser; allowDot=false): PNode = +proc identWithPragma(p: var Parser; allowDot=false): PNode = #| identWithPragma = identVis pragma? #| identWithPragmaDot = identVisDot pragma? var a = identVis(p, allowDot) if p.tok.tokType == tkCurlyDotLe: result = newNodeP(nkPragmaExpr, p) - addSon(result, a) - addSon(result, parsePragma(p)) + result.add(a) + result.add(parsePragma(p)) else: result = a type - TDeclaredIdentFlag = enum + DeclaredIdentFlag = enum withPragma, # identifier may have pragma withBothOptional # both ':' and '=' parts are optional withDot # allow 'var ident.ident = value' - TDeclaredIdentFlags = set[TDeclaredIdentFlag] + DeclaredIdentFlags = set[DeclaredIdentFlag] -proc parseIdentColonEquals(p: var TParser, flags: TDeclaredIdentFlags): PNode = +proc parseIdentColonEquals(p: var Parser, flags: DeclaredIdentFlags): PNode = #| declColonEquals = identWithPragma (comma identWithPragma)* comma? - #| (':' optInd typeDesc)? ('=' optInd expr)? - #| identColonEquals = ident (comma ident)* comma? - #| (':' optInd typeDesc)? ('=' optInd expr)?) + #| (':' optInd typeDescExpr)? ('=' optInd expr)? + #| identColonEquals = IDENT (comma IDENT)* comma? + #| (':' optInd typeDescExpr)? ('=' optInd expr)?) var a: PNode result = newNodeP(nkIdentDefs, p) # progress guaranteed while true: case p.tok.tokType of tkSymbol, tkAccent: - if withPragma in flags: a = identWithPragma(p, allowDot=withdot in flags) + if withPragma in flags: a = identWithPragma(p, allowDot=withDot in flags) else: a = parseSymbol(p) if a.kind == nkEmpty: return else: break - addSon(result, a) + result.add(a) if p.tok.tokType != tkComma: break getTok(p) optInd(p, a) if p.tok.tokType == tkColon: getTok(p) optInd(p, result) - addSon(result, parseTypeDesc(p)) + result.add(parseTypeDesc(p, fullExpr = true)) else: - addSon(result, newNodeP(nkEmpty, p)) + result.add(newNodeP(nkEmpty, p)) if p.tok.tokType != tkEquals and withBothOptional notin flags: parMessage(p, "':' or '=' expected, but got '$1'", p.tok) if p.tok.tokType == tkEquals: getTok(p) optInd(p, result) - addSon(result, parseExpr(p)) + result.add(parseExpr(p)) else: - addSon(result, newNodeP(nkEmpty, p)) - -proc parseTuple(p: var TParser, indentAllowed = false): PNode = - #| inlTupleDecl = 'tuple' - #| [' optInd (identColonEquals (comma/semicolon)?)* optPar ']' - #| extTupleDecl = 'tuple' - #| COMMENT? (IND{>} identColonEquals (IND{=} identColonEquals)*)? - #| tupleClass = 'tuple' + result.add(newNodeP(nkEmpty, p)) + setEndInfo() + +proc parseTuple(p: var Parser, indentAllowed = false): PNode = + #| 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: @@ -1010,9 +1096,9 @@ proc parseTuple(p: var TParser, indentAllowed = false): PNode = # progress guaranteed while p.tok.tokType in {tkSymbol, tkAccent}: var a = parseIdentColonEquals(p, {}) - addSon(result, a) + result.add(a) if p.tok.tokType notin {tkComma, tkSemiColon}: break - when defined(nimpretty2): + when defined(nimpretty): commaWasSemicolon(p.em) getTok(p) skipComment(p, a) @@ -1030,7 +1116,7 @@ proc parseTuple(p: var TParser, indentAllowed = false): PNode = var a = parseIdentColonEquals(p, {}) if p.tok.indent < 0 or p.tok.indent >= p.currInd: rawSkipComment(p, a) - addSon(result, a) + result.add(a) of tkEof: break else: parMessage(p, errIdentifierExpected, p.tok) @@ -1040,16 +1126,18 @@ proc parseTuple(p: var TParser, 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 TParser, retColon = true): PNode = +proc parseParamList(p: var Parser, retColon = true): PNode = #| paramList = '(' declColonEquals ^* (comma/semicolon) ')' #| paramListArrow = paramList? ('->' optInd typeDesc)? #| paramListColon = paramList? (':' optInd typeDesc)? var a: PNode result = newNodeP(nkFormalParams, p) - addSon(result, p.emptyNode) # return type - when defined(nimpretty2): + result.add(p.emptyNode) # return type + when defined(nimpretty): inc p.em.doIndentMore + inc p.em.keepIndents let hasParLe = p.tok.tokType == tkParLe and p.tok.indent < 0 if hasParLe: getTok(p) @@ -1067,9 +1155,9 @@ proc parseParamList(p: var TParser, retColon = true): PNode = else: parMessage(p, "expected closing ')'") break - addSon(result, a) + result.add(a) if p.tok.tokType notin {tkComma, tkSemiColon}: break - when defined(nimpretty2): + when defined(nimpretty): commaWasSemicolon(p.em) getTok(p) skipComment(p, a) @@ -1080,78 +1168,96 @@ proc parseParamList(p: var TParser, retColon = true): PNode = if hasRet and p.tok.indent < 0: getTok(p) optInd(p, result) - result.sons[0] = parseTypeDesc(p) - elif not retColon and not hasParle: + 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(nimpretty2): + when defined(nimpretty): dec p.em.doIndentMore + dec p.em.keepIndents + setEndInfo() -proc optPragmas(p: var TParser): PNode = +proc optPragmas(p: var Parser): PNode = if p.tok.tokType == tkCurlyDotLe and (p.tok.indent < 0 or realInd(p)): result = parsePragma(p) else: result = p.emptyNode -proc parseDoBlock(p: var TParser; info: TLineInfo): PNode = - #| doBlock = 'do' paramListArrow pragmas? colcom stmt - let params = parseParamList(p, retColon=false) +proc parseDoBlock(p: var Parser; info: TLineInfo): PNode = + #| doBlock = 'do' paramListArrow pragma? colcom stmt + 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 TParser; isExpr: bool; kind: TNodeKind): PNode = - #| procExpr = 'proc' paramListColon pragmas? ('=' COMMENT? stmt)? +proc parseProcExpr(p: var Parser; isExpr: bool; kind: TNodeKind): PNode = + #| 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: - addSon(result, params) - addSon(result, pragmas) - -proc isExprStart(p: TParser): bool = + 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, - tkProc, tkFunc, tkIterator, tkBind, tkAddr, - tkParLe, tkBracketLe, tkCurlyLe, tkIntLit..tkCharLit, tkVar, tkRef, tkPtr, - tkTuple, tkObject, tkType, tkWhen, tkCase, tkOut: + of tkSymbol, tkAccent, tkOpr, tkNot, tkNil, tkCast, tkIf, tkFor, + tkProc, tkFunc, tkIterator, tkBind, tkBuiltInMagics, + tkParLe, tkBracketLe, tkCurlyLe, tkIntLit..tkCustomLit, tkVar, tkRef, tkPtr, + tkEnum, tkTuple, tkObject, tkWhen, tkCase, tkOut, tkTry, tkBlock: result = true else: result = false -proc parseSymbolList(p: var TParser, result: PNode) = +proc parseSymbolList(p: var Parser, result: PNode) = # progress guaranteed while true: var s = parseSymbol(p, smAllowNil) if s.kind == nkEmpty: break - addSon(result, s) + result.add(s) if p.tok.tokType != tkComma: break getTok(p) optInd(p, s) + setEndInfo() -proc parseTypeDescKAux(p: var TParser, kind: TNodeKind, - mode: TPrimaryMode): PNode = - #| distinct = 'distinct' optInd typeDesc +proc parseTypeDescKAux(p: var Parser, kind: TNodeKind, + mode: PrimaryMode): PNode = 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): - addSon(result, 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 @@ -1163,123 +1269,235 @@ proc parseTypeDescKAux(p: var TParser, kind: TNodeKind, return result getTok(p) let list = newNodeP(nodeKind, p) - result.addSon list + result.add list parseSymbolList(p, list) + if mode == pmTypeDef and not isTypedef: + result = parseOperators(p, result, -1, mode) + setEndInfo() -proc parseExpr(p: var TParser): PNode = +proc parseVarTuple(p: var Parser): PNode + +proc parseFor(p: var Parser): PNode = + #| forStmt = 'for' ((varTuple / identWithPragma) ^+ comma) 'in' expr colcom stmt + #| forExpr = forStmt + getTokNoInd(p) + result = newNodeP(nkForStmt, p) + if p.tok.tokType == tkParLe: + result.add(parseVarTuple(p)) + else: + var a = identWithPragma(p) + result.add(a) + while p.tok.tokType == tkComma: + getTok(p) + optInd(p, a) + if p.tok.tokType == tkParLe: + result.add(parseVarTuple(p)) + break + a = identWithPragma(p) + result.add(a) + eat(p, tkIn) + result.add(parseExpr(p)) + colcom(p, result) + result.add(parseStmt(p)) + setEndInfo() + +template nimprettyDontTouch(body) = + when defined(nimpretty): + inc p.em.keepIndents + body + when defined(nimpretty): + dec p.em.keepIndents + +proc parseExpr(p: var Parser): PNode = #| expr = (blockExpr #| | ifExpr #| | whenExpr - #| | caseExpr + #| | caseStmt + #| | forExpr #| | tryExpr) #| / simpleExpr - case p.tok.tokType: - of tkBlock: result = parseBlock(p) - of tkIf: result = parseIfExpr(p, nkIfExpr) - of tkWhen: result = parseIfExpr(p, nkWhenExpr) - of tkCase: result = parseCase(p) - of tkTry: result = parseTry(p, isExpr=true) + case p.tok.tokType + of tkBlock: + nimprettyDontTouch: + result = parseBlock(p) + of tkIf: + nimprettyDontTouch: + result = parseIfOrWhenExpr(p, nkIfExpr) + of tkFor: + nimprettyDontTouch: + result = parseFor(p) + of tkWhen: + nimprettyDontTouch: + result = parseIfOrWhenExpr(p, nkWhenStmt) + of tkCase: + # Currently we think nimpretty is good enough with case expressions, + # so it is allowed to touch them: + #nimprettyDontTouch: + result = parseCase(p) + of tkTry: + nimprettyDontTouch: + result = parseTry(p, isExpr=true) else: result = simpleExpr(p) - -proc parseEnum(p: var TParser): PNode -proc parseObject(p: var TParser): PNode -proc parseTypeClass(p: var TParser): PNode - -proc primary(p: var TParser, mode: TPrimaryMode): PNode = - #| typeKeyw = 'var' | 'out' | 'ref' | 'ptr' | 'shared' | 'tuple' - #| | 'proc' | 'iterator' | 'distinct' | 'object' | 'enum' - #| primary = typeKeyw typeDescK - #| / prefixOperator* identOrLiteral primarySuffix* - #| / 'static' primary - #| / 'bind' primary + 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 = + #| 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) - addSon(result, a) + 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 - addSon(result, primary(p, pmSkipSuffix)) - result = primarySuffix(p, result, baseInd) + result.add(identOrLiteral(p, mode)) + result = primarySuffix(p, result, baseInd, mode) else: - addSon(result, primary(p, pmNormal)) + 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) + case p.tok.tokType + 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.kind = nkIteratorDef - else: result.kind = nkIteratorTy - of tkEnum: - if mode == pmTypeDef: - result = parseEnum(p) - else: - result = newNodeP(nkEnumTy, p) - getTok(p) - of tkObject: - if mode == pmTypeDef: - 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") - of tkStatic: - let info = parLineInfo(p) - getTokNoInd(p) - let next = primary(p, pmNormal) - if next.kind == nkBracket and next.sonsLen == 1: - result = newNode(nkStaticTy, info, @[next.sons[0]]) - else: - result = newNode(nkStaticExpr, info, @[next]) + 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) - addSon(result, primary(p, pmNormal)) - of tkVar: result = parseTypeDescKAux(p, nkVarTy, mode) - of tkOut: result = parseTypeDescKAux(p, nkVarTy, mode) - of tkRef: result = parseTypeDescKAux(p, nkRefTy, mode) - of tkPtr: result = parseTypeDescKAux(p, nkPtrTy, mode) - of tkDistinct: result = parseTypeDescKAux(p, nkDistinctTy, mode) + result.add(primary(p, pmNormal)) + 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) + result = primarySuffix(p, result, baseInd, mode) -proc parseTypeDesc(p: var TParser): PNode = - #| typeDesc = simpleExpr - result = simpleExpr(p, pmTypeDesc) +proc binaryNot(p: var Parser; a: PNode): PNode = + if p.tok.tokType == tkNot and p.tok.indent < 0: + let notOpr = newIdentNodeP(p.tok.ident, p) + getTok(p) + optInd(p, notOpr) + let b = primary(p, pmTypeDesc) + result = newNodeP(nkInfix, p) + result.add notOpr + result.add a + result.add b + else: + result = a -proc parseTypeDefAux(p: var TParser): PNode = - #| typeDefAux = simpleExpr - #| | 'concept' typeClass - result = simpleExpr(p, pmTypeDef) +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) + 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 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 TParser, x: PNode): PNode = - #| postExprBlocks = ':' stmt? ( IND{=} doBlock - #| | IND{=} 'of' exprList ':' stmt - #| | IND{=} 'elif' expr ':' stmt - #| | IND{=} 'except' exprList ':' stmt - #| | IND{=} 'else' ':' stmt )* +proc postExprBlocks(p: var Parser, x: PNode): PNode = + #| 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 @@ -1296,14 +1514,17 @@ proc postExprBlocks(p: var TParser, 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, @@ -1321,7 +1542,7 @@ proc postExprBlocks(p: var TParser, x: PNode): PNode = getTok(p) nextBlock = parseDoBlock(p, info) else: - case nextToken: + case nextToken of tkOf: nextBlock = newNodeP(nkOfBranch, p) exprList(p, tkColon, nextBlock) @@ -1329,63 +1550,61 @@ proc postExprBlocks(p: var TParser, x: PNode): PNode = nextBlock = newNodeP(nkElifBranch, p) getTok(p) optInd(p, nextBlock) - nextBlock.addSon parseExpr(p) + 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) of tkElse: nextBlock = newNodeP(nkElse, p) getTok(p) else: break eat(p, tkColon) - nextBlock.addSon parseStmt(p) + nextBlock.add parseStmt(p) - nextBlock.flags.incl nfBlockArg + setNodeFlag nextBlock, nfBlockArg result.add nextBlock - if nextBlock.kind == nkElse: break + if nextBlock.kind in {nkElse, nkFinally}: break else: if openingParams.kind != nkEmpty: parMessage(p, "expected ':'") -proc parseExprStmt(p: var TParser): PNode = - #| exprStmt = simpleExpr - #| (( '=' optInd expr colonBody? ) - #| / ( expr ^+ comma - #| doBlocks - #| / macroColon - #| ))? - var a = simpleExpr(p) +proc parseExprStmt(p: var Parser): PNode = + #| 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) optInd(p, result) var b = parseExpr(p) b = postExprBlocks(p, b) - addSon(result, a) - addSon(result, b) + 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) - addSon(result, commandParam(p, isFirstParam)) - if p.tok.tokType != tkComma: break - elif p.tok.indent < 0 and isExprStart(p): - result = newNode(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: - addSon(result, commandParam(p, isFirstParam)) - if p.tok.tokType != tkComma: break + result.add(commandParam(p, isFirstParam, pmNormal)) + 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 TParser, kind: TNodeKind): PNode = +proc parseModuleName(p: var Parser, kind: TNodeKind): PNode = result = parseExpr(p) when false: # parseExpr already handles 'as' syntax ... @@ -1395,19 +1614,23 @@ proc parseModuleName(p: var TParser, kind: TNodeKind): PNode = getTok(p) result.add(a) result.add(parseExpr(p)) + setEndInfo() -proc parseImport(p: var TParser, kind: TNodeKind): PNode = +proc parseImport(p: var Parser, kind: TNodeKind): PNode = #| importStmt = 'import' optInd expr #| ((comma expr)* #| / 'except' optInd (expr ^+ comma)) + #| exportStmt = 'export' optInd expr + #| ((comma expr)* + #| / 'except' optInd (expr ^+ comma)) result = newNodeP(kind, p) getTok(p) # skip `import` or `export` optInd(p, result) var a = parseModuleName(p, kind) - addSon(result, a) + result.add(a) if p.tok.tokType in {tkComma, tkExcept}: if p.tok.tokType == tkExcept: - result.kind = succ(kind) + result.transitionSonsKind(succ(kind)) getTok(p) optInd(p, result) while true: @@ -1415,13 +1638,14 @@ proc parseImport(p: var TParser, kind: TNodeKind): PNode = p.hasProgress = false a = parseModuleName(p, kind) if a.kind == nkEmpty or not p.hasProgress: break - addSon(result, a) + result.add(a) if p.tok.tokType != tkComma: break getTok(p) optInd(p, a) #expectNl(p) + setEndInfo() -proc parseIncludeStmt(p: var TParser): PNode = +proc parseIncludeStmt(p: var Parser): PNode = #| includeStmt = 'include' optInd expr ^+ comma result = newNodeP(nkIncludeStmt, p) getTok(p) # skip `import` or `include` @@ -1431,19 +1655,20 @@ proc parseIncludeStmt(p: var TParser): PNode = p.hasProgress = false var a = parseExpr(p) if a.kind == nkEmpty or not p.hasProgress: break - addSon(result, a) + result.add(a) if p.tok.tokType != tkComma: break getTok(p) optInd(p, a) #expectNl(p) + setEndInfo() -proc parseFromStmt(p: var TParser): PNode = - #| fromStmt = 'from' moduleName 'import' optInd expr (comma expr)* +proc parseFromStmt(p: var Parser): PNode = + #| fromStmt = 'from' expr 'import' optInd expr (comma expr)* result = newNodeP(nkFromStmt, p) getTok(p) # skip `from` optInd(p, result) var a = parseModuleName(p, nkImportStmt) - addSon(result, a) #optInd(p, a); + result.add(a) #optInd(p, a); eat(p, tkImport) optInd(p, result) while true: @@ -1451,33 +1676,36 @@ proc parseFromStmt(p: var TParser): PNode = p.hasProgress = false a = parseExpr(p) if a.kind == nkEmpty or not p.hasProgress: break - addSon(result, a) + result.add(a) if p.tok.tokType != tkComma: break getTok(p) optInd(p, a) #expectNl(p) + setEndInfo() -proc parseReturnOrRaise(p: var TParser, kind: TNodeKind): PNode = +proc parseReturnOrRaise(p: var Parser, kind: TNodeKind): PNode = #| returnStmt = 'return' optInd expr? #| raiseStmt = 'raise' optInd expr? #| 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: skipComment(p, result) - addSon(result, p.emptyNode) + result.add(p.emptyNode) elif p.tok.indent >= 0 and p.tok.indent <= p.currInd or not isExprStart(p): # NL terminates: - addSon(result, p.emptyNode) + result.add(p.emptyNode) + # nimpretty here! else: var e = parseExpr(p) e = postExprBlocks(p, e) - addSon(result, e) + result.add(e) + setEndInfo() -proc parseIfOrWhen(p: var TParser, kind: TNodeKind): PNode = +proc parseIfOrWhen(p: var Parser, kind: TNodeKind): PNode = #| condStmt = expr colcom stmt COMMENT? #| (IND{=} 'elif' expr colcom stmt)* #| (IND{=} 'else' colcom stmt)? @@ -1488,29 +1716,56 @@ proc parseIfOrWhen(p: var TParser, kind: TNodeKind): PNode = getTok(p) # skip `if`, `when`, `elif` var branch = newNodeP(nkElifBranch, p) optInd(p, branch) - addSon(branch, parseExpr(p)) + branch.add(parseExpr(p)) colcom(p, branch) - addSon(branch, parseStmt(p)) + branch.add(parseStmt(p)) skipComment(p, branch) - addSon(result, branch) + result.add(branch) if p.tok.tokType != tkElif or not sameOrNoInd(p): break if p.tok.tokType == tkElse and sameOrNoInd(p): var branch = newNodeP(nkElse, p) eat(p, tkElse) colcom(p, branch) - addSon(branch, parseStmt(p)) - addSon(result, branch) + branch.add(parseStmt(p)) + result.add(branch) + setEndInfo() + +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) + while true: + getTok(p) # skip `if`, `when`, `elif` + var branch = newNodeP(nkElifExpr, p) + optInd(p, branch) + branch.add(parseExpr(p)) + colcom(p, branch) + branch.add(parseStmt(p)) + skipComment(p, branch) + result.add(branch) + if p.tok.tokType != tkElif: break + if p.tok.tokType == tkElse: + var branch = newNodeP(nkElseExpr, p) + eat(p, tkElse) + colcom(p, branch) + branch.add(parseStmt(p)) + result.add(branch) + setEndInfo() -proc parseWhile(p: var TParser): PNode = +proc parseWhile(p: var Parser): PNode = #| whileStmt = 'while' expr colcom stmt result = newNodeP(nkWhileStmt, p) getTok(p) optInd(p, result) - addSon(result, parseExpr(p)) + result.add(parseExpr(p)) colcom(p, result) - addSon(result, parseStmt(p)) + result.add(parseStmt(p)) + setEndInfo() -proc parseCase(p: var TParser): PNode = +proc parseCase(p: var Parser): PNode = #| ofBranch = 'of' exprList colcom stmt #| ofBranches = ofBranch (IND{=} ofBranch)* #| (IND{=} 'elif' expr colcom stmt)* @@ -1520,11 +1775,11 @@ proc parseCase(p: var TParser): PNode = #| | IND{=} ofBranches) var b: PNode - inElif= false + inElif = false wasIndented = false result = newNodeP(nkCaseStmt, p) getTok(p) - addSon(result, parseExpr(p)) + result.add(parseExpr(p)) if p.tok.tokType == tkColon: getTok(p) skipComment(p, result) @@ -1544,105 +1799,94 @@ proc parseCase(p: var TParser): PNode = b = newNodeP(nkElifBranch, p) getTok(p) optInd(p, b) - addSon(b, parseExpr(p)) + b.add(parseExpr(p)) of tkElse: b = newNodeP(nkElse, p) getTok(p) else: break colcom(p, b) - addSon(b, parseStmt(p)) - addSon(result, b) + b.add(parseStmt(p)) + result.add(b) if b.kind == nkElse: break if wasIndented: p.currInd = oldInd + setEndInfo() -proc parseTry(p: var TParser; isExpr: bool): PNode = +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) - addSon(result, parseStmt(p)) + 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) else: break colcom(p, b) - addSon(b, parseStmt(p)) - addSon(result, b) - if b.kind == nkFinally: break + b.add(parseStmt(p)) + result.add(b) if b == nil: parMessage(p, "expected 'except'") + setEndInfo() -proc parseExceptBlock(p: var TParser, kind: TNodeKind): PNode = - #| exceptBlock = 'except' colcom stmt +proc parseExceptBlock(p: var Parser, kind: TNodeKind): PNode = result = newNodeP(kind, p) getTok(p) colcom(p, result) - addSon(result, parseStmt(p)) + result.add(parseStmt(p)) + setEndInfo() -proc parseFor(p: var TParser): PNode = - #| forStmt = 'for' (identWithPragma ^+ comma) 'in' expr colcom stmt - result = newNodeP(nkForStmt, p) - getTokNoInd(p) - var a = identWithPragma(p) - addSon(result, a) - while p.tok.tokType == tkComma: - getTok(p) - optInd(p, a) - a = identWithPragma(p) - addSon(result, a) - eat(p, tkIn) - addSon(result, parseExpr(p)) - colcom(p, result) - addSon(result, parseStmt(p)) - -proc parseBlock(p: var TParser): PNode = +proc parseBlock(p: var Parser): PNode = #| blockStmt = 'block' symbol? colcom stmt #| blockExpr = 'block' symbol? colcom stmt result = newNodeP(nkBlockStmt, p) getTokNoInd(p) - if p.tok.tokType == tkColon: addSon(result, p.emptyNode) - else: addSon(result, parseSymbol(p)) + if p.tok.tokType == tkColon: result.add(p.emptyNode) + else: result.add(parseSymbol(p)) colcom(p, result) - addSon(result, parseStmt(p)) + result.add(parseStmt(p)) + setEndInfo() -proc parseStaticOrDefer(p: var TParser; k: TNodeKind): PNode = +proc parseStaticOrDefer(p: var Parser; k: TNodeKind): PNode = #| staticStmt = 'static' colcom stmt #| deferStmt = 'defer' colcom stmt result = newNodeP(k, p) getTok(p) colcom(p, result) - addSon(result, parseStmt(p)) + result.add(parseStmt(p)) + setEndInfo() -proc parseAsm(p: var TParser): PNode = - #| asmStmt = 'asm' pragma? (STR_LIT | RSTR_LIT | TRIPLE_STR_LIT) +proc parseAsm(p: var Parser): PNode = + #| asmStmt = 'asm' pragma? (STR_LIT | RSTR_LIT | TRIPLESTR_LIT) result = newNodeP(nkAsmStmt, p) getTokNoInd(p) - if p.tok.tokType == tkCurlyDotLe: addSon(result, parsePragma(p)) - else: addSon(result, p.emptyNode) + if p.tok.tokType == tkCurlyDotLe: result.add(parsePragma(p)) + else: result.add(p.emptyNode) case p.tok.tokType - of tkStrLit: addSon(result, newStrNodeP(nkStrLit, p.tok.literal, p)) - of tkRStrLit: addSon(result, newStrNodeP(nkRStrLit, p.tok.literal, p)) - of tkTripleStrLit: addSon(result, - newStrNodeP(nkTripleStrLit, p.tok.literal, p)) + of tkStrLit: result.add(newStrNodeP(nkStrLit, p.tok.literal, p)) + of tkRStrLit: result.add(newStrNodeP(nkRStrLit, p.tok.literal, p)) + of tkTripleStrLit: result.add(newStrNodeP(nkTripleStrLit, p.tok.literal, p)) else: parMessage(p, "the 'asm' statement takes a string literal") - addSon(result, p.emptyNode) + result.add(p.emptyNode) return getTok(p) + setEndInfo() -proc parseGenericParam(p: var TParser): PNode = +proc parseGenericParam(p: var Parser): PNode = #| genericParam = symbol (comma symbol)* (colon expr)? ('=' optInd expr)? var a: PNode result = newNodeP(nkIdentDefs, p) @@ -1652,32 +1896,33 @@ proc parseGenericParam(p: var TParser): PNode = of tkIn, tkOut: let x = p.lex.cache.getIdent(if p.tok.tokType == tkIn: "in" else: "out") a = newNodeP(nkPrefix, p) - a.addSon newIdentNodeP(x, p) + a.add newIdentNodeP(x, p) getTok(p) expectIdent(p) - a.addSon(parseSymbol(p)) + a.add(parseSymbol(p)) of tkSymbol, tkAccent: a = parseSymbol(p) if a.kind == nkEmpty: return else: break - addSon(result, a) + result.add(a) if p.tok.tokType != tkComma: break getTok(p) optInd(p, a) if p.tok.tokType == tkColon: getTok(p) optInd(p, result) - addSon(result, parseExpr(p)) + result.add(parseExpr(p)) else: - addSon(result, p.emptyNode) + result.add(p.emptyNode) if p.tok.tokType == tkEquals: getTok(p) optInd(p, result) - addSon(result, parseExpr(p)) + result.add(parseExpr(p)) else: - addSon(result, p.emptyNode) + result.add(p.emptyNode) + setEndInfo() -proc parseGenericParamList(p: var TParser): PNode = +proc parseGenericParamList(p: var Parser): PNode = #| genericParamList = '[' optInd #| genericParam ^* (comma/semicolon) optPar ']' result = newNodeP(nkGenericParams, p) @@ -1686,63 +1931,77 @@ proc parseGenericParamList(p: var TParser): PNode = # progress guaranteed while p.tok.tokType in {tkSymbol, tkAccent, tkIn, tkOut}: var a = parseGenericParam(p) - addSon(result, a) + result.add(a) if p.tok.tokType notin {tkComma, tkSemiColon}: break - when defined(nimpretty2): + when defined(nimpretty): commaWasSemicolon(p.em) getTok(p) skipComment(p, a) optPar(p) eat(p, tkBracketRi) + setEndInfo() -proc parsePattern(p: var TParser): PNode = +proc parsePattern(p: var Parser): PNode = #| pattern = '{' stmt '}' eat(p, tkCurlyLe) result = parseStmt(p) eat(p, tkCurlyRi) + setEndInfo() -proc validInd(p: var TParser): bool = - result = p.tok.indent < 0 or p.tok.indent > p.currInd - -proc parseRoutine(p: var TParser, kind: TNodeKind): PNode = +proc parseRoutine(p: var Parser, kind: TNodeKind): PNode = #| indAndComment = (IND{>} COMMENT)? | COMMENT? #| routine = optInd identVis pattern? genericParamList? #| paramListColon pragma? ('=' COMMENT? stmt)? indAndComment result = newNodeP(kind, p) getTok(p) optInd(p, result) - addSon(result, identVis(p)) - if p.tok.tokType == tkCurlyLe and p.validInd: addSon(result, p.parsePattern) - else: addSon(result, p.emptyNode) + 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) if p.tok.tokType == tkBracketLe and p.validInd: result.add(p.parseGenericParamList) else: - addSon(result, p.emptyNode) - addSon(result, p.parseParamList) - if p.tok.tokType == tkCurlyDotLe and p.validInd: addSon(result, p.parsePragma) - else: addSon(result, p.emptyNode) + result.add(p.emptyNode) + result.add(p.parseParamList) + if p.tok.tokType == tkCurlyDotLe and p.validInd: result.add(p.parsePragma) + else: result.add(p.emptyNode) # empty exception tracking: - addSon(result, p.emptyNode) - if p.tok.tokType == tkEquals and p.validInd: + result.add(p.emptyNode) + let maybeMissEquals = p.tok.tokType != tkEquals + if (not maybeMissEquals) and p.validInd: getTok(p) skipComment(p, result) - addSon(result, parseStmt(p)) + result.add(parseStmt(p)) else: - addSon(result, p.emptyNode) - indAndComment(p, result) - -proc newCommentStmt(p: var TParser): PNode = + result.add(p.emptyNode) + 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 result = newNodeP(nkCommentStmt, p) result.comment = p.tok.literal getTok(p) -type - TDefParser = proc (p: var TParser): PNode {.nimcall.} - -proc parseSection(p: var TParser, kind: TNodeKind, - defparser: TDefParser): PNode = - #| section(p) = COMMENT? p / (IND{>} (p / COMMENT)^+IND{=} DED) +proc parseSection(p: var Parser, kind: TNodeKind, + defparser: proc (p: var Parser): PNode {.nimcall.}): PNode = + #| section(RULE) = COMMENT? RULE / (IND{>} (RULE / COMMENT)^+IND{=} DED) result = newNodeP(kind, p) if kind != nkTypeSection: getTok(p) skipComment(p, result) @@ -1755,73 +2014,70 @@ proc parseSection(p: var TParser, kind: TNodeKind, of tkSymbol, tkAccent, tkParLe: var a = defparser(p) skipComment(p, a) - addSon(result, a) + result.add(a) of tkComment: var a = newCommentStmt(p) - addSon(result, a) + result.add(a) 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 - addSon(result, defparser(p)) + result.add(defparser(p)) else: parMessage(p, errIdentifierExpected, p.tok) + setEndInfo() -proc parseConstant(p: var TParser): PNode = - #| constant = identWithPragma (colon typeDesc)? '=' optInd expr indAndComment - result = newNodeP(nkConstDef, p) - addSon(result, identWithPragma(p)) - if p.tok.tokType == tkColon: - getTok(p) - optInd(p, result) - addSon(result, parseTypeDesc(p)) - else: - addSon(result, p.emptyNode) - eat(p, tkEquals) - optInd(p, result) - addSon(result, parseExpr(p)) - indAndComment(p, result) - -proc parseEnum(p: var TParser): PNode = - #| enum = 'enum' optInd (symbol optInd ('=' optInd expr COMMENT?)? comma?)+ +proc parseEnum(p: var Parser): PNode = + #| enumDecl = 'enum' optInd (symbol pragma? optInd ('=' optInd expr COMMENT?)? comma?)+ result = newNodeP(nkEnumTy, p) getTok(p) - addSon(result, p.emptyNode) + result.add(p.emptyNode) optInd(p, result) flexComment(p, result) # progress guaranteed while true: var a = parseSymbol(p) if a.kind == nkEmpty: return + + var symPragma = a + var pragma: PNode + 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) + symPragma.add(pragma) + # nimpretty support here if p.tok.indent >= 0 and p.tok.indent <= p.currInd: - add(result, a) + result.add(symPragma) break + if p.tok.tokType == tkEquals and p.tok.indent < 0: getTok(p) - optInd(p, a) - var b = a - a = newNodeP(nkEnumFieldDef, p) - addSon(a, b) - addSon(a, parseExpr(p)) + optInd(p, symPragma) + var b = symPragma + symPragma = newNodeP(nkEnumFieldDef, p) + symPragma.add(b) + symPragma.add(parseExpr(p)) if p.tok.indent < 0 or p.tok.indent >= p.currInd: - rawSkipComment(p, a) + rawSkipComment(p, symPragma) if p.tok.tokType == tkComma and p.tok.indent < 0: getTok(p) - rawSkipComment(p, a) + rawSkipComment(p, symPragma) else: if p.tok.indent < 0 or p.tok.indent >= p.currInd: - rawSkipComment(p, a) - addSon(result, a) + rawSkipComment(p, symPragma) + result.add(symPragma) 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 TParser): PNode -proc parseObjectWhen(p: var TParser): PNode = +proc parseObjectPart(p: var Parser): PNode +proc parseObjectWhen(p: var Parser): PNode = #| objectWhen = 'when' expr colcom objectPart COMMENT? #| ('elif' expr colcom objectPart COMMENT?)* #| ('else' colcom objectPart COMMENT?)? @@ -1831,36 +2087,33 @@ proc parseObjectWhen(p: var TParser): PNode = getTok(p) # skip `when`, `elif` var branch = newNodeP(nkElifBranch, p) optInd(p, branch) - addSon(branch, parseExpr(p)) + branch.add(parseExpr(p)) colcom(p, branch) - addSon(branch, parseObjectPart(p)) + branch.add(parseObjectPart(p)) flexComment(p, branch) - addSon(result, branch) + result.add(branch) if p.tok.tokType != tkElif: break if p.tok.tokType == tkElse and sameInd(p): var branch = newNodeP(nkElse, p) eat(p, tkElse) colcom(p, branch) - addSon(branch, parseObjectPart(p)) + branch.add(parseObjectPart(p)) flexComment(p, branch) - addSon(result, branch) + result.add(branch) + setEndInfo() -proc parseObjectCase(p: var TParser): PNode = +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) - addSon(a, identWithPragma(p)) - eat(p, tkColon) - addSon(a, parseTypeDesc(p)) - addSon(a, p.emptyNode) - addSon(result, a) + var a = parseIdentColonEquals(p, {withPragma}) + result.add(a) if p.tok.tokType == tkColon: getTok(p) flexComment(p, result) var wasIndented = false @@ -1884,13 +2137,14 @@ proc parseObjectCase(p: var TParser): PNode = if fields.kind == nkEmpty: parMessage(p, errIdentifierExpected, p.tok) fields = newNodeP(nkNilLit, p) # don't break further semantic checking - addSon(b, fields) - addSon(result, b) + b.add(fields) + result.add(b) if b.kind == nkElse: break if wasIndented: p.currInd = oldInd + setEndInfo() -proc parseObjectPart(p: var TParser): PNode = +proc parseObjectPart(p: var Parser): PNode = #| objectPart = IND{>} objectPart^+IND{=} DED #| / objectWhen / objectCase / 'nil' / 'discard' / declColonEquals if realInd(p): @@ -1900,11 +2154,11 @@ proc parseObjectPart(p: var TParser): PNode = while sameInd(p): case p.tok.tokType of tkCase, tkWhen, tkSymbol, tkAccent, tkNil, tkDiscard: - addSon(result, parseObjectPart(p)) + result.add(parseObjectPart(p)) else: parMessage(p, errIdentifierExpected, p.tok) break - else: + elif sameOrNoInd(p): case p.tok.tokType of tkWhen: result = parseObjectWhen(p) @@ -1919,33 +2173,36 @@ proc parseObjectPart(p: var TParser): PNode = getTok(p) else: result = p.emptyNode + else: + result = p.emptyNode + setEndInfo() -proc parseObject(p: var TParser): PNode = - #| object = 'object' pragma? ('of' typeDesc)? COMMENT? objectPart +proc parseObject(p: var Parser): PNode = + #| objectDecl = 'object' ('of' typeDesc)? COMMENT? objectPart result = newNodeP(nkObjectTy, p) getTok(p) - if p.tok.tokType == tkCurlyDotLe and p.validInd: - addSon(result, parsePragma(p)) - else: - addSon(result, 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) - addSon(a, parseTypeDesc(p)) - addSon(result, a) + a.add(parseTypeDesc(p)) + result.add(a) else: - addSon(result, p.emptyNode) + result.add(p.emptyNode) if p.tok.tokType == tkComment: skipComment(p, result) # an initial IND{>} HAS to follow: if not realInd(p): - addSon(result, p.emptyNode) - return - addSon(result, parseObjectPart(p)) + result.add(p.emptyNode) + else: + result.add(parseObjectPart(p)) + setEndInfo() -proc parseTypeClassParam(p: var TParser): PNode = - let modifier = case p.tok.tokType - of tkOut, tkVar: nkVarTy +proc parseTypeClassParam(p: var Parser): PNode = + let modifier = + case p.tok.tokType + of tkVar: nkVarTy + of tkOut: nkOutTy of tkPtr: nkPtrTy of tkRef: nkRefTy of tkStatic: nkStaticTy @@ -1955,92 +2212,151 @@ proc parseTypeClassParam(p: var TParser): PNode = if modifier != nkEmpty: result = newNodeP(modifier, p) getTok(p) - result.addSon(p.parseSymbol) + result.add(p.parseSymbol) else: result = p.parseSymbol + setEndInfo() -proc parseTypeClass(p: var TParser): PNode = - #| typeClassParam = ('var' | 'out')? symbol - #| typeClass = typeClassParam ^* ',' (pragma)? ('of' typeDesc ^* ',')? +proc parseTypeClass(p: var Parser): PNode = + #| conceptParam = ('var' | 'out' | 'ptr' | 'ref' | 'static' | 'type')? symbol + #| conceptDecl = 'concept' conceptParam ^* ',' (pragma)? ('of' typeDesc ^* ',')? #| &IND{>} stmt result = newNodeP(nkTypeClassTy, p) getTok(p) - var args = newNodeP(nkArgList, p) - addSon(result, args) - addSon(args, p.parseTypeClassParam) - while p.tok.tokType == tkComma: - getTok(p) - addSon(args, p.parseTypeClassParam) + if p.tok.tokType == tkComment: + skipComment(p, result) + + if p.tok.indent < 0: + var args = newNodeP(nkArgList, p) + result.add(args) + args.add(p.parseTypeClassParam) + while p.tok.tokType == tkComma: + getTok(p) + args.add(p.parseTypeClassParam) + else: + result.add(p.emptyNode) # see ast.isNewStyleConcept if p.tok.tokType == tkCurlyDotLe and p.validInd: - addSon(result, parsePragma(p)) + result.add(parsePragma(p)) else: - addSon(result, p.emptyNode) + result.add(p.emptyNode) if p.tok.tokType == tkOf and p.tok.indent < 0: var a = newNodeP(nkOfInherit, p) getTok(p) # progress guaranteed while true: - addSon(a, parseTypeDesc(p)) + a.add(parseTypeDesc(p)) if p.tok.tokType != tkComma: break getTok(p) - addSon(result, a) + result.add(a) else: - addSon(result, p.emptyNode) + result.add(p.emptyNode) if p.tok.tokType == tkComment: skipComment(p, result) # an initial IND{>} HAS to follow: if not realInd(p): - addSon(result, p.emptyNode) + if result.isNewStyleConcept: + parMessage(p, "routine expected, but found '$1' (empty new-styled concepts are not allowed)", p.tok) + result.add(p.emptyNode) else: - addSon(result, parseStmt(p)) + result.add(parseStmt(p)) + setEndInfo() -proc parseTypeDef(p: var TParser): PNode = +proc parseTypeDef(p: var Parser): PNode = #| - #| typeDef = identWithPragmaDot genericParamList? '=' optInd typeDefAux + #| typeDef = identVisDot genericParamList? pragma '=' optInd typeDefValue #| indAndComment? result = newNodeP(nkTypeDef, p) - addSon(result, identWithPragma(p, allowDot=true)) + var identifier = identVis(p, allowDot=true) + var identPragma = identifier + var pragma: PNode + var genericParam: PNode + if p.tok.tokType == tkBracketLe and p.validInd: - addSon(result, parseGenericParamList(p)) + genericParam = parseGenericParamList(p) else: - addSon(result, p.emptyNode) + genericParam = p.emptyNode + + pragma = optPragmas(p) + if pragma.kind != nkEmpty: + identPragma = newNodeP(nkPragmaExpr, p) + identPragma.add(identifier) + identPragma.add(pragma) + + result.add(identPragma) + result.add(genericParam) + if p.tok.tokType == tkEquals: result.info = parLineInfo(p) getTok(p) optInd(p, result) - addSon(result, parseTypeDefAux(p)) + result.add(parseTypeDefValue(p)) else: - addSon(result, p.emptyNode) + result.add(p.emptyNode) indAndComment(p, result) # special extension! + setEndInfo() -proc parseVarTuple(p: var TParser): PNode = - #| varTuple = '(' optInd identWithPragma ^+ comma optPar ')' '=' optInd expr +proc parseVarTuple(p: var Parser): PNode = + #| 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) - addSon(result, a) + 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) - addSon(result, p.emptyNode) # no type desc optPar(p) eat(p, tkParRi) - eat(p, tkEquals) - optInd(p, result) - addSon(result, parseExpr(p)) + 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 TParser): PNode = - #| colonBody = colcom stmt doBlocks? +proc parseVariable(p: var Parser): PNode = + #| colonBody = colcom stmt postExprBlocks? #| variable = (varTuple / identColonEquals) colonBody? indAndComment - if p.tok.tokType == tkParLe: result = parseVarTuple(p) + if p.tok.tokType == tkParLe: + result = parseVarTuple(p) + eat(p, tkEquals) + 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 + if p.tok.tokType == tkParLe: result = parseVarTuple(p) + else: + result = newNodeP(nkConstDef, p) + result.add(identWithPragma(p)) + if p.tok.tokType == tkColon: + getTok(p) + optInd(p, result) + result.add(parseTypeDesc(p)) + else: + result.add(p.emptyNode) + eat(p, tkEquals) + optInd(p, result) + #add(result, parseStmtListExpr(p)) + let a = parseExpr(p) + result.add postExprBlocks(p, a) indAndComment(p, result) + setEndInfo() -proc parseBind(p: var TParser, k: TNodeKind): PNode = +proc parseBind(p: var Parser, k: TNodeKind): PNode = #| bindStmt = 'bind' optInd qualifiedIdent ^+ comma #| mixinStmt = 'mixin' optInd qualifiedIdent ^+ comma result = newNodeP(k, p) @@ -2049,24 +2365,26 @@ proc parseBind(p: var TParser, k: TNodeKind): PNode = # progress guaranteed while true: var a = qualifiedIdent(p) - addSon(result, a) + result.add(a) if p.tok.tokType != tkComma: break getTok(p) optInd(p, a) #expectNl(p) + setEndInfo() -proc parseStmtPragma(p: var TParser): PNode = +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 TParser): PNode = +proc simpleStmt(p: var Parser): PNode = #| simpleStmt = ((returnStmt | raiseStmt | yieldStmt | discardStmt | breakStmt #| | continueStmt | pragmaStmt | importStmt | exportStmt | fromStmt #| | includeStmt | commentStmt) / exprStmt) COMMENT? @@ -2089,12 +2407,13 @@ proc simpleStmt(p: var TParser): PNode = else: result = p.emptyNode if result.kind notin {nkEmpty, nkCommentStmt}: skipComment(p, result) -proc complexOrSimpleStmt(p: var TParser): PNode = +proc complexOrSimpleStmt(p: var Parser): PNode = #| complexOrSimpleStmt = (ifStmt | whenStmt | whileStmt #| | tryStmt | forStmt #| | blockStmt | staticStmt | deferStmt | asmStmt #| | 'proc' routine #| | 'method' routine + #| | 'func' routine #| | 'iterator' routine #| | 'macro' routine #| | 'template' routine @@ -2128,24 +2447,31 @@ proc complexOrSimpleStmt(p: var TParser): PNode = if p.tok.tokType == tkParLe: getTok(p) result = newNodeP(nkTypeOfExpr, p) - result.addSon(primary(p, pmTypeDesc)) + result.add(primary(p, pmTypeDesc)) eat(p, tkParRi) result = parseOperators(p, result, -1, pmNormal) else: result = parseSection(p, nkTypeSection, parseTypeDef) - of tkConst: result = parseSection(p, nkConstSection, parseConstant) - of tkLet: result = parseSection(p, nkLetSection, parseVariable) + of tkConst: + prettySection: + result = parseSection(p, nkConstSection, parseConstant) + of tkLet: + prettySection: + result = parseSection(p, nkLetSection, parseVariable) + of tkVar: + prettySection: + result = parseSection(p, nkVarSection, parseVariable) of tkWhen: result = parseIfOrWhen(p, nkWhenStmt) - of tkVar: result = parseSection(p, nkVarSection, parseVariable) of tkBind: result = parseBind(p, nkBindStmt) of tkMixin: result = parseBind(p, nkMixinStmt) of tkUsing: result = parseSection(p, nkUsingStmt, parseVariable) else: result = simpleStmt(p) -proc parseStmt(p: var TParser): PNode = +proc parseStmt(p: var Parser): PNode = #| stmt = (IND{>} complexOrSimpleStmt^+(IND{=} / ';') DED) #| / simpleStmt ^+ ';' if p.tok.indent > p.currInd: + # nimpretty support here result = newNodeP(nkStmtList, p) withInd(p): while true: @@ -2164,24 +2490,23 @@ proc parseStmt(p: var TParser): PNode = # deprecate this syntax later break p.hasProgress = false - var a = complexOrSimpleStmt(p) - if a.kind != nkEmpty: - addSon(result, a) + if p.tok.tokType in {tkElse, tkElif}: + break # Allow this too, see tests/parser/tifexprs + + let a = complexOrSimpleStmt(p) + if a.kind == nkEmpty and not p.hasProgress: + parMessage(p, errExprExpected, p.tok) + break else: - # This is done to make the new 'if' expressions work better. - # XXX Eventually we need to be more strict here. - if p.tok.tokType notin {tkElse, tkElif}: - parMessage(p, errExprExpected, p.tok) - getTok(p) - else: - break + result.add a + if not p.hasProgress and p.tok.tokType == tkEof: break else: # the case statement is only needed for better error messages: case p.tok.tokType of tkIf, tkWhile, tkCase, tkTry, tkFor, tkBlock, tkAsm, tkProc, tkFunc, tkIterator, tkMacro, tkType, tkConst, tkWhen, tkVar: - parMessage(p, "complex statement requires indentation") + parMessage(p, "nestable statement requires indentation") result = p.emptyNode else: if p.inSemiStmtList > 0: @@ -2200,28 +2525,19 @@ proc parseStmt(p: var TParser): PNode = if p.tok.tokType != tkSemiColon: break getTok(p) if err and p.tok.tokType == tkEof: break + setEndInfo() -proc parseAll(p: var TParser): 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: - addSon(result, 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 TParser): 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 # progress guaranteed while true: + # nimpretty support here if p.tok.indent != 0: if p.firstTok and p.tok.indent < 0: discard elif p.tok.tokType != tkSemiColon: @@ -2243,10 +2559,21 @@ proc parseTopLevelStmt(p: var TParser): 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; - errorHandler: TErrorHandler = nil): PNode = + errorHandler: ErrorHandler = nil): PNode = ## Parses a string into an AST, returning the top node. ## `filename` and `line`, although optional, provide info so that the ## compiler can generate correct error messages referring to the original @@ -2254,11 +2581,10 @@ proc parseString*(s: string; cache: IdentCache; config: ConfigRef; var stream = llStreamOpen(s) stream.lineOffset = line - var parser: TParser - # XXX for now the builtin 'parseStmt/Expr' functions do not know about strong - # spaces... - parser.lex.errorHandler = errorHandler - openParser(parser, filename, stream, cache, config, false) + 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 eabce8822..af507d210 100644 --- a/compiler/passaux.nim +++ b/compiler/passaux.nim @@ -10,26 +10,24 @@ ## implements some little helper passes import - strutils, ast, astalgo, passes, idents, msgs, options, idgen, lineinfos + ast, passes, msgs, options, lineinfos -from modulegraphs import ModuleGraph +from modulegraphs import ModuleGraph, PPassContext type - VerboseRef = ref object of TPassContext + VerboseRef = ref object of PPassContext config: ConfigRef -proc verboseOpen(graph: ModuleGraph; s: PSym): PPassContext = - #MessageOut('compiling ' + s.name.s); - result = VerboseRef(config: graph.config) - rawMessage(graph.config, hintProcessing, s.name.s) +proc verboseOpen(graph: ModuleGraph; s: PSym; idgen: IdGenerator): PPassContext = + # xxx consider either removing this or keeping for documentation for how to add a pass + result = VerboseRef(config: graph.config, idgen: idgen) + +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 unconditionally: - incl(v.config.notes, hintProcessing) - message(v.config, n.info, hintProcessing, $idgen.gFrontendId) + 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 45c726f2a..d6b141078 100644 --- a/compiler/passes.nim +++ b/compiler/passes.nim @@ -11,26 +11,28 @@ ## `TPass` interface. import - strutils, options, ast, astalgo, llstream, msgs, platform, os, - condsyms, idents, renderer, types, extccomp, math, magicsys, nversion, - nimsets, syntaxes, times, idgen, modulegraphs, reorder, rod, - lineinfos + options, ast, llstream, msgs, + idents, + syntaxes, modulegraphs, reorder, + lineinfos, + pipelineutils, + modules, pathutils, packages, + sem, semdata +import ic/replayer -type - TPassContext* = object of RootObj # the pass's context +export skipCodegen, resolveMod, prepareConfigNotes - PPassContext* = ref TPassContext +when defined(nimsuggest): + import ../dist/checksums/src/checksums/sha1 - TPassOpen* = proc (graph: ModuleGraph; module: PSym): PPassContext {.nimcall.} - TPassClose* = proc (graph: ModuleGraph; p: PPassContext, n: PNode): PNode {.nimcall.} - TPassProcess* = proc (p: PPassContext, topLevelStmt: PNode): PNode {.nimcall.} +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] - TPass* = tuple[open: TPassOpen, process: TPassProcess, close: TPassClose, - isFrontend: bool] +import std/tables +type TPassData* = tuple[input: PNode, closeOutput: PNode] - TPasses* = openArray[TPass] # a pass is a tuple of procedure vars ``TPass.close`` may produce additional # nodes. These are passed to the other close procedures. @@ -45,156 +47,209 @@ 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 type TPassContextArray = array[0..maxPasses - 1, PPassContext] -var - gPasses: array[0..maxPasses - 1, TPass] - gPassesLen*: int - proc clearPasses*(g: ModuleGraph) = - gPassesLen = 0 + g.passes.setLen(0) proc registerPass*(g: ModuleGraph; p: TPass) = - gPasses[gPassesLen] = p - inc(gPassesLen) - -proc carryPass*(g: ModuleGraph; p: TPass, module: PSym; - m: TPassData): TPassData = - var c = p.open(g, module) - result.input = p.process(c, m.input) - result.closeOutput = if p.close != nil: p.close(g, c, m.closeOutput) - else: m.closeOutput - -proc carryPasses*(g: ModuleGraph; nodes: PNode, module: PSym; - passes: TPasses) = - var passdata: TPassData - passdata.input = nodes - for pass in passes: - passdata = carryPass(g, pass, module, passdata) + internalAssert g.config, g.passes.len < maxPasses + g.passes.add(p) proc openPasses(g: ModuleGraph; a: var TPassContextArray; - module: PSym) = - for i in countup(0, gPassesLen - 1): - if not isNil(gPasses[i].open): - a[i] = gPasses[i].open(g, module) + module: PSym; idgen: IdGenerator) = + for i in 0..<g.passes.len: + if not isNil(g.passes[i].open): + a[i] = g.passes[i].open(g, module, idgen) else: a[i] = nil proc closePasses(graph: ModuleGraph; a: var TPassContextArray) = var m: PNode = nil - for i in countup(0, gPassesLen - 1): - if not isNil(gPasses[i].close): m = gPasses[i].close(graph, a[i], m) + for i in 0..<graph.passes.len: + if not isNil(graph.passes[i].close): + m = graph.passes[i].close(graph, a[i], m) a[i] = nil # free the memory here -proc processTopLevelStmt(n: PNode, a: var TPassContextArray): bool = +proc processTopLevelStmt(graph: ModuleGraph, n: PNode, a: var TPassContextArray): bool = # this implements the code transformation pipeline var m = n - for i in countup(0, gPassesLen - 1): - if not isNil(gPasses[i].process): - m = gPasses[i].process(a[i], m) + for i in 0..<graph.passes.len: + if not isNil(graph.passes[i].process): + m = graph.passes[i].process(a[i], m) if isNil(m): return false result = true -proc resolveMod(conf: ConfigRef; module, relativeTo: string): FileIndex = - let fullPath = findModule(conf, module, relativeTo) - if fullPath.len == 0: - result = InvalidFileIDX - else: - result = fileInfoIdx(conf, fullPath) - -proc processImplicits(conf: ConfigRef; implicits: seq[string], nodeKind: TNodeKind, +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! - let gCmdLineInfo = newLineInfo(FileIndex(0), 1, 1) - let relativeTo = toFullPath(conf, m.info) + 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(conf, module, relativeTo).int32: - var importStmt = newNodeI(nodeKind, gCmdLineInfo) + if m.position != resolveMod(graph.config, module, relativeTo).int32: + var importStmt = newNodeI(nodeKind, m.info) var str = newStrNode(nkStrLit, module) - str.info = gCmdLineInfo - importStmt.addSon str - if not processTopLevelStmt(importStmt, a): break + str.info = m.info + importStmt.add str + if not processTopLevelStmt(graph, importStmt, a): break -proc processModule*(graph: ModuleGraph; module: PSym, stream: PLLStream): bool {.discardable.} = +proc processModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator; + stream: PLLStream): bool {.discardable.} = if graph.stopCompile(): return true var - p: TParsers + p: Parser a: TPassContextArray s: PLLStream fileIdx = module.fileIdx - if module.id < 0: - # new module caching mechanism: - for i in 0..<gPassesLen: - if not isNil(gPasses[i].open) and not gPasses[i].isFrontend: - a[i] = gPasses[i].open(graph, module) - else: - a[i] = nil - - if not graph.stopCompile(): - let n = loadNode(graph, module) - var m = n - for i in 0..<gPassesLen: - if not isNil(gPasses[i].process) and not gPasses[i].isFrontend: - m = gPasses[i].process(a[i], m) - if isNil(m): - break - - var m: PNode = nil - for i in 0..<gPassesLen: - if not isNil(gPasses[i].close) and not gPasses[i].isFrontend: - m = gPasses[i].close(graph, a[i], m) - a[i] = nil + prepareConfigNotes(graph, module) + openPasses(graph, a, module, idgen) + if stream == nil: + let filename = toFullPathConsiderDirty(graph.config, fileIdx) + s = llStreamOpen(filename, fmRead) + if s == nil: + rawMessage(graph.config, errCannotOpenFile, filename.string) + return false else: - openPasses(graph, a, module) - if stream == nil: - let filename = toFullPathConsiderDirty(graph.config, fileIdx) - s = llStreamOpen(filename, fmRead) - if s == nil: - rawMessage(graph.config, errCannotOpenFile, filename) - return false - else: - s = stream - while true: - openParsers(p, fileIdx, s, graph.cache, graph.config) - - if sfSystemModule notin module.flags: - # 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. - processImplicits graph.config, graph.config.implicitImports, nkImportStmt, a, module - processImplicits graph.config, graph.config.implicitIncludes, nkIncludeStmt, a, module - + 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 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 + # for the interactive mode. + if module.name.s != "nimscriptapi": + processImplicits graph, graph.config.implicitImports, nkImportStmt, a, module + processImplicits graph, graph.config.implicitIncludes, nkIncludeStmt, a, module + + 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: - if graph.stopCompile(): break var n = parseTopLevelStmt(p) if n.kind == nkEmpty: break - if {sfNoForward, sfReorder} * module.flags != {}: - # 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: - sl = reorder(graph, sl, module) - discard processTopLevelStmt(sl, a) - break - elif not processTopLevelStmt(n, a): break - closeParsers(p) - if s.kind != llsStdIn: break - closePasses(graph, a) - # id synchronization point for more consistent code generation: - idSynchronizationPoint(1000) + sl.add n + 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) + 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 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 new file mode 100644 index 000000000..5f6212bb2 --- /dev/null +++ b/compiler/pathutils.nim @@ -0,0 +1,153 @@ +# +# +# The Nim Compiler +# (c) Copyright 2018 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Path handling utilities for Nim. Strictly typed code in order +## to avoid the never ending time sink in getting path handling right. + +import std/[os, pathnorm, strutils] + +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] + +type + AbsoluteFile* = distinct string + AbsoluteDir* = distinct string + RelativeFile* = distinct string + RelativeDir* = distinct string + AnyPath* = AbsoluteFile|AbsoluteDir|RelativeFile|RelativeDir + +proc isEmpty*(x: AnyPath): bool {.inline.} = x.string.len == 0 + +proc copyFile*(source, dest: AbsoluteFile) = + os.copyFile(source.string, dest.string) + +proc removeFile*(x: AbsoluteFile) {.borrow.} + +proc splitFile*(x: AbsoluteFile): tuple[dir: AbsoluteDir, name, ext: string] = + let (a, b, c) = splitFile(x.string) + result = (dir: AbsoluteDir(a), name: b, ext: c) + +proc extractFilename*(x: AbsoluteFile): string {.borrow.} + +proc fileExists*(x: AbsoluteFile): bool {.borrow.} +proc dirExists*(x: AbsoluteDir): bool {.borrow.} + +proc quoteShell*(x: AbsoluteFile): string {.borrow.} +proc quoteShell*(x: AbsoluteDir): string {.borrow.} + +proc cmpPaths*(x, y: AbsoluteDir): int {.borrow.} + +proc createDir*(x: AbsoluteDir) {.borrow.} + +proc toAbsoluteDir*(path: string): AbsoluteDir = + result = if path.isAbsolute: AbsoluteDir(path) + else: AbsoluteDir(getCurrentDir() / path) + +proc `$`*(x: AnyPath): string = x.string + +when true: + proc eqImpl(x, y: string): bool {.inline.} = + result = cmpPaths(x, y) == 0 + + proc `==`*[T: AnyPath](x, y: T): bool = eqImpl(x.string, y.string) + + template postProcessBase(base: AbsoluteDir): untyped = + # xxx: as argued here https://github.com/nim-lang/Nim/pull/10018#issuecomment-448192956 + # empty paths should not mean `cwd` so the correct behavior would be to throw + # here and make sure `outDir` is always correctly initialized; for now + # we simply preserve pre-existing external semantics and treat it as `cwd` + when false: + doAssert isAbsolute(base.string), base.string + base + else: + if base.isEmpty: getCurrentDir().AbsoluteDir else: base + + proc `/`*(base: AbsoluteDir; f: RelativeFile): AbsoluteFile = + let base = postProcessBase(base) + assert(not isAbsolute(f.string), f.string) + result = AbsoluteFile newStringOfCap(base.string.len + f.string.len) + var state = 0 + addNormalizePath(base.string, result.string, state) + addNormalizePath(f.string, result.string, state) + + proc `/`*(base: AbsoluteDir; f: RelativeDir): AbsoluteDir = + let base = postProcessBase(base) + assert(not isAbsolute(f.string)) + result = AbsoluteDir newStringOfCap(base.string.len + f.string.len) + var state = 0 + addNormalizePath(base.string, result.string, state) + addNormalizePath(f.string, result.string, state) + + proc relativeTo*(fullPath: AbsoluteFile, baseFilename: AbsoluteDir; + sep = DirSep): RelativeFile = + # this currently fails for `tests/compilerapi/tcompilerapi.nim` + # it's needed otherwise would returns an absolute path + # assert not baseFilename.isEmpty, $fullPath + result = RelativeFile(relativePath(fullPath.string, baseFilename.string, sep)) + + proc toAbsolute*(file: string; base: AbsoluteDir): AbsoluteFile = + if isAbsolute(file): result = AbsoluteFile(file) + else: result = base / RelativeFile file + + proc changeFileExt*(x: AbsoluteFile; ext: string): AbsoluteFile {.borrow.} + proc changeFileExt*(x: RelativeFile; ext: string): RelativeFile {.borrow.} + + proc addFileExt*(x: AbsoluteFile; ext: string): AbsoluteFile {.borrow.} + 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 2d2aeba76..32ec7fb53 100644 --- a/compiler/patterns.nim +++ b/compiler/patterns.nim @@ -11,8 +11,10 @@ ## macro support. import - ast, astalgo, types, semdata, sigmatch, msgs, idents, aliases, parampatterns, - trees + ast, types, semdata, sigmatch, idents, aliases, parampatterns, trees + +when defined(nimPreviewSlimSystem): + import std/assertions type TPatternContext = object @@ -21,31 +23,36 @@ type formals: int c: PContext subMatch: bool # subnode matches are special + mappingIsFull: bool PPatternContext = var TPatternContext proc getLazy(c: PPatternContext, sym: PSym): PNode = - if not isNil(c.mapping): + if c.mappingIsFull: result = c.mapping[sym.position] + else: + result = nil proc putLazy(c: PPatternContext, sym: PSym, n: PNode) = - if isNil(c.mapping): newSeq(c.mapping, c.formals) + if not c.mappingIsFull: + newSeq(c.mapping, c.formals) + c.mappingIsFull = true c.mapping[sym.position] = n 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.} = result = a.kind == b.kind or a.canonKind == b.canonKind -proc sameTrees(a, b: PNode): bool = +proc sameTrees*(a, b: PNode): bool = if sameKinds(a, b): case a.kind of nkSym: result = a.sym == b.sym @@ -56,18 +63,25 @@ proc sameTrees(a, b: PNode): bool = of nkEmpty, nkNilLit: result = true of nkType: result = sameTypeOrNil(a.typ, b.typ) else: - if sonsLen(a) == sonsLen(b): - for i in countup(0, sonsLen(a) - 1): - if not sameTrees(a.sons[i], b.sons[i]): return + if a.len == b.len: + 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.sons[i].sym == x.sym: return true + if sc[i].sym == x.sym: return true elif sc.kind == nkOpenSymChoice: # same name suffices for open sym choices! - result = sc.sons[0].sym.name.id == x.sym.name.id + 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: @@ -75,7 +89,7 @@ proc checkTypes(c: PPatternContext, p: PSym, n: PNode): bool = result = matchNodeKinds(p.constraint, n) if not result: return if isNil(n.typ): - result = p.typ.kind in {tyVoid, tyStmt} + result = p.typ.kind in {tyVoid, tyTyped} else: result = sigmatch.argtypeMatches(c.c, p.typ, n.typ, fromHlo = true) @@ -83,8 +97,9 @@ 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 = - for i in 1 ..< p.len: - if matches(c, p.sons[i], n): return true + result = false + for i in 1..<p.len: + if matches(c, p[i], n): return true proc bindOrCheck(c: PPatternContext, param: PSym, n: PNode): bool = var pp = getLazy(c, param) @@ -94,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) @@ -101,7 +118,7 @@ proc gather(c: PPatternContext, param: PSym, n: PNode) = pp.add(n) else: pp = newNodeI(nkArgList, n.info, 1) - pp.sons[0] = n + pp[0] = n putLazy(c, param, pp) proc matchNested(c: PPatternContext, p, n: PNode, rpn: bool): bool = @@ -109,24 +126,28 @@ proc matchNested(c: PPatternContext, p, n: PNode, rpn: bool): bool = proc matchStarAux(c: PPatternContext, op, n, arglist: PNode, rpn: bool): bool = result = true - if n.kind in nkCallKinds and matches(c, op.sons[1], n.sons[0]): - for i in 1..sonsLen(n)-1: + if n.kind in nkCallKinds and matches(c, op[1], n[0]): + for i in 1..<n.len: if not matchStarAux(c, op, n[i], arglist, rpn): return false - if rpn: arglist.add(n.sons[0]) - elif n.kind == nkHiddenStdConv and n.sons[1].kind == nkBracket: - let n = n.sons[1] + if rpn: arglist.add(n[0]) + elif n.kind == nkHiddenStdConv and n[1].kind == nkBracket: + let n = n[1] for i in 0..<n.len: if not matchStarAux(c, op, n[i], arglist, rpn): return false - elif checkTypes(c, p.sons[2].sym, n): - add(arglist, n) + elif checkTypes(c, p[2].sym, n): + arglist.add(n) else: result = false if n.kind notin nkCallKinds: return false - if matches(c, p.sons[1], n.sons[0]): + if matches(c, p[1], n[0]): var arglist = newNodeI(nkArgList, n.info) if matchStarAux(c, p, n, arglist, rpn): - result = bindOrCheck(c, p.sons[2].sym, arglist) + 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) @@ -141,27 +162,34 @@ 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.sons[0].ident.s + let opr = p[0].ident.s case opr of "|": result = matchChoice(c, p, n) of "*": result = matchNested(c, p, n, rpn=false) of "**": result = matchNested(c, p, n, rpn=true) - of "~": result = not matches(c, p.sons[1], n) - else: doAssert(false, "invalid pattern") + of "~": result = not matches(c, p[1], n) + else: + result = false + doAssert(false, "invalid pattern") # template {add(a, `&` * b)}(a: string{noalias}, b: varargs[string]) = - # add(a, b) + # a.add(b) elif p.kind == nkCurlyExpr: - if p.sons[1].kind == nkPrefix: - if matches(c, p.sons[0], n): - gather(c, p.sons[1].sons[1].sym, n) + if p[1].kind == nkPrefix: + if matches(c, p[0], n): + gather(c, p[1][1].sym, n) result = true + else: + result = false else: - assert isPatternParam(c, p.sons[1]) - if matches(c, p.sons[0], n): - result = bindOrCheck(c, p.sons[1].sym, n) + 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 @@ -172,80 +200,84 @@ proc matches(c: PPatternContext, p, n: PNode): bool = of nkEmpty, nkNilLit, nkType: result = true else: - var plen = sonsLen(p) # 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 - if plen <= sonsLen(n): - for i in countup(0, plen - 2): - if not matches(c, p.sons[i], n.sons[i]): return - if plen == sonsLen(n) and lastSon(n).kind == nkHiddenStdConv and - lastSon(n).sons[1].kind == nkBracket: + if p.len <= n.len: + for i in 0..<p.len - 1: + if not matches(c, p[i], n[i]): return + if p.len == n.len and lastSon(n).kind == nkHiddenStdConv and + lastSon(n)[1].kind == nkBracket: # unpack varargs: - let n = lastSon(n).sons[1] + let n = lastSon(n)[1] arglist = newNodeI(nkArgList, n.info, n.len) - for i in 0..<n.len: arglist.sons[i] = n.sons[i] + for i in 0..<n.len: arglist[i] = n[i] else: - arglist = newNodeI(nkArgList, n.info, sonsLen(n) - plen + 1) + arglist = newNodeI(nkArgList, n.info, n.len - p.len + 1) # f(1, 2, 3) # p(X) - for i in countup(0, sonsLen(n) - plen): - arglist.sons[i] = n.sons[i + plen - 1] + for i in 0..n.len - p.len: + arglist[i] = n[i + p.len - 1] return bindOrCheck(c, v.sym, arglist) - elif plen-1 == sonsLen(n): - for i in countup(0, plen - 2): - if not matches(c, p.sons[i], n.sons[i]): return + elif p.len-1 == n.len: + for i in 0..<p.len - 1: + if not matches(c, p[i], n[i]): return arglist = newNodeI(nkArgList, n.info) return bindOrCheck(c, v.sym, arglist) - if plen == sonsLen(n): - for i in countup(0, sonsLen(p) - 1): - if not matches(c, p.sons[i], n.sons[i]): return + if p.len == n.len: + 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 = - for j in 0 ..< p.len: - if not matches(c, p.sons[j], n.sons[i+j]): + for j in 0..<p.len: + if not matches(c, p[j], n[i+j]): # we need to undo any bindings: - if not isNil(c.mapping): c.mapping = nil + c.mapping = @[] + c.mappingIsFull = false return false 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: + for i in 0..n.len - p.len: if matchRange(c, p, n, i): c.subMatch = true result = newNodeI(nkStmtList, n.info, 3) - result.sons[0] = extractRange(nkStmtList, n, 0, i-1) - result.sons[1] = extractRange(nkStmtList, n, i, i+p.len-1) - result.sons[2] = extractRange(nkStmtList, n, i+p.len, n.len-1) + result[0] = extractRange(nkStmtList, n, 0, i-1) + result[1] = extractRange(nkStmtList, n, i, i+p.len-1) + result[2] = extractRange(nkStmtList, n, i+p.len, n.len-1) 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.sons[i].sym + for i in 1..<params.len: + let param = params[i].sym if whichAlias(param) != aqNone: return true proc addToArgList(result, n: PNode) = - if n.typ != nil and n.typ.kind != tyStmt: + if n.typ != nil and n.typ.kind != tyTyped: if n.kind != nkArgList: result.add(n) else: - for i in 0 ..< n.len: result.add(n.sons[i]) + for i in 0..<n.len: result.add(n[i]) 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 = sonsLen(s.typ)-1 - var m = matchStmtList(ctx, s.ast.sons[patternPos], n) + 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 # let semantic checking deal with the rest :-) @@ -253,11 +285,13 @@ 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) - for i in 1 ..< params.len: - let param = params.sons[i].sym + 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) # couldn't bind parameter: if isNil(x): return nil @@ -265,9 +299,9 @@ proc applyRule*(c: PContext, s: PSym, n: PNode): PNode = if requiresAA: addToArgList(args, x) # perform alias analysis here: if requiresAA: - for i in 1 ..< params.len: - var rs = result.sons[i] - let param = params.sons[i].sym + for i in 1..<params.len: + var rs = result[i] + let param = params[i].sym case whichAlias(param) of aqNone: discard of aqShouldAlias: @@ -289,8 +323,8 @@ proc applyRule*(c: PContext, s: PSym, n: PNode): PNode = # constraint not fulfilled: if not ok: return nil - markUsed(c.config, n.info, s, c.graph.usageSym) + markUsed(c, n.info, s) if ctx.subMatch: assert m.len == 3 - m.sons[1] = result + m[1] = result result = m 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 0db16f26c..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, - osAmiga, osAtari, osNetware, osMacos, osMacosx, osHaiku, osAndroid, osVxworks - osGenode, osJS, osNimVM, osStandalone + osIrix, osNetbsd, osFreebsd, osOpenbsd, osDragonfly, osCrossos, osAix, osPalmos, osQnx, + osAmiga, osAtari, osNetware, osMacos, osMacosx, osIos, osHaiku, osAndroid, osVxWorks + 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: ".", @@ -139,6 +148,10 @@ const objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", props: {ospNeedsPIC, ospPosix, ospLacksThreadVars}), + (name: "iOS", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), (name: "Haiku", parDir: "..", dllFrmt: "lib$1.so", altDirSep: ":", objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", @@ -168,24 +181,44 @@ const (name: "Standalone", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {})] + props: {}), + (name: "NintendoSwitch", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", exeExt: ".elf", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "FreeRTOS", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + 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: ".", + props: {}), + ] type TSystemCPU* = enum # Also add CPU for in initialization section and # alias conditionals to condsyms (end of module). cpuNone, cpuI386, cpuM68k, cpuAlpha, cpuPowerpc, cpuPowerpc64, - cpuPowerpc64el, cpuSparc, cpuVm, cpuIa64, cpuAmd64, cpuMips, cpuMipsel, - cpuArm, cpuArm64, cpuJS, cpuNimVM, cpuAVR, cpuMSP430, cpuSparc64, - cpuMips64, cpuMips64el, cpuRiscV64 + cpuPowerpc64el, cpuSparc, cpuVm, cpuHppa, cpuIa64, cpuAmd64, cpuMips, + cpuMipsel, cpuArm, cpuArm64, cpuJS, cpuNimVM, cpuAVR, cpuMSP430, + 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), @@ -195,20 +228,27 @@ const (name: "powerpc64el", intSize: 64, endian: littleEndian, floatSize: 64,bit: 64), (name: "sparc", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), (name: "vm", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), + (name: "hppa", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), (name: "ia64", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), - (name: "amd64", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), + (name: "amd64", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), # a.k.a. x86_64, covers both amd and intel (name: "mips", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), (name: "mipsel", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), (name: "arm", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), (name: "arm64", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), - (name: "js", intSize: 32, endian: bigEndian,floatSize: 64,bit: 32), + (name: "js", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), (name: "nimvm", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), + # xxx this seems buggy; on a 64bit machine, sizeof(int) is 64 in nimvm. (name: "avr", intSize: 16, endian: littleEndian, floatSize: 32, bit: 16), (name: "msp430", intSize: 16, endian: littleEndian, floatSize: 32, bit: 16), (name: "sparc64", intSize: 64, endian: bigEndian, floatSize: 64, bit: 64), (name: "mips64", intSize: 64, endian: bigEndian, floatSize: 64, bit: 64), (name: "mips64el", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), - (name: "riscv64", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64)] + (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: "e2k", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), + (name: "loongarch64", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64)] type Target* = object @@ -225,25 +265,34 @@ proc setTarget*(t: var Target; o: TSystemOS, c: TSystemCPU) = #echo "new Target: OS: ", o, " CPU: ", c t.targetCPU = c t.targetOS = o - # assume no cross-compiling - t.hostCPU = c - t.hostOS = o t.intSize = CPU[c].intSize div 8 t.floatSize = CPU[c].floatSize div 8 t.ptrSize = CPU[c].bit div 8 t.tnl = OS[o].newLine proc nameToOS*(name: string): TSystemOS = - for i in countup(succ(osNone), high(TSystemOS)): + for i in succ(osNone)..high(TSystemOS): if cmpIgnoreStyle(name, OS[i].name) == 0: return i result = osNone +proc listOSnames*(): seq[string] = + result = @[] + for i in succ(osNone)..high(TSystemOS): + result.add OS[i].name + proc nameToCPU*(name: string): TSystemCPU = - for i in countup(succ(cpuNone), high(TSystemCPU)): + for i in succ(cpuNone)..high(TSystemCPU): if cmpIgnoreStyle(name, CPU[i].name) == 0: return i result = cpuNone +proc listCPUnames*(): seq[string] = + result = @[] + for i in succ(cpuNone)..high(TSystemCPU): + result.add CPU[i].name + proc setTargetFromSystem*(t: var Target) = - t.setTarget(nameToOS(system.hostOS), nameToCPU(system.hostCPU)) + t.hostOS = nameToOS(system.hostOS) + t.hostCPU = nameToCPU(system.hostCPU) + t.setTarget(t.hostOS, t.hostCPU) diff --git a/compiler/plugins/active.nim b/compiler/plugins/active.nim index 7b5306f9c..19c320aae 100644 --- a/compiler/plugins/active.nim +++ b/compiler/plugins/active.nim @@ -10,7 +10,7 @@ ## Include file that imports all plugins that are active. import - "../compiler" / [pluginsupport, idents, ast], locals, itersgen + ".." / [pluginsupport, idents, ast], locals, itersgen const plugins: array[2, Plugin] = [ 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 440d2e081..e2c97bdc5 100644 --- a/compiler/plugins/itersgen.nim +++ b/compiler/plugins/itersgen.nim @@ -9,9 +9,7 @@ ## Plugin to transform an inline iterator into a data structure. -import ".." / [ast, astalgo, - magicsys, lookups, semdata, - lambdalifting, msgs] +import ".." / [ast, modulegraphs, lookups, semdata, lambdalifting, msgs] proc iterToProcImpl*(c: PContext, n: PNode): PNode = result = newNodeI(nkStmtList, n.info) @@ -27,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, iter.sym.getBody, t) + let body = liftIterToProc(c.graph, iter.sym, getBody(c.graph, iter.sym), t, c.idgen) - let prc = newSym(skProc, n[3].ident, iter.sym.owner, iter.sym.info) - prc.typ = copyType(iter.sym.typ, prc, false) + 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 @@ -44,5 +42,5 @@ proc iterToProcImpl*(c: PContext, n: PNode): PNode = pattern = c.graph.emptyNode, genericParams = c.graph.emptyNode, pragmas = orig[pragmasPos], exceptions = c.graph.emptyNode) - prc.ast.add iter.sym.ast.sons[resultPos] + prc.ast.add iter.sym.ast[resultPos] addInterfaceDecl(c, prc) diff --git a/compiler/plugins/locals.nim b/compiler/plugins/locals.nim index 0048ff985..d3046cd65 100644 --- a/compiler/plugins/locals.nim +++ b/compiler/plugins/locals.nim @@ -9,33 +9,31 @@ ## The builtin 'system.locals' implemented as a plugin. -import ".." / [pluginsupport, ast, astalgo, +import ".." / [ast, astalgo, magicsys, lookups, semdata, lowerings] 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 ... - for scope in walkScopes(c.currentScope): - if scope == c.topLevelScope: break + for scope in localScopesFrom(c, c.currentScope): for it in items(scope.symbols): - # XXX parameters' owners are wrong for generics; this caused some pain - # for closures too; we should finally fix it. - #if it.owner != c.p.owner: return result if it.kind in skLocalVars and it.typ.skipTypes({tyGenericInst, tyVar}).kind notin - {tyVarargs, tyOpenArray, tyTypeDesc, tyStatic, tyExpr, tyStmt, tyEmpty}: + {tyVarargs, tyOpenArray, tyTypeDesc, tyStatic, tyUntyped, tyTyped, tyEmpty}: - var field = newSym(skField, it.name, getCurrOwner(c), n.info) - field.typ = it.typ.skipTypes({tyGenericInst, tyVar}) - field.position = counter - inc(counter) + if it.owner == owner: + var field = newSym(skField, it.name, c.idgen, owner, n.info) + field.typ = it.typ.skipTypes({tyVar}) + field.position = counter + inc(counter) - addSon(tupleType.n, newSymNode(field)) - addSonSkipIntLit(tupleType, field.typ) + tupleType.n.add newSymNode(field) + addSonSkipIntLit(tupleType, field.typ, c.idgen) - var a = newSymNode(it, result.info) - if it.typ.skipTypes({tyGenericInst}).kind == tyVar: a = newDeref(a) - result.add(a) + var a = newSymNode(it, result.info) + if it.typ.skipTypes({tyGenericInst}).kind == tyVar: a = newDeref(a) + result.add(a) 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 c78a3519c..9a298cd90 100644 --- a/compiler/pragmas.nim +++ b/compiler/pragmas.nim @@ -10,70 +10,95 @@ # This module implements semantic checking for pragmas import - os, platform, condsyms, ast, astalgo, idents, semdata, msgs, renderer, - wordrecg, ropes, options, strutils, extccomp, math, magicsys, trees, - types, lookups, lineinfos + 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 const FirstCallConv* = wNimcall LastCallConv* = wNoconv const - procPragmas* = {FirstCallConv..LastCallConv, wImportc, wExportc, wNodecl, - wMagic, wNosideeffect, wSideeffect, wNoreturn, wDynlib, wHeader, - wCompilerProc, wCore, wProcVar, wDeprecated, wVarargs, wCompileTime, wMerge, - wBorrow, wExtern, wImportCompilerProc, wThread, wImportCpp, wImportObjC, - wAsmNoStackFrame, wError, wDiscardable, wNoInit, wCodegenDecl, - wGensym, wInject, wRaises, wTags, wLocks, wDelegator, wGcSafe, wOverride, - wConstructor, wExportNims, wUsed, wLiftLocals, wStacktrace, wLinetrace} + declPragmas = {wImportc, wImportObjC, wImportCpp, wImportJs, wExportc, wExportCpp, + wExportNims, wExtern, wDeprecated, wNodecl, wError, wUsed} + ## 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, + wBorrow, wImportCompilerProc, wThread, + wAsmNoStackFrame, wDiscardable, wNoInit, wCodegenDecl, + wGensym, wInject, wRaises, wEffectsOf, wTags, wForbids, wLocks, wDelegator, wGcSafe, + wConstructor, wLiftLocals, wStackTrace, wLineTrace, wNoDestroy, + wRequires, wEnsures, wEnforceNoRaises, wSystemRaisesDefect, wVirtual, wQuirky, wMember} converterPragmas* = procPragmas methodPragmas* = procPragmas+{wBase}-{wImportCpp} - templatePragmas* = {wImmediate, wDeprecated, wError, wGensym, wInject, wDirty, - wDelegator, wExportNims, wUsed, wPragma} - macroPragmas* = {FirstCallConv..LastCallConv, wImmediate, wImportc, wExportc, - wNodecl, wMagic, wNosideeffect, wCompilerProc, wCore, wDeprecated, wExtern, - wImportCpp, wImportObjC, wError, wDiscardable, wGensym, wInject, wDelegator, - wExportNims, wUsed} - iteratorPragmas* = {FirstCallConv..LastCallConv, wNosideeffect, wSideeffect, - wImportc, wExportc, wNodecl, wMagic, wDeprecated, wBorrow, wExtern, - wImportCpp, wImportObjC, wError, wDiscardable, wGensym, wInject, wRaises, - wTags, wLocks, wGcSafe, wExportNims, wUsed} - exprPragmas* = {wLine, wLocks, wNoRewrite, wGcSafe} - stmtPragmas* = {wChecks, wObjChecks, wFieldChecks, wRangechecks, - wBoundchecks, wOverflowchecks, wNilchecks, wMovechecks, wAssertions, - wWarnings, wHints, - wLinedir, wStacktrace, wLinetrace, wOptimization, wHint, wWarning, wError, + templatePragmas* = {wDeprecated, wError, wGensym, wInject, wDirty, + 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, wEffectsOf, + wTags, wForbids, wLocks, wGcSafe, wRequires, wEnsures} + exprPragmas* = {wLine, wLocks, wNoRewrite, wGcSafe, wNoSideEffect} + stmtPragmas* = { + wHint, wWarning, wError, wFatal, wDefine, wUndef, wCompile, wLink, wLinksys, wPure, wPush, wPop, - wBreakpoint, wWatchPoint, wPassl, wPassc, + wPassl, wPassc, wLocalPassc, wDeadCodeElimUnused, # deprecated, always on wDeprecated, - wFloatchecks, wInfChecks, wNanChecks, wPragma, wEmit, wUnroll, - wLinearScanEnd, wPatterns, wEffects, wNoForward, wReorder, wComputedGoto, - wInjectStmt, wDeprecated, wExperimental, wThis} - lambdaPragmas* = {FirstCallConv..LastCallConv, wImportc, wExportc, wNodecl, - wNosideeffect, wSideeffect, wNoreturn, wDynlib, wHeader, - wDeprecated, wExtern, wThread, wImportCpp, wImportObjC, wAsmNoStackFrame, - wRaises, wLocks, wTags, wGcSafe} - typePragmas* = {wImportc, wExportc, wDeprecated, wMagic, wAcyclic, wNodecl, - wPure, wHeader, wCompilerProc, wCore, wFinal, wSize, wExtern, wShallow, - wImportCpp, wImportObjC, wError, wIncompleteStruct, wByCopy, wByRef, + wPragma, wEmit, wUnroll, + wLinearScanEnd, wPatterns, wTrMacros, wEffects, wNoForward, wReorder, wComputedGoto, + 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, 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, - wBorrow, wGcSafe, wExportNims, wPartial, wUsed, wExplain, wPackage} - fieldPragmas* = {wImportc, wExportc, wDeprecated, wExtern, - wImportCpp, wImportObjC, wError, wGuard, wBitsize, wUsed} - varPragmas* = {wImportc, wExportc, wVolatile, wRegister, wThreadVar, wNodecl, - wMagic, wHeader, wDeprecated, wCompilerProc, wCore, wDynlib, wExtern, - wImportCpp, wImportObjC, wError, wNoInit, wCompileTime, wGlobal, - wGensym, wInject, wCodegenDecl, wGuard, wGoto, wExportNims, wUsed} - constPragmas* = {wImportc, wExportc, wHeader, wDeprecated, wMagic, wNodecl, - wExtern, wImportCpp, wImportObjC, wError, wGensym, wInject, wExportNims, - wIntDefine, wStrDefine, wUsed, wCompilerProc, wCore} + wCppNonPod, wBorrow, wGcSafe, wPartial, wExplain, wPackage, wCodegenDecl, + wSendable, wNoInit} + fieldPragmas* = declPragmas + {wGuard, wBitsize, wCursor, + wRequiresInit, wNoalias, wAlign, wNoInit} - {wExportNims, wNodecl} # why exclude these? + varPragmas* = declPragmas + {wVolatile, wRegister, wThreadVar, + wMagic, wHeader, wCompilerProc, wCore, wDynlib, + wNoInit, wCompileTime, wGlobal, wLiftLocals, + wGensym, wInject, wCodegenDecl, + wGuard, wGoto, wCursor, wNoalias, wAlign} + constPragmas* = declPragmas + {wHeader, wMagic, + wGensym, wInject, + wIntDefine, wStrDefine, wBoolDefine, wDefine, + wCompilerProc, wCore} + paramPragmas* = {wNoalias, wInject, wGensym, wByRef, wByCopy, wCodegenDecl, wExportc, wExportCpp} letPragmas* = varPragmas - procTypePragmas* = {FirstCallConv..LastCallConv, wVarargs, wNosideeffect, - wThread, wRaises, wLocks, wTags, wGcSafe} + procTypePragmas* = {FirstCallConv..LastCallConv, wVarargs, wNoSideEffect, + 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: @@ -81,50 +106,67 @@ proc getPragmaVal*(procAst: PNode; name: TSpecialWord): PNode = it[0].ident.id == ord(name): return it[1] -proc pragma*(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords) +proc pragma*(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords; + isStatement: bool = false) -proc recordPragma(c: PContext; n: PNode; key, val: string; val2 = "") = - var recorded = newNodeI(nkCommentStmt, n.info) - recorded.add newStrNode(key, n.info) - recorded.add newStrNode(val, n.info) - if val2.len > 0: recorded.add newStrNode(val2, n.info) - c.graph.recordStmt(c.graph, c.module, recorded) +proc recordPragma(c: PContext; n: PNode; args: varargs[string]) = + var recorded = newNodeI(nkReplayAction, n.info) + for i in 0..args.high: + recorded.add newStrNode(args[i], n.info) + addPragmaComputation(c, recorded) const errStringLiteralExpected = "string literal expected" errIntLiteralExpected = "integer literal expected" proc invalidPragma*(c: PContext; n: PNode) = - localError(c.config, n.info, "invalid pragma: " % renderTree(n, {renderNoComments})) + localError(c.config, n.info, "invalid pragma: " & renderTree(n, {renderNoComments})) + +proc illegalCustomPragma*(c: PContext, n: PNode, s: PSym) = + 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: + localError(c.config, n.info, "proposition expected") + else: + n[1] = c.semExpr(c, n[1]) -proc pragmaAsm*(c: PContext, n: PNode): char = - result = '\0' - if n != nil: - for i in countup(0, sonsLen(n) - 1): - let it = n.sons[i] - if it.kind in nkPragmaCallKinds and it.len == 2 and it.sons[0].kind == nkIdent: - case whichKeyword(it.sons[0].ident) - of wSubsChar: - if it.sons[1].kind == nkCharLit: result = chr(int(it.sons[1].intVal)) - else: invalidPragma(c, it) - else: invalidPragma(c, it) - else: - invalidPragma(c, it) +proc pragmaEnsures(c: PContext, n: PNode) = + if n.kind notin nkPragmaCallKinds or n.len != 2: + localError(c.config, n.info, "proposition expected") + else: + openScope(c) + let o = getCurrOwner(c) + 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 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 '$'?)") - if c.config.cmd == cmdPretty and '$' notin extname: - # note that '{.importc.}' is transformed into '{.importc: "$1".}' - s.loc.flags.incl(lfFullExternalName) + when hasFFI: + s.cname = $s.loc.snippet + proc makeExternImport(c: PContext; s: PSym, extname: string, info: TLineInfo) = setExternName(c, s, extname, info) @@ -146,7 +188,7 @@ proc processImportCpp(c: PContext; s: PSym, extname: string, info: TLineInfo) = incl(s.flags, sfImportc) incl(s.flags, sfInfixCall) excl(s.flags, sfForward) - if c.config.cmd == cmdCompileToC: + if c.config.backend == backendC: let m = s.getModule() incl(m.flags, sfCompileToCpp) incl c.config.globalOptions, optMixedMode @@ -157,11 +199,11 @@ proc processImportObjC(c: PContext; s: PSym, extname: string, info: TLineInfo) = incl(s.flags, sfNamedParamCall) excl(s.flags, sfForward) let m = s.getModule() - incl(m.flags, sfCompileToObjC) + 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: @@ -169,9 +211,9 @@ proc getStrLitNode(c: PContext, n: PNode): PNode = # error correction: result = newEmptyStrNode(c, n) else: - n.sons[1] = c.semConstExpr(c, n.sons[1]) - case n.sons[1].kind - of nkStrLit, nkRStrLit, nkTripleStrLit: result = n.sons[1] + n[1] = c.semConstExpr(c, n[1]) + case n[1].kind + of nkStrLit, nkRStrLit, nkTripleStrLit: result = n[1] else: localError(c.config, n.info, errStringLiteralExpected) # error correction: @@ -181,20 +223,30 @@ 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: - n.sons[1] = c.semConstExpr(c, n.sons[1]) - case n.sons[1].kind - of nkIntLit..nkInt64Lit: result = int(n.sons[1].intVal) + n[1] = c.semConstExpr(c, n[1]) + case n[1].kind + of nkIntLit..nkInt64Lit: result = int(n[1].intVal) else: localError(c.config, n.info, errIntLiteralExpected) 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: @@ -203,9 +255,9 @@ proc processMagic(c: PContext, n: PNode, s: PSym) = localError(c.config, n.info, errStringLiteralExpected) return var v: string - if n.sons[1].kind == nkIdent: v = n.sons[1].ident.s + if n[1].kind == nkIdent: v = n[1].ident.s else: v = expectStrLit(c, n) - for m in countup(low(TMagic), high(TMagic)): + for m in TMagic: if substr($m, 1) == v: s.magic = m break @@ -214,26 +266,54 @@ proc processMagic(c: PContext, n: PNode, s: PSym) = proc wordToCallConv(sw: TSpecialWord): TCallingConvention = # this assumes that the order of special words and calling conventions is # the same - result = TCallingConvention(ord(ccDefault) + ord(sw) - ord(wNimcall)) + 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.sons[1]) - n.sons[1] = x + let x = c.semConstBoolExpr(c, n[1]) + n[1] = x if x.kind == nkIntLit: return x.intVal != 0 localError(c.config, n.info, "'on' or 'off' expected") proc onOff(c: PContext, n: PNode, op: TOptions, resOptions: var TOptions) = - if isTurnedOn(c, n): resOptions = resOptions + op - else: resOptions = resOptions - op + if isTurnedOn(c, n): resOptions.incl op + else: resOptions.excl op -proc pragmaNoForward(c: PContext, n: PNode; flag=sfNoForward) = - if isTurnedOn(c, n): incl(c.module.flags, flag) - else: excl(c.module.flags, flag) +proc pragmaNoForward*(c: PContext, n: PNode; flag=sfNoForward) = + if isTurnedOn(c, n): + incl(c.module.flags, flag) + c.features.incl codeReordering + else: + excl(c.module.flags, flag) + # c.features.excl codeReordering + + # deprecated as of 0.18.1 + message(c.config, n.info, warnDeprecated, + "use {.experimental: \"codeReordering\".} instead; " & + (if flag == sfNoForward: "{.noForward.}" else: "{.reorder.}") & " is deprecated") + +proc 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.sons[1].kind == nkIdent: - let sw = whichKeyword(n.sons[1].ident) + if n.kind in nkPragmaCallKinds and n.len == 2 and n[1].kind == nkIdent: + let sw = whichKeyword(n[1].ident) case sw of FirstCallConv..LastCallConv: c.optionStack[^1].defaultCC = wordToCallConv(sw) @@ -250,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: @@ -260,9 +340,9 @@ proc expectDynlibNode(c: PContext, n: PNode): PNode = else: # For the OpenGL wrapper we support: # {.dynlib: myGetProcAddr(...).} - result = c.semExpr(c, n.sons[1]) + 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) @@ -270,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: @@ -284,69 +364,93 @@ proc processDynLib(c: PContext, n: PNode, sym: PSym) = # a calling convention that doesn't introduce custom name mangling # cdecl is the default - the user can override this explicitly if sym.kind in routineKinds and sym.typ != nil and - sym.typ.callConv == ccDefault: + tfExplicitCallConv notin sym.typ.flags: sym.typ.callConv = ccCDecl proc processNote(c: PContext, n: PNode) = - if n.kind in nkPragmaCallKinds and len(n) == 2 and + template handleNote(enumVals, notes) = + let x = findStr(enumVals.a, enumVals.b, n[0][1].ident.s, errUnknown) + if x != errUnknown: + nk = TNoteKind(x) + let x = c.semConstBoolExpr(c, n[1]) + n[1] = x + if x.kind == nkIntLit and x.intVal != 0: incl(notes, nk) + else: excl(notes, nk) + else: + invalidPragma(c, n) + + if n.kind in nkPragmaCallKinds and n.len == 2 and n[0].kind == nkBracketExpr and n[0].len == 2 and n[0][1].kind == nkIdent and n[0][0].kind == nkIdent: var nk: TNoteKind case whichKeyword(n[0][0].ident) - of wHint: - var x = findStr(HintsToStr, n[0][1].ident.s) - if x >= 0: nk = TNoteKind(x + ord(hintMin)) - else: invalidPragma(c, n); return - of wWarning: - var x = findStr(WarningsToStr, n[0][1].ident.s) - if x >= 0: nk = TNoteKind(x + ord(warnMin)) - else: invalidPragma(c, n); return - else: - invalidPragma(c, n) - return - - let x = c.semConstBoolExpr(c, n[1]) - n.sons[1] = x - if x.kind == nkIntLit and x.intVal != 0: incl(c.config.notes, nk) - else: excl(c.config.notes, nk) - else: - invalidPragma(c, n) - -proc pragmaToOptions(w: TSpecialWord): TOptions {.inline.} = + of wHint: handleNote(hintMin .. hintMax, c.config.notes) + of wWarning: handleNote(warnMin .. warnMax, c.config.notes) + of wWarningAsError: handleNote(warnMin .. warnMax, c.config.warningAsErrors) + of wHintAsError: handleNote(hintMin .. hintMax, c.config.warningAsErrors) + else: invalidPragma(c, n) + else: invalidPragma(c, n) + +proc pragmaToOptions*(w: TSpecialWord): TOptions {.inline.} = case w of wChecks: ChecksOptions of wObjChecks: {optObjCheck} of wFieldChecks: {optFieldCheck} - of wRangechecks: {optRangeCheck} - of wBoundchecks: {optBoundsCheck} - of wOverflowchecks: {optOverflowCheck} - of wNilchecks: {optNilCheck} - of wFloatchecks: {optNaNCheck, optInfCheck} + of wRangeChecks: {optRangeCheck} + of wBoundChecks: {optBoundsCheck} + of wOverflowChecks: {optOverflowCheck} + of wFloatChecks: {optNaNCheck, optInfCheck} of wNanChecks: {optNaNCheck} of wInfChecks: {optInfCheck} - of wMovechecks: {optMoveCheck} + of wStaticBoundchecks: {optStaticBoundsCheck} + of wStyleChecks: {optStyleCheck} of wAssertions: {optAssert} of wWarnings: {optWarns} of wHints: {optHints} - of wLinedir: {optLineDir} - of wStacktrace: {optStackTrace} - of wLinetrace: {optLineTrace} - of wDebugger: {optEndb} + of wLineDir: {optLineDir} + of wStackTrace: {optStackTrace} + of wLineTrace: {optLineTrace} + of wDebugger: {optNone} of wProfiler: {optProfiler, optMemTracker} of wMemTracker: {optMemTracker} of wByRef: {optByRef} of wImplicitStatic: {optImplicitStatic} - of wPatterns: {optPatterns} + of wPatterns, wTrMacros: {optTrMacros} + of wSinkInference: {optSinkInference} + of wQuirky: {optQuirky} else: {} +proc processExperimental(c: PContext; n: PNode) = + if n.kind notin nkPragmaCallKinds or n.len != 2: + c.features.incl oldExperimentalFeatures + else: + n[1] = c.semConstExpr(c, n[1]) + case n[1].kind + of nkStrLit, nkRStrLit, nkTripleStrLit: + try: + let feature = parseEnum[Feature](n[1].strVal) + c.features.incl feature + if feature == codeReordering: + if not isTopLevel(c): + localError(c.config, n.info, + "Code reordering experimental pragma only valid at toplevel") + c.module.flags.incl sfReorder + except ValueError: + localError(c.config, n[1].info, "unknown experimental feature") + else: + localError(c.config, n.info, errStringLiteralExpected) + proc tryProcessOption(c: PContext, n: PNode, resOptions: var TOptions): bool = result = true if n.kind notin nkPragmaCallKinds or n.len != 2: result = false - elif n.sons[0].kind == nkBracketExpr: processNote(c, n) - elif n.sons[0].kind != nkIdent: result = false + elif n[0].kind == nkBracketExpr: processNote(c, n) + elif n[0].kind != nkIdent: result = false else: - let sw = whichKeyword(n.sons[0].ident) + let sw = whichKeyword(n[0].ident) + if sw == wExperimental: + processExperimental(c, n) + return true let opts = pragmaToOptions(sw) if opts != {}: onOff(c, n, opts, resOptions) @@ -355,10 +459,10 @@ proc tryProcessOption(c: PContext, n: PNode, resOptions: var TOptions): bool = of wCallconv: processCallConv(c, n) of wDynlib: processDynLib(c, n, nil) of wOptimization: - if n.sons[1].kind != nkIdent: + if n[1].kind != nkIdent: invalidPragma(c, n) else: - case n.sons[1].ident.s.normalize + case n[1].ident.s.normalize of "speed": incl(resOptions, optOptimizeSpeed) excl(resOptions, optOptimizeSize) @@ -376,125 +480,144 @@ 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.sons[start-1].kind in nkPragmaCallKinds: + if n[start-1].kind in nkPragmaCallKinds: localError(c.config, n.info, "'push' cannot have arguments") - var x = newOptionEntry(c.config) - var y = c.optionStack[^1] - x.options = c.config.options - x.defaultCC = y.defaultCC - x.dynlib = y.dynlib - x.notes = c.config.notes - c.optionStack.add(x) - for i in countup(start, sonsLen(n) - 1): - if not tryProcessOption(c, n.sons[i], c.config.options): + var x = pushOptionEntry(c) + 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.sons[i] + x.otherPragmas.add n[i] #localError(c.config, n.info, errOptionExpected) # If stacktrace is disabled globally we should not enable it if optStackTrace notin c.optionStack[0].options: c.config.options.excl(optStackTrace) + when defined(debugOptions): + echo c.config $ n.info, " PUSH config is now ", c.config.options proc processPop(c: PContext, n: PNode) = if c.optionStack.len <= 1: localError(c.config, n.info, "{.pop.} without a corresponding {.push.}") else: - c.config.options = c.optionStack[^1].options - c.config.notes = c.optionStack[^1].notes - c.optionStack.setLen(c.optionStack.len - 1) + popOptionEntry(c) + 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) - message(c.config, n.info, warnDeprecated, "define") else: invalidPragma(c, n) proc processUndef(c: PContext, n: PNode) = if (n.kind in nkPragmaCallKinds and n.len == 2) and (n[1].kind == nkIdent): undefSymbol(c.config.symbols, n[1].ident.s) - message(c.config, n.info, warnDeprecated, "undef") else: invalidPragma(c, n) -type - TLinkFeature = enum - linkNormal, linkSys - -proc relativeFile(c: PContext; n: PNode; ext=""): string = +proc relativeFile(c: PContext; n: PNode; ext=""): AbsoluteFile = var s = expectStrLit(c, n) if ext.len > 0 and splitFile(s).ext == "": s = addFileExt(s, ext) - result = parentDir(toFullPath(c.config, n.info)) / s + result = AbsoluteFile parentDir(toFullPath(c.config, n.info)) / s if not fileExists(result): - if isAbsolute(s): result = s + if isAbsolute(s): result = AbsoluteFile s else: result = findFile(c.config, s) - if result.len == 0: result = s + if result.isEmpty: result = AbsoluteFile s proc processCompile(c: PContext, n: PNode) = - proc docompile(c: PContext; it: PNode; src, dest: string) = - var cf = Cfile(cname: src, obj: dest, flags: {CfileFlag.External}) - extccomp.addExternalFileToCompile(c.config, cf) - recordPragma(c, it, "compile", src, dest) + ## 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) + 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.sons[i] = c.semConstExpr(c, n[i]) + 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 = "" - let it = if n.kind in nkPragmaCallKinds and n.len == 2: n.sons[1] else: n + let it = if n.kind in nkPragmaCallKinds and n.len == 2: n[1] else: n if it.kind in {nkPar, nkTupleConstr} and it.len == 2: let s = getStrLit(c, it, 0) let dest = getStrLit(c, it, 1) var found = parentDir(toFullPath(c.config, n.info)) / s for f in os.walkFiles(found): - let obj = completeCFilePath(c.config, dest % extractFilename(f)) - docompile(c, it, f, obj) + let obj = completeCfilePath(c.config, AbsoluteFile(dest % extractFilename(f))) + docompile(c, it, AbsoluteFile f, obj, "") else: - let s = expectStrLit(c, n) - var found = parentDir(toFullPath(c.config, n.info)) / s + var s = "" + var customArgs = "" + if n.kind in nkCallKinds: + s = getStrLit(c, n, 1) + if n.len <= 3: + customArgs = getStrLit(c, n, 2) + else: + localError(c.config, n.info, "'.compile' pragma takes up 2 arguments") + else: + s = expectStrLit(c, n) + + var found = AbsoluteFile(parentDir(toFullPath(c.config, n.info)) / s) if not fileExists(found): - if isAbsolute(s): found = s + if isAbsolute(s): found = AbsoluteFile s else: found = findFile(c.config, s) - if found.len == 0: found = s - let obj = toObjFile(c.config, completeCFilePath(c.config, changeFileExt(found, ""), false)) - docompile(c, it, found, obj) + if found.isEmpty: found = AbsoluteFile s + let mangled = completeCfilePath(c.config, mangleModuleName(c.config, found).AbsoluteFile) + let obj = toObjFile(c.config, mangled) + docompile(c, it, found, obj, customArgs) -proc processCommonLink(c: PContext, n: PNode, feature: TLinkFeature) = +proc processLink(c: PContext, n: PNode) = let found = relativeFile(c, n, CC[c.config.cCompiler].objExt) - case feature - of linkNormal: - extccomp.addExternalFileToLink(c.config, found) - recordPragma(c, n, "link", found) - of linkSys: - let dest = c.config.libpath / completeCFilePath(c.config, found, false) - extccomp.addExternalFileToLink(c.config, dest) - recordPragma(c, n, "link", dest) - else: internalError(c.config, n.info, "processCommonLink") - -proc pragmaBreakpoint(c: PContext, n: PNode) = - discard getOptionalStr(c, n, "") - -proc pragmaWatchpoint(c: PContext, n: PNode) = - if n.kind in nkPragmaCallKinds and n.len == 2: - n.sons[1] = c.semExpr(c, n.sons[1]) - else: - invalidPragma(c, n) + extccomp.addExternalFileToLink(c.config, found) + recordPragma(c, n, "link", found.string) proc semAsmOrEmit*(con: PContext, n: PNode, marker: char): PNode = - case n.sons[1].kind + case n[1].kind of nkStrLit, nkRStrLit, nkTripleStrLit: - result = newNode(if n.kind == nkAsmStmt: nkAsmStmt else: nkArgList, n.info) - var str = n.sons[1].strVal + 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") return @@ -503,28 +626,29 @@ proc semAsmOrEmit*(con: PContext, n: PNode, marker: char): PNode = while true: var b = strutils.find(str, marker, a) var sub = if b < 0: substr(str, a) else: substr(str, a, b - 1) - if sub != "": addSon(result, newStrNode(nkStrLit, sub)) + if sub != "": result.add newStrNode(nkStrLit, sub) if b < 0: break var c = strutils.find(str, marker, b + 1) if c < 0: sub = substr(str, b + 1) else: sub = substr(str, b + 1, c - 1) if sub != "": - var e = searchInScopes(con, getIdent(con.cache, sub)) + var amb = false + var e = searchInScopes(con, getIdent(con.cache, sub), amb) + # XXX what to do here if 'amb' is true? if e != nil: - when false: - if e.kind == skStub: loadStub(e) incl(e.flags, sfUsed) - addSon(result, newSymNode(e)) + result.add newSymNode(e) else: - addSon(result, newStrNode(nkStrLit, sub)) + result.add newStrNode(nkStrLit, sub) else: # an empty '``' produces a single '`' - addSon(result, newStrNode(nkStrLit, $marker)) + result.add newStrNode(nkStrLit, $marker) if c < 0: break a = c + 1 else: illFormedAstLocal(n, con.config) - result = newNode(nkAsmStmt, n.info) + 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: @@ -534,13 +658,13 @@ 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.sons[i] = c.semExpr(c, n1[i]) - n.sons[1] = b + b[i] = c.semExprWithType(c, n1[i], {efTypeAllowed}) + n[1] = b else: - n.sons[1] = c.semConstExpr(c, n1) - case n.sons[1].kind + n[1] = c.semConstExpr(c, n1) + case n[1].kind of nkStrLit, nkRStrLit, nkTripleStrLit: - n.sons[1] = semAsmOrEmit(c, n, '`') + n[1] = semAsmOrEmit(c, n, '`') else: localError(c.config, n.info, errStringLiteralExpected) @@ -553,27 +677,26 @@ proc pragmaUnroll(c: PContext, n: PNode) = elif n.kind in nkPragmaCallKinds and n.len == 2: var unrollFactor = expectIntLit(c, n) if unrollFactor <% 32: - n.sons[1] = newIntNode(nkIntLit, unrollFactor) + n[1] = newIntNode(nkIntLit, unrollFactor) else: invalidPragma(c, n) proc pragmaLine(c: PContext, n: PNode) = if n.kind in nkPragmaCallKinds and n.len == 2: - n.sons[1] = c.semConstExpr(c, n.sons[1]) - let a = n.sons[1] + n[1] = c.semConstExpr(c, n[1]) + let a = n[1] if a.kind in {nkPar, nkTupleConstr}: # unpack the tuple - var x = a.sons[0] - var y = a.sons[1] - if x.kind == nkExprColonExpr: x = x.sons[1] - if y.kind == nkExprColonExpr: y = y.sons[1] + var x = a[0] + var y = a[1] + if x.kind == nkExprColonExpr: x = x[1] + if y.kind == nkExprColonExpr: y = y[1] if x.kind != nkStrLit: localError(c.config, n.info, errStringLiteralExpected) elif y.kind != nkIntLit: localError(c.config, n.info, errIntLiteralExpected) else: - # XXX this produces weird paths which are not properly resolved: - n.info.fileIndex = msgs.fileInfoIdx(c.config, x.strVal) + n.info.fileIndex = fileInfoIdx(c.config, AbsoluteFile(x.strVal)) n.info.line = uint16(y.intVal) else: localError(c.config, n.info, "tuple expected") @@ -582,24 +705,32 @@ 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.len == 2: invalidPragma(c, n) - elif it[0].kind != nkIdent: invalidPragma(c, n) - elif it[1].kind != nkIdent: 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, nil, it.info, c.config.options) - userPragma.ast = newNode(nkPragma, n.info, n.sons[i+1..^1]) + 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) proc pragmaRaisesOrTags(c: PContext, n: PNode) = proc processExc(c: PContext, x: PNode) = - var t = skipTypes(c.semTypeNode(c, x, nil), skipPtrs) - if t.kind != tyObject: - localError(c.config, x.info, errGenerated, "invalid type for raises/tags list") - x.typ = t + if c.hasUnresolvedArgs(c, x): + x.typ = makeTypeFromExpr(c, x) + else: + var t = skipTypes(c.semTypeNode(c, x, nil), skipPtrs) + if t.kind notin {tyObject, tyOr}: + localError(c.config, x.info, errGenerated, "invalid type for raises/tags list") + x.typ = t if n.kind in nkPragmaCallKinds and n.len == 2: - let it = n.sons[1] + let it = n[1] if it.kind notin {nkCurly, nkBracket}: processExc(c, it) else: @@ -615,41 +746,26 @@ proc pragmaLockStmt(c: PContext; it: PNode) = if n.kind != nkBracket: localError(c.config, n.info, errGenerated, "locks pragma takes a list of expressions") else: - for i in 0 ..< n.len: - n.sons[i] = c.semExpr(c, n.sons[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) + for i in 0..<n.len: + n[i] = c.semExpr(c, n[i]) proc typeBorrow(c: PContext; sym: PSym, n: PNode) = if n.kind in nkPragmaCallKinds and n.len == 2: - let it = n.sons[1] + let it = n[1] if it.kind != nkAccQuoted: localError(c.config, n.info, "a type can only borrow `.` for now") incl(sym.typ.flags, tfBorrowDot) 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) incl(s.flags, sfCompilerProc) incl(s.flags, sfUsed) registerCompilerProc(c.graph, s) + if c.config.symbolFiles != disabledSf: + addCompilerProc(c.encoder, c.packedRepr, s) proc deprecatedStmt(c: PContext; outerPragma: PNode) = let pragma = outerPragma[1] @@ -659,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, dest, n[0].info, c.config.options) - incl(alias.flags, sfExported) - if sfCompilerProc in dest.flags: markCompilerProc(c, alias) - addInterfaceDecl(c, alias) - n.sons[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: @@ -687,77 +792,119 @@ 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), 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 = - if n.kind == nkIdent: - result = newTree(nkCall, n) - elif n.kind == nkExprColonExpr: +proc semCustomPragma(c: PContext, n: PNode, sym: PSym): PNode = + var callNode: PNode + + case n.kind + of nkIdentKinds: + # pragma -> pragma() + callNode = newTree(nkCall, n) + of nkExprColonExpr: # pragma: arg -> pragma(arg) - result = newTree(nkCall, n[0], n[1]) - elif n.kind in nkPragmaCallKinds + {nkIdent}: - result = n + callNode = newTree(nkCall, n[0], n[1]) + of nkPragmaCallKinds - {nkExprColonExpr}: + callNode = n else: invalidPragma(c, n) return n - let r = c.semOverloadedCall(c, result, n, {skTemplate}, {}) + 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) - else: - result = r - if n.kind == nkIdent: - result = result[0] - elif n.kind == nkExprColonExpr: - result.kind = n.kind # pragma(arg) -> pragma: arg - -proc processExperimental(c: PContext; n: PNode; s: PSym) = - if not isTopLevel(c): - localError(c.config, n.info, "'experimental' pragma only valid as toplevel statement") + 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: + # pragma() -> pragma + result = result[0] + elif n.kind == nkExprColonExpr and r.len == 2: + # 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: - c.features.incl oldExperimentalFeatures + localError(c.config, n.info, errGenerated, "parameter name expected") else: - n[1] = c.semConstExpr(c, n[1]) - case n[1].kind - of nkStrLit, nkRStrLit, nkTripleStrLit: - try: - c.features.incl parseEnum[Feature](n[1].strVal) - except ValueError: - localError(c.config, n[1].info, "unknown experimental feature") + let it = n[1] + if it.kind in {nkCurly, nkBracket}: + for x in items(it): processParam(c, x) else: - localError(c.config, n.info, errStringLiteralExpected) + processParam(c, it) proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, - validPragmas: TSpecialWords): bool = - var it = n.sons[i] - var key = if it.kind in nkPragmaCallKinds and it.len > 1: it.sons[0] else: it + validPragmas: TSpecialWords, + comesFromPush, isStatement: bool): bool = + result = false + var it = n[i] + 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 + elif key.kind == nkCast: + if comesFromPush: + localError(c.config, n.info, "a 'cast' pragma cannot be pushed") + elif not isStatement: + localError(c.config, n.info, "'cast' pragma only allowed in a statement context") + case whichPragma(key[1]) + of wRaises, wTags, wForbids: pragmaRaisesOrTags(c, key[1]) + else: discard + return elif key.kind notin nkIdentKinds: - n.sons[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: + 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) - pragma(c, sym, userPragma.ast, validPragmas) + 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: + checkPragmaUse(c, key.info, k, ident.s, (if sym != nil: sym else: c.module)) case k - of wExportc: + 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) + else: + incl(sym.flags, sfMangleCpp) incl(sym.flags, sfUsed) # avoid wrong hints of wImportc: let name = getOptionalStr(c, it, "$1") @@ -770,33 +917,48 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, recordPragma(c, it, "cppdefine", name) processImportCompilerProc(c, sym, name, it.info) of wExtern: setExternName(c, sym, expectStrLit(c, it), it.info) - of wImmediate: - if sym.kind in {skTemplate, skMacro}: - incl(sym.flags, sfImmediate) - incl(sym.flags, sfAllUntyped) - message(c.config, n.info, warnDeprecated, "use 'untyped' parameters instead; immediate") - else: invalidPragma(c, it) 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: + incl(sym.flags, sfCppNonPod) + of wImportJs: + if c.config.backend != backendJs: + localError(c.config, it.info, "`importjs` pragma requires the JavaScript target") + let name = getOptionalStr(c, it, "$1") + incl(sym.flags, sfImportc) + incl(sym.flags, sfInfixCall) + if sym.kind in skProcKinds and {'(', '#', '@'} notin name: + localError(c.config, n.info, "`importjs` for routines requires a pattern") + setExternName(c, sym, name, it.info) of wImportObjC: processImportObjC(c, sym, getOptionalStr(c, it, "$1"), it.info) - of wAlign: - if sym.typ == nil: invalidPragma(c, it) - var align = expectIntLit(c, it) - if (not isPowerOfTwo(align) and align != 0) or align >% high(int16): - localError(c.config, it.info, "power of two expected") - else: - sym.typ.align = align.int16 of wSize: if sym.typ == nil: invalidPragma(c, it) var size = expectIntLit(c, it) - if not isPowerOfTwo(size) or size <= 0 or size > 8: - localError(c.config, it.info, "power of two expected") - else: + case size + of 1, 2, 4: sym.typ.size = size + sym.typ.align = int16 size + of 8: + sym.typ.size = 8 + sym.typ.align = floatInt64Align(c.config) + else: + localError(c.config, it.info, "size may only be 1, 2, 4 or 8") + of wAlign: + let alignment = expectIntLit(c, it) + if isPowerOfTwo(alignment) and alignment > 0: + sym.alignment = max(sym.alignment, alignment) + else: + localError(c.config, it.info, "power of two expected") of wNodecl: noVal(c, it) incl(sym.loc.flags, lfNoDecl) @@ -808,30 +970,44 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, of wVolatile: noVal(c, it) incl(sym.flags, sfVolatile) + of wCursor: + noVal(c, it) + incl(sym.flags, sfCursor) of wRegister: noVal(c, it) incl(sym.flags, sfRegister) + 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, sfReorder) + of wReorder: pragmaNoForward(c, it, flag = sfReorder) of wMagic: processMagic(c, it, sym) of wCompileTime: noVal(c, it) - incl(sym.flags, sfCompileTime) - incl(sym.loc.flags, lfNoDecl) + if comesFromPush: + if sym.kind in {skProc, skFunc}: + incl(sym.flags, sfCompileTime) + else: + incl(sym.flags, sfCompileTime) + #incl(sym.loc.flags, lfNoDecl) of wGlobal: 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) @@ -839,22 +1015,29 @@ 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) - of wOverride: - sym.flags.incl sfOverriden - of wNosideeffect: + if sym.loc.snippet == "": sym.loc.snippet = rope(sym.name.s) + of wNoSideEffect: noVal(c, it) - incl(sym.flags, sfNoSideEffect) - if sym.typ != nil: incl(sym.typ.flags, tfNoSideEffect) - of wSideeffect: + if sym != nil: + incl(sym.flags, sfNoSideEffect) + if sym.typ != nil: incl(sym.typ.flags, tfNoSideEffect) + of wSideEffect: noVal(c, it) incl(sym.flags, sfSideEffect) of wNoreturn: noVal(c, it) - incl(sym.flags, sfNoReturn) - if sym.typ[0] != nil: + # Disable the 'noreturn' annotation when in the "Quirky Exceptions" mode! + if c.config.exc != excQuirky: + incl(sym.flags, sfNoReturn) + if sym.typ.returnType != nil: localError(c.config, sym.ast[paramsPos][0].info, ".noreturn with return type not allowed") + of wNoDestroy: + noVal(c, it) + incl(sym.flags, sfGeneratedOp) + of wNosinks: + noVal(c, it) + incl(sym.flags, sfWasForwarded) of wDynlib: processDynLib(c, it, sym) of wCompilerProc, wCore: @@ -862,17 +1045,25 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, cppDefine(c.graph.config, sym.name.s) recordPragma(c, it, "cppdefine", sym.name.s) if sfFromGeneric notin sym.flags: markCompilerProc(c, sym) + 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: + 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: + # We don't support the extra annotation field + if it.kind in nkPragmaCallKinds: + localError(c.config, it.info, "annotation to deprecated not supported here") + incl(sym.flags, sfDeprecated) + # At this point we're quite sure this is a statement and applies to the + # whole module elif it.kind in nkPragmaCallKinds: deprecatedStmt(c, it) - elif sym != nil: incl(sym.flags, sfDeprecated) else: incl(c.module.flags, sfDeprecated) of wVarargs: noVal(c, it) @@ -907,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 = ccDefault + 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: @@ -932,37 +1128,50 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, recordPragma(c, it, "warning", s) message(c.config, it.info, warnUser, s) of wError: - if sym != nil and sym.isRoutine: + if sym != nil and (sym.isRoutine or sym.kind == skType) and not isStatement: # This is subtle but correct: the error *statement* is only - # allowed for top level statements. Seems to be easier than - # distinguishing properly between + # allowed when 'wUsed' is not in validPragmas. Here this is the easiest way to + # distinguish properly between # ``proc p() {.error}`` and ``proc p() = {.error: "msg".}`` - noVal(c, it) + if it.kind in nkPragmaCallKinds: discard getStrLitNode(c, it) incl(sym.flags, sfError) + excl(sym.flags, sfForward) else: 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 wLink: processCommonLink(c, it, linkNormal) - of wLinksys: processCommonLink(c, it, linkSys) + 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 wBreakpoint: pragmaBreakpoint(c, it) - of wWatchPoint: pragmaWatchpoint(c, it) + 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: processPush(c, n, i + 1) result = true - of wPop: processPop(c, it) + of wPop: + processPop(c, it) + result = true of wPragma: if not sym.isNil and sym.kind == skTemplate: sym.flags.incl sfCustomPragma @@ -976,12 +1185,13 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, noVal(c, it) if sym != nil: incl(sym.flags, sfNoInit) of wCodegenDecl: processCodegenDecl(c, it, sym) - of wChecks, wObjChecks, wFieldChecks, wRangechecks, wBoundchecks, - wOverflowchecks, wNilchecks, wAssertions, wWarnings, wHints, - wLinedir, wOptimization, wMovechecks, wCallconv, wDebugger, wProfiler, - wFloatchecks, wNanChecks, wInfChecks, wPatterns: + of wChecks, wObjChecks, wFieldChecks, wRangeChecks, wBoundChecks, + wOverflowChecks, wNilChecks, wAssertions, wWarnings, wHints, + wLineDir, wOptimization, wStaticBoundchecks, wStyleChecks, + wCallconv, wDebugger, wProfiler, + wFloatChecks, wNanChecks, wInfChecks, wPatterns, wTrMacros: processOption(c, it, c.config.options) - of wStacktrace, wLinetrace: + of wStackTrace, wLineTrace: if sym.kind in {skProc, skMethod, skConverter}: processOption(c, it, sym.options) else: @@ -989,7 +1199,9 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, of FirstCallConv..LastCallConv: assert(sym != nil) if sym.typ == nil: invalidPragma(c, it) - else: sym.typ.callConv = wordToCallConv(k) + else: + sym.typ.callConv = wordToCallConv(k) + sym.typ.flags.incl tfExplicitCallConv of wEmit: pragmaEmit(c, it) of wUnroll: pragmaUnroll(c, it) of wLinearScanEnd, wComputedGoto: noVal(c, it) @@ -1000,27 +1212,44 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, noVal(c, it) if sym.typ == nil: invalidPragma(c, it) else: incl(sym.typ.flags, tfIncompleteStruct) - of wUnchecked: + of wCompleteStruct: noVal(c, it) if sym.typ == nil: invalidPragma(c, it) - else: incl(sym.typ.flags, tfUncheckedArray) - of wUnion: + else: incl(sym.typ.flags, tfCompleteStruct) + of wUnchecked: noVal(c, it) - if sym.typ == nil: invalidPragma(c, it) - else: incl(sym.typ.flags, tfUnion) + if sym.typ == nil or sym.typ.kind notin {tyArray, tyUncheckedArray}: + invalidPragma(c, it) + else: + sym.typ.kind = tyUncheckedArray + of wUnion: + if c.config.backend == backendJs: + localError(c.config, it.info, "`{.union.}` is not implemented for js backend.") + else: + noVal(c, it) + if sym.typ == nil: invalidPragma(c, it) + else: incl(sym.typ.flags, tfUnion) of wRequiresInit: noVal(c, it) - if sym.typ == nil: invalidPragma(c, it) - else: incl(sym.typ.flags, tfNeedsInit) + if sym.kind == skField: + sym.flags.incl sfRequiresInit + elif sym.typ != nil: + incl(sym.typ.flags, tfNeedsFullInit) + else: + 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) @@ -1033,16 +1262,18 @@ 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) else: sym.bitsize = expectIntLit(c, it) + if sym.bitsize <= 0: + localError(c.config, it.info, "bitsize needs to be positive") of wGuard: if sym == nil or sym.kind notin {skVar, skLet, skField}: invalidPragma(c, it) @@ -1056,61 +1287,97 @@ 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.sons[1] = c.semExpr(c, it.sons[1]) of wExperimental: - processExperimental(c, it, sym) - of wThis: - if it.kind in nkPragmaCallKinds and it.len == 2: - c.selfName = considerQuotedIdent(c, it[1]) - elif it.kind == nkIdent or it.len == 1: - c.selfName = getIdent(c.cache, "self") - else: - localError(c.config, it.info, "'this' pragma is allowed to have zero or one arguments") + 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 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: + 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: - n.sons[i] = semCustomPragma(c, it) - - -proc implicitPragmas*(c: PContext, sym: PSym, n: PNode, + # semCustomPragma gives appropriate error for invalid pragmas + n[i] = semCustomPragma(c, it, sym) + +proc overwriteLineInfo(n: PNode; info: TLineInfo) = + n.info = info + for i in 0..<n.safeLen: + overwriteLineInfo(n[i], info) + +proc mergePragmas(n, pragmas: PNode) = + var pragmas = copyTree(pragmas) + overwriteLineInfo pragmas, n.info + if n[pragmasPos].kind == nkEmpty: + n[pragmasPos] = pragmas + 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: - pushInfoContext(c.config, n.info) + if not o.isNil and sfFromGeneric notin sym.flags: # bug #23019 + pushInfoContext(c.config, info) var i = 0 - while i < o.len(): - if singlePragma(c, sym, o, i, validPragmas): - internalError(c.config, n.info, "implicitPragmas") + while i < o.len: + if singlePragma(c, sym, o, i, validPragmas, true, false): + internalError(c.config, info, "implicitPragmas") inc i popInfoContext(c.config) + 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, n.info, ".dynlib requires .exportc") + localError(c.config, info, ".dynlib requires .exportc") var lib = c.optionStack[^1].dynlib if {lfDynamicLib, lfHeader} * sym.loc.flags == {} and sfImportc in sym.flags and lib != nil: incl(sym.loc.flags, lfDynamicLib) 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 @@ -1122,14 +1389,23 @@ proc hasPragma*(n: PNode, pragma: TSpecialWord): bool = return false -proc pragmaRec(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords) = +proc pragmaRec(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords; + isStatement: bool) = if n == nil: return var i = 0 while i < n.len: - if singlePragma(c, sym, n, i, validPragmas): break + if singlePragma(c, sym, n, i, validPragmas, false, isStatement): break inc i -proc pragma(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords) = +proc pragma(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords; + isStatement: bool) = + if n == nil: return + pragmaRec(c, sym, n, validPragmas, isStatement) + # XXX: in the case of a callable def, this should use its info + implicitPragmas(c, sym, n.info, validPragmas) + +proc pragmaCallable*(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords, + isStatement: bool = false) = if n == nil: return - pragmaRec(c, sym, n, validPragmas) - implicitPragmas(c, sym, n, validPragmas) + if n[pragmasPos].kind != nkEmpty: + pragmaRec(c, sym, n[pragmasPos], validPragmas, isStatement) diff --git a/compiler/prefixmatches.nim b/compiler/prefixmatches.nim index 246d1ae5e..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 @@ -20,14 +20,13 @@ proc prefixMatch*(p, s: string): PrefixMatch = template eq(a, b): bool = a.toLowerAscii == b.toLowerAscii if p.len > s.len: return PrefixMatch.None var i = 0 - let L = s.len # check for prefix/contains: - while i < L: + while i < s.len: if s[i] == '_': inc i - if i < L and eq(s[i], p[0]): + if i < s.len and eq(s[i], p[0]): var ii = i+1 var jj = 1 - while ii < L and jj < p.len: + while ii < s.len and jj < p.len: if p[jj] == '_': inc jj if s[ii] == '_': inc ii if not eq(s[ii], p[jj]): break @@ -55,36 +54,3 @@ proc prefixMatch*(p, s: string): PrefixMatch = else: return PrefixMatch.None return PrefixMatch.None - -when isMainModule: - import macros - - macro check(val, body: untyped): untyped = - result = newStmtList() - expectKind body, nnkStmtList - for b in body: - expectKind b, nnkPar - expectLen b, 2 - let p = b[0] - let s = b[1] - result.add quote do: - echo prefixMatch(`p`, `s`) == `val` - - check PrefixMatch.Prefix: - ("abc", "abc") - ("a", "abc") - ("xyz", "X_yzzzZe") - - check PrefixMatch.Substr: - ("b", "abc") - ("abc", "fooabcabc") - ("abC", "foo_AB_c") - - check PrefixMatch.Abbrev: - ("abc", "AxxxBxxxCxxx") - ("xyz", "X_yabcZe") - - check PrefixMatch.None: - ("foobar", "afkslfjd_as") - ("xyz", "X_yuuZuuZe") - ("ru", "remotes") diff --git a/compiler/procfind.nim b/compiler/procfind.nim index 3f47e7e8a..c2cc6e71f 100644 --- a/compiler/procfind.nim +++ b/compiler/procfind.nim @@ -11,60 +11,29 @@ # This is needed for proper handling of forward declarations. import - ast, astalgo, msgs, semdata, types, trees, strutils + ast, astalgo, msgs, semdata, types, trees, lookups + +import std/strutils proc equalGenericParams(procA, procB: PNode): bool = - if sonsLen(procA) != sonsLen(procB): return false - for i in countup(0, sonsLen(procA) - 1): - if procA.sons[i].kind != nkSym: + if procA.len != procB.len: return false + for i in 0..<procA.len: + if procA[i].kind != nkSym: return false - if procB.sons[i].kind != nkSym: + if procB[i].kind != nkSym: return false - let a = procA.sons[i].sym - let b = procB.sons[i].sym + let a = procA[i].sym + let b = procB[i].sym if a.name.id != b.name.id or not sameTypeOrNil(a.typ, b.typ, {ExactTypeDescValues}): return if a.ast != nil and b.ast != nil: if not exprStructuralEquivalent(a.ast, b.ast): return result = true -proc searchForProcOld*(c: PContext, scope: PScope, fn: PSym): PSym = - # Searchs for a forward declaration or a "twin" symbol of fn - # in the symbol table. If the parameter lists are exactly - # the same the sym in the symbol table is returned, else nil. - var it: TIdentIter - result = initIdentIter(it, scope.symbols, fn.name) - if isGenericRoutine(fn): - # we simply check the AST; this is imprecise but nearly the best what - # can be done; this doesn't work either though as type constraints are - # not kept in the AST .. - while result != nil: - if result.kind == fn.kind and isGenericRoutine(result): - let genR = result.ast.sons[genericParamsPos] - let genF = fn.ast.sons[genericParamsPos] - if exprStructuralEquivalent(genR, genF) and - exprStructuralEquivalent(result.ast.sons[paramsPos], - fn.ast.sons[paramsPos]) and - equalGenericParams(genR, genF): - return - result = nextIdentIter(it, scope.symbols) - else: - while result != nil: - if result.kind == fn.kind and not isGenericRoutine(result): - case equalParams(result.typ.n, fn.typ.n) - of paramsEqual: - return - of paramsIncompatible: - localError(c.config, fn.info, "overloaded '$1' leads to ambiguous calls" % fn.name.s) - return - of paramsNotEqual: - discard - result = nextIdentIter(it, scope.symbols) - -proc searchForProcNew(c: PContext, scope: PScope, fn: PSym): PSym = +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): @@ -72,8 +41,8 @@ proc searchForProcNew(c: PContext, scope: PScope, fn: PSym): PSym = of paramsEqual: if (sfExported notin result.flags) and (sfExported in fn.flags): let message = ("public implementation '$1' has non-public " & - "forward declaration in $2") % - [getProcHeader(c.config, result), c.config$result.info] + "forward declaration at $2") % + [getProcHeader(c.config, result, getDeclarationPath = false), c.config$result.info] localError(c.config, fn.info, message) return of paramsIncompatible: @@ -83,40 +52,37 @@ proc searchForProcNew(c: PContext, scope: PScope, fn: PSym): PSym = discard result = nextIdentIter(it, scope.symbols) -proc searchForProc*(c: PContext, scope: PScope, fn: PSym): PSym = - result = searchForProcNew(c, scope, fn) - when false: - let old = searchForProcOld(c, scope, fn) - if old != result: - echo "Mismatch in searchForProc: ", fn.info - debug fn.typ - debug if result != nil: result.typ else: nil - debug if old != nil: old.typ else: nil +proc searchForProc*(c: PContext, scope: PScope, fn: PSym): tuple[proto: PSym, comesFromShadowScope: bool] = + var scope = scope + result = (searchForProcAux(c, scope, fn), false) + while result.proto == nil and scope.isShadowScope: + scope = scope.parent + result.proto = searchForProcAux(c, scope, fn) + result.comesFromShadowScope = true when false: proc paramsFitBorrow(child, parent: PNode): bool = - var length = sonsLen(child) result = false - if length == sonsLen(parent): - for i in countup(1, length - 1): - var m = child.sons[i].sym - var n = parent.sons[i].sym + if child.len == parent.len: + for i in 1..<child.len: + var m = child[i].sym + var n = parent[i].sym assert((m.kind == skParam) and (n.kind == skParam)) if not compareTypes(m.typ, n.typ, dcEqOrDistinctOf): return - if not compareTypes(child.sons[0].typ, parent.sons[0].typ, + if not compareTypes(child[0].typ, parent[0].typ, dcEqOrDistinctOf): return result = true proc searchForBorrowProc*(c: PContext, startScope: PScope, fn: PSym): PSym = - # Searchs for the fn in the symbol table. If the parameter lists are suitable + # 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: # watchout! result must not be the same as fn! if (result.Kind == fn.kind) and (result.id != fn.id): - if equalGenericParams(result.ast.sons[genericParamsPos], - fn.ast.sons[genericParamsPos]): + if equalGenericParams(result.ast[genericParamsPos], + fn.ast[genericParamsPos]): if paramsFitBorrow(fn.typ.n, result.typ.n): return result = NextIdentIter(it, scope.symbols) 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 new file mode 100644 index 000000000..4a197991c --- /dev/null +++ b/compiler/readme.md @@ -0,0 +1,7 @@ +## Nim Compiler + +- This directory contains the Nim compiler written in Nim. +- 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.github.io/Nim/intern.html) for more information. diff --git a/compiler/readme.txt b/compiler/readme.txt deleted file mode 100644 index c4934e031..000000000 --- a/compiler/readme.txt +++ /dev/null @@ -1,4 +0,0 @@ -This directory contains the Nim compiler written in Nim. 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. - diff --git a/compiler/renderer.nim b/compiler/renderer.nim index ba87838db..cc07c0c2d 100644 --- a/compiler/renderer.nim +++ b/compiler/renderer.nim @@ -9,22 +9,39 @@ # This module implements the renderer of the standard Nim representation. +# '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 + renderNoPragmas, renderIds, renderNoProcDefs, renderSyms, renderRunnableExamples, + renderIr, renderNonExportedFields, renderExpandUsing, renderNoPostfix + TRenderFlags* = set[TRenderFlag] TRenderTok* = object - kind*: TTokType + kind*: TokType length*: int16 + sym*: PSym + + Section = enum + GenericParams + ObjectDef TRenderTokSeq* = seq[TRenderTok] TSrcGen* = object indent*: int lineLen*: int + col: int pos*: int # current position for iteration over the buffer idx*: int # current token index for iteration over the buffer tokens*: TRenderTokSeq @@ -34,22 +51,45 @@ 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): pendingNewlineCount: int fid*: FileIndex 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. +proc disamb(g: var TSrcGen; s: PSym): int = + # we group by 's.name.s' to compute the stable name ID. + result = 0 + for i in 0 ..< g.mangler.len: + if s == g.mangler[i]: return result + if s.name.s == g.mangler[i].name.s: inc result + g.mangler.add s + 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. @@ -63,14 +103,32 @@ proc renderDefinitionName*(s: PSym, noQuotes = false): string = else: result = '`' & x & '`' -when not defined(nimpretty): - const - IndentWidth = 2 - longIndentWid = IndentWidth * 2 -else: - template IndentWidth: untyped = lexer.gIndentationWidth - template longIndentWid: untyped = IndentWidth() * 2 +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) = case n.kind of nkTripleStrLit: @@ -79,7 +137,7 @@ else: result = (n.info.line.int, n.info.line.int + countLines(n.comment)) else: result = (n.info.line.int, n.info.line.int) - for i in 0 ..< safeLen(n): + for i in 0..<n.safeLen: let (currMin, currMax) = minmaxLine(n[i]) if currMin < result[0]: result[0] = currMin if currMax > result[1]: result[1] = currMax @@ -87,30 +145,19 @@ else: 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 addTok(g: var TSrcGen, kind: TTokType, s: string) = - var length = len(g.tokens) - setLen(g.tokens, length + 1) - g.tokens[length].kind = kind - g.tokens[length].length = int16(len(s)) - add(g.buf, s) +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) + g.buf.add(s) + if kind != tkSpaces: + inc g.col, s.len proc addPendingNL(g: var TSrcGen) = if g.pendingNL >= 0: @@ -120,6 +167,7 @@ proc addPendingNL(g: var TSrcGen) = const newlines = "\n" addTok(g, tkSpaces, newlines & spaces(g.pendingNL)) g.lineLen = g.pendingNL + g.col = g.pendingNL g.pendingNL = - 1 g.pendingWhitespace = -1 elif g.pendingWhitespace >= 0: @@ -128,7 +176,10 @@ proc addPendingNL(g: var TSrcGen) = proc putNL(g: var TSrcGen, indent: int) = if g.pendingNL >= 0: addPendingNL(g) - else: addTok(g, tkSpaces, "\n") + else: + addTok(g, tkSpaces, "\n") + g.col = 0 + g.pendingNL = indent g.lineLen = indent g.pendingWhitespace = -1 @@ -143,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) = @@ -151,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) = @@ -165,39 +218,40 @@ proc dedent(g: var TSrcGen) = dec(g.pendingNL, IndentWidth) dec(g.lineLen, IndentWidth) -proc put(g: var TSrcGen, kind: TTokType, s: string) = +proc put(g: var TSrcGen, kind: TokType, s: string; sym: PSym = nil) = if kind != tkSpaces: addPendingNL(g) - if len(s) > 0: - addTok(g, kind, s) - inc(g.lineLen, len(s)) + if s.len > 0 or kind in {tkHideableStart, tkHideableEnd}: + addTok(g, kind, s, sym) else: g.pendingWhitespace = s.len + inc g.col, s.len + inc(g.lineLen, s.len) proc putComment(g: var TSrcGen, s: string) = - if s.isNil: return + if s.len == 0: return var i = 0 - let hi = len(s) - 1 - var isCode = (len(s) >= 2) and (s[1] != ' ') - var ind = g.lineLen + let hi = s.len - 1 + let isCode = (s.len >= 2) and (s[1] != ' ') + let ind = g.col var com = "## " while i <= hi: case s[i] of '\0': break - of '\x0D': + of '\r': put(g, tkComment, com) com = "## " inc(i) - if i < s.len and s[i] == '\x0A': inc(i) + if i <= hi and s[i] == '\n': inc(i) optNL(g, ind) - of '\x0A': + of '\n': put(g, tkComment, com) com = "## " inc(i) optNL(g, ind) - of ' ', '\x09': - add(com, s[i]) + of ' ', '\t': + com.add(s[i]) inc(i) else: # we may break the comment into a multi-line comment if the line @@ -205,31 +259,32 @@ proc putComment(g: var TSrcGen, s: string) = # compute length of the following word: var j = i while j <= hi and s[j] > ' ': inc(j) - if not isCode and (g.lineLen + (j - i) > MaxLineLen): + if not isCode and (g.col + (j - i) > MaxLineLen): put(g, tkComment, com) optNL(g, ind) com = "## " while i <= hi and s[i] > ' ': - add(com, s[i]) + com.add(s[i]) inc(i) put(g, tkComment, com) optNL(g) proc maxLineLength(s: string): int = - if s.isNil: return 0 + result = 0 + if s.len == 0: return 0 var i = 0 - let hi = len(s) - 1 + let hi = s.len - 1 var lineLen = 0 while i <= hi: case s[i] of '\0': break - of '\x0D': + of '\r': inc(i) - if s[i] == '\x0A': inc(i) + if i <= hi and s[i] == '\n': inc(i) result = max(result, lineLen) lineLen = 0 - of '\x0A': + of '\n': inc(i) result = max(result, lineLen) lineLen = 0 @@ -237,41 +292,40 @@ proc maxLineLength(s: string): int = inc(lineLen) inc(i) -proc putRawStr(g: var TSrcGen, kind: TTokType, s: string) = +proc putRawStr(g: var TSrcGen, kind: TokType, s: string) = var i = 0 - let hi = len(s) - 1 + let hi = s.len - 1 var str = "" while i <= hi: case s[i] - of '\x0D': + of '\r': put(g, kind, str) str = "" inc(i) - if (i <= hi) and (s[i] == '\x0A'): inc(i) + if i <= hi and s[i] == '\n': inc(i) optNL(g, 0) - of '\x0A': + of '\n': put(g, kind, str) str = "" inc(i) optNL(g, 0) else: - add(str, s[i]) + str.add(s[i]) inc(i) put(g, kind, str) proc containsNL(s: string): bool = - for i in countup(0, len(s) - 1): + for i in 0..<s.len: case s[i] - of '\x0D', '\x0A': + of '\r', '\n': return true else: discard result = false proc pushCom(g: var TSrcGen, n: PNode) = - var length = len(g.comStack) - setLen(g.comStack, length + 1) - g.comStack[length] = n + setLen(g.comStack, g.comStack.len + 1) + g.comStack[^1] = n proc popAllComs(g: var TSrcGen) = setLen(g.comStack, 0) @@ -279,45 +333,58 @@ proc popAllComs(g: var TSrcGen) = const Space = " " -proc shouldRenderComment(g: var TSrcGen, n: PNode): bool = - result = false - if n.comment != nil: - result = (renderNoComments notin g.flags) or - (renderDocComments in g.flags) +proc shouldRenderComment(g: TSrcGen): bool {.inline.} = + (renderNoComments notin g.flags or renderDocComments in g.flags) + +proc shouldRenderComment(g: TSrcGen, n: PNode): bool {.inline.} = + shouldRenderComment(g) and n.comment.len > 0 proc gcom(g: var TSrcGen, n: PNode) = assert(n != nil) if shouldRenderComment(g, n): - if (g.pendingNL < 0) and (len(g.buf) > 0) and (g.buf[len(g.buf)-1] != ' '): + var oneSpaceAdded = 0 + if (g.pendingNL < 0) and (g.buf.len > 0) and (g.buf[^1] != ' '): put(g, tkSpaces, Space) + oneSpaceAdded = 1 # Before long comments we cannot make sure that a newline is generated, # because this might be wrong. But it is no problem in practice. - if (g.pendingNL < 0) and (len(g.buf) > 0) and - (g.lineLen < LineCommentColumn): + if (g.pendingNL < 0) and (g.buf.len > 0) and + (g.col < LineCommentColumn): var ml = maxLineLength(n.comment) if ml + LineCommentColumn <= MaxLineLen: - put(g, tkSpaces, spaces(LineCommentColumn - g.lineLen)) + put(g, tkSpaces, spaces(LineCommentColumn - g.col)) + dec g.col, oneSpaceAdded putComment(g, n.comment) #assert(g.comStack[high(g.comStack)] = n); proc gcoms(g: var TSrcGen) = - for i in countup(0, high(g.comStack)): gcom(g, g.comStack[i]) + for i in 0..high(g.comStack): gcom(g, g.comStack[i]) popAllComs(g) proc lsub(g: TSrcGen; n: PNode): int proc litAux(g: TSrcGen; n: PNode, x: BiggestInt, size: int): string = proc skip(t: PType): PType = result = t - while result.kind in {tyGenericInst, tyRange, tyVar, tyLent, tyDistinct, - tyOrdinal, tyAlias, tySink}: - result = lastSon(result) - if n.typ != nil and n.typ.skip.kind in {tyBool, tyEnum}: - let enumfields = n.typ.skip.n + while result != nil and result.kind in {tyGenericInst, tyRange, tyVar, + tyLent, tyDistinct, tyOrdinal, tyAlias, tySink}: + result = skipModifier(result) + + result = "" + let typ = n.typ.skip + if typ != nil and typ.kind in {tyBool, tyEnum}: + if sfPure in typ.sym.flags: + result = typ.sym.name.s & '.' + let enumfields = typ.n # we need a slow linear search because of enums with holes: for e in items(enumfields): - if e.sym.position == x: return e.sym.name.s + if e.sym.position == x: + result &= e.sym.name.s + return if nfBase2 in n.flags: result = "0b" & toBin(x, size * 8) - elif nfBase8 in n.flags: result = "0o" & toOct(x, size * 3) + elif nfBase8 in n.flags: + var y = if size < sizeof(BiggestInt): x and ((1.BiggestInt shl (size*8)) - 1) + else: x + result = "0o" & toOct(y, size * 3) elif nfBase16 in n.flags: result = "0x" & toHex(x, size * 2) else: result = $x @@ -325,8 +392,7 @@ proc ulitAux(g: TSrcGen; n: PNode, x: BiggestInt, size: int): string = if nfBase2 in n.flags: result = "0b" & toBin(x, size * 8) elif nfBase8 in n.flags: result = "0o" & toOct(x, size * 3) elif nfBase16 in n.flags: result = "0x" & toHex(x, size * 2) - else: result = $x - # XXX proper unsigned output! + else: result = $cast[BiggestUInt](x) proc atom(g: TSrcGen; n: PNode): string = when defined(nimpretty): @@ -344,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 & "\"\"\"" @@ -363,59 +430,85 @@ 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 = assert(theEnd < 0) result = 0 - for i in countup(start, sonsLen(n) + theEnd): - inc(result, lsub(g, n.sons[i])) - inc(result, 2) # for ``, `` + for i in start..n.len + theEnd: + let param = n[i] + if nfDefaultParam notin param.flags: + inc(result, lsub(g, param)) + inc(result, 2) # for ``, `` if result > 0: dec(result, 2) # last does not get a comma! proc lsons(g: TSrcGen; n: PNode, start: int = 0, theEnd: int = - 1): int = assert(theEnd < 0) result = 0 - for i in countup(start, sonsLen(n) + theEnd): inc(result, lsub(g, n.sons[i])) + 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 n.comment != nil: return MaxLineLen + 1 + if shouldRenderComment(g, n): return MaxLineLen + 1 case n.kind of nkEmpty: result = 0 of nkTripleStrLit: if containsNL(n.strVal): result = MaxLineLen + 1 - else: result = len(atom(g, n)) + else: result = atom(g, n).len of succ(nkEmpty)..pred(nkTripleStrLit), succ(nkTripleStrLit)..nkNilLit: - result = len(atom(g, n)) + result = atom(g, n).len of nkCall, nkBracketExpr, nkCurlyExpr, nkConv, nkPattern, nkObjConstr: - result = lsub(g, n.sons[0]) + lcomma(g, n, 1) + 2 + result = lsub(g, n[0]) + lcomma(g, n, 1) + 2 of nkHiddenStdConv, nkHiddenSubConv, nkHiddenCallConv: result = lsub(g, n[1]) - of nkCast: result = lsub(g, n.sons[0]) + lsub(g, n.sons[1]) + len("cast[]()") - of nkAddr: result = (if n.len>0: lsub(g, n.sons[0]) + len("addr()") else: 4) - of nkStaticExpr: result = lsub(g, n.sons[0]) + len("static_") - of nkHiddenAddr, nkHiddenDeref: result = lsub(g, n.sons[0]) - of nkCommand: result = lsub(g, n.sons[0]) + lcomma(g, n, 1) + 1 + of nkCast: result = lsub(g, n[0]) + lsub(g, n[1]) + len("cast[]()") + of nkAddr: result = (if n.len>0: lsub(g, n[0]) + len("addr()") else: 4) + of nkStaticExpr: result = lsub(g, n[0]) + len("static_") + of nkHiddenAddr, nkHiddenDeref, nkStringToCString, nkCStringToString: result = lsub(g, n[0]) + of nkCommand: result = lsub(g, n[0]) + lcomma(g, n, 1) + 1 of nkExprEqExpr, nkAsgn, nkFastAsgn: result = lsons(g, n) + 3 of nkPar, nkCurly, nkBracket, nkClosure: result = lcomma(g, n) + 2 of nkTupleConstr: @@ -425,95 +518,112 @@ proc lsub(g: TSrcGen; n: PNode): int = of nkTableConstr: result = if n.len > 0: lcomma(g, n) + 2 else: len("{:}") of nkClosedSymChoice, nkOpenSymChoice: - result = lsons(g, n) + len("()") + sonsLen(n) - 1 + 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 of nkBind: result = lsons(g, n) + len("bind_") of nkBindStmt: result = lcomma(g, n) + len("bind_") of nkMixinStmt: result = lcomma(g, n) + len("mixin_") - of nkCheckedFieldExpr: result = lsub(g, n.sons[0]) + of nkCheckedFieldExpr: result = lsub(g, n[0]) of nkLambda: result = lsons(g, n) + len("proc__=_") of nkDo: result = lsons(g, n) + len("do__:_") of nkConstDef, nkIdentDefs: result = lcomma(g, n, 0, - 3) - var L = sonsLen(n) - if n.sons[L - 2].kind != nkEmpty: result = result + lsub(g, n.sons[L - 2]) + 2 - if n.sons[L - 1].kind != nkEmpty: result = result + lsub(g, n.sons[L - 1]) + 3 - of nkVarTuple: result = lcomma(g, n, 0, - 3) + len("() = ") + lsub(g, lastSon(n)) + 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("()") + else: + result = lcomma(g, n, 0, - 3) + len("() = ") + lsub(g, lastSon(n)) of nkChckRangeF: result = len("chckRangeF") + 2 + lcomma(g, n) of nkChckRange64: result = len("chckRange64") + 2 + lcomma(g, n) of nkChckRange: result = len("chckRange") + 2 + lcomma(g, n) - of nkObjDownConv, nkObjUpConv, nkStringToCString, nkCStringToString: + of nkObjDownConv, nkObjUpConv: result = 2 - if sonsLen(n) >= 1: result = result + lsub(g, n.sons[0]) - result = result + lcomma(g, n, 1) + if n.len >= 1: result += lsub(g, n[0]) + result += lcomma(g, n, 1) of nkExprColonExpr: result = lsons(g, n) + 2 of nkInfix: result = lsons(g, n) + 2 of nkPrefix: - result = lsons(g, n)+1+(if n.len > 0 and n.sons[1].kind == nkInfix: 2 else: 0) - of nkPostfix: result = lsons(g, n) + result = lsons(g, n)+1+(if n.len > 0 and n[1].kind == nkInfix: 2 else: 0) + 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.sons[0]) + lcomma(g, n, 1) + of nkPragmaExpr: result = lsub(g, n[0]) + lcomma(g, n, 1) of nkRange: result = lsons(g, n) + 2 - of nkDerefExpr: result = lsub(g, n.sons[0]) + 2 + of nkDerefExpr: result = lsub(g, n[0]) + 2 of nkAccQuoted: result = lsons(g, n) + 2 of nkIfExpr: - result = lsub(g, n.sons[0].sons[0]) + lsub(g, n.sons[0].sons[1]) + lsons(g, n, 1) + + result = lsub(g, n[0][0]) + lsub(g, n[0][1]) + lsons(g, n, 1) + len("if_:_") of nkElifExpr: result = lsons(g, n) + len("_elif_:_") - of nkElseExpr: result = lsub(g, n.sons[0]) + len("_else:_") # type descriptions - of nkTypeOfExpr: result = (if n.len > 0: lsub(g, n.sons[0]) else: 0)+len("type()") - of nkRefTy: result = (if n.len > 0: lsub(g, n.sons[0])+1 else: 0) + len("ref") - of nkPtrTy: result = (if n.len > 0: lsub(g, n.sons[0])+1 else: 0) + len("ptr") - of nkVarTy: result = (if n.len > 0: lsub(g, n.sons[0])+1 else: 0) + len("var") + of nkElseExpr: result = lsub(g, n[0]) + len("_else:_") # type descriptions + 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, 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.sons[0])+1 else: 0) + result = len("distinct") + (if n.len > 0: lsub(g, n[0])+1 else: 0) if n.len > 1: result += (if n[1].kind == nkWith: len("_with_") else: len("_without_")) result += lcomma(g, n[1]) - of nkStaticTy: result = (if n.len > 0: lsub(g, n.sons[0]) else: 0) + + of nkStaticTy: result = (if n.len > 0: lsub(g, n[0]) else: 0) + len("static[]") of nkTypeDef: result = lsons(g, n) + 3 - of nkOfInherit: result = lsub(g, n.sons[0]) + len("of_") + 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 sonsLen(n) > 0: - result = lsub(g, n.sons[0]) + lcomma(g, n, 1) + len("enum_") + if n.len > 0: + result = lsub(g, n[0]) + lcomma(g, n, 1) + len("enum_") else: result = len("enum") of nkEnumFieldDef: result = lsons(g, n) + 3 of nkVarSection, nkLetSection: - if sonsLen(n) > 1: result = MaxLineLen + 1 + if n.len > 1: result = MaxLineLen + 1 else: result = lsons(g, n) + len("var_") of nkUsingStmt: - if sonsLen(n) > 1: result = MaxLineLen + 1 + if n.len > 1: result = MaxLineLen + 1 else: result = lsons(g, n) + len("using_") - of nkReturnStmt: result = lsub(g, n.sons[0]) + len("return_") - of nkRaiseStmt: result = lsub(g, n.sons[0]) + len("raise_") - of nkYieldStmt: result = lsub(g, n.sons[0]) + len("yield_") - of nkDiscardStmt: result = lsub(g, n.sons[0]) + len("discard_") - of nkBreakStmt: result = lsub(g, n.sons[0]) + len("break_") - of nkContinueStmt: result = lsub(g, n.sons[0]) + len("continue_") + of nkReturnStmt: + 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]) + of nkRaiseStmt: result = lsub(g, n[0]) + len("raise_") + of nkYieldStmt: result = lsub(g, n[0]) + len("yield_") + of nkDiscardStmt: result = lsub(g, n[0]) + len("discard_") + of nkBreakStmt: result = lsub(g, n[0]) + len("break_") + of nkContinueStmt: result = lsub(g, n[0]) + len("continue_") of nkPragma: result = lcomma(g, n) + 4 - of nkCommentStmt: result = if n.comment.isNil: 0 else: len(n.comment) + of nkCommentStmt: result = n.comment.len of nkOfBranch: result = lcomma(g, n, 0, - 2) + lsub(g, lastSon(n)) + len("of_:_") - of nkImportAs: result = lsub(g, n.sons[0]) + len("_as_") + lsub(g, n.sons[1]) + of nkImportAs: result = lsub(g, n[0]) + len("_as_") + lsub(g, n[1]) of nkElifBranch: result = lsons(g, n) + len("elif_:_") - of nkElse: result = lsub(g, n.sons[0]) + len("else:_") - of nkFinally: result = lsub(g, n.sons[0]) + len("finally:_") + of nkElse: result = lsub(g, n[0]) + len("else:_") + of nkFinally: result = lsub(g, n[0]) + len("finally:_") of nkGenericParams: result = lcomma(g, n) + 2 of nkFormalParams: result = lcomma(g, n, 1) + 2 - if n.sons[0].kind != nkEmpty: result = result + lsub(g, n.sons[0]) + 2 + if n[0].kind != nkEmpty: result += lsub(g, n[0]) + 2 of nkExceptBranch: result = lcomma(g, n, 0, -2) + lsub(g, lastSon(n)) + len("except_:_") + of nkObjectTy: + result = len("object_") else: result = MaxLineLen + 1 proc fits(g: TSrcGen, x: int): bool = - result = x + g.lineLen <= MaxLineLen + result = x <= MaxLineLen type TSubFlag = enum @@ -524,47 +634,67 @@ 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 if n.isNil: return false - if n.comment != nil: return true + if n.comment.len > 0: return true case n.kind of nkEmpty..nkNilLit: discard else: - for i in countup(0, sonsLen(n) - 1): - if hasCom(n.sons[i]): return true + for i in 0..<n.len: + if hasCom(n[i]): return true -proc putWithSpace(g: var TSrcGen, kind: TTokType, s: string) = +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) = - for i in countup(start, sonsLen(n) + theEnd): - var c = i < sonsLen(n) + theEnd - var sublen = lsub(g, n.sons[i]) + ord(c) - if not fits(g, sublen) and (ind + sublen < MaxLineLen): optNL(g, ind) + let inPragma = g.inPragma == 1 # just the top-level + var inHideable = false + for i in start..n.len + theEnd: + 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 - gsub(g, n.sons[i]) + 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: - putWithSpace(g, separator, TokTypeToStr[separator]) - if hasCom(n.sons[i]): + putWithSpace(g, separator, $separator) + 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 @@ -585,26 +715,26 @@ proc gsemicolon(g: var TSrcGen, n: PNode, start: int = 0, theEnd: int = - 1) = proc gsons(g: var TSrcGen, n: PNode, c: TContext, start: int = 0, theEnd: int = - 1) = - for i in countup(start, sonsLen(n) + theEnd): gsub(g, n.sons[i], c) + for i in start..n.len + theEnd: gsub(g, n[i], c) -proc gsection(g: var TSrcGen, n: PNode, c: TContext, kind: TTokType, +proc gsection(g: var TSrcGen, n: PNode, c: TContext, kind: TokType, k: string) = - if sonsLen(n) == 0: return # empty var sections are possible + if n.len == 0: return # empty var sections are possible putWithSpace(g, kind, k) gcoms(g) indentNL(g) - for i in countup(0, sonsLen(n) - 1): + for i in 0..<n.len: optNL(g) - gsub(g, n.sons[i], c) + gsub(g, n[i], c) gcoms(g) dedent(g) proc longMode(g: TSrcGen; n: PNode, start: int = 0, theEnd: int = - 1): bool = - result = n.comment != nil + result = shouldRenderComment(g, n) if not result: # check further - for i in countup(start, sonsLen(n) + theEnd): - if (lsub(g, n.sons[i]) > MaxLineLen): + for i in start..n.len + theEnd: + if (lsub(g, n[i]) > MaxLineLen): result = true break @@ -612,8 +742,7 @@ proc gstmts(g: var TSrcGen, n: PNode, c: TContext, doIndent=true) = if n.kind == nkEmpty: return if n.kind in {nkStmtList, nkStmtListExpr, nkStmtListType}: if doIndent: indentNL(g) - let L = n.len - for i in 0 .. L-1: + for i in 0..<n.len: if i > 0: optNL(g, n[i-1], n[i]) else: @@ -621,137 +750,138 @@ 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: - if rfLongMode in c.flags: indentNL(g) + indentNL(g) gsub(g, n) gcoms(g) + dedent(g) optNL(g) - if rfLongMode in c.flags: dedent(g) + + +proc gcond(g: var TSrcGen, n: PNode) = + if n.kind == nkStmtListExpr: + put(g, tkParLe, "(") + gsub(g, n) + if n.kind == nkStmtListExpr: + put(g, tkParRi, ")") proc gif(g: var TSrcGen, n: PNode) = - var c: TContext - gsub(g, n.sons[0].sons[0]) - initContext(c) + var c: TContext = initContext() + gcond(g, n[0][0]) putWithSpace(g, tkColon, ":") - if longMode(g, n) or (lsub(g, n.sons[0].sons[1]) + g.lineLen > MaxLineLen): + if longMode(g, n) or (lsub(g, n[0][1]) + g.lineLen > MaxLineLen): incl(c.flags, rfLongMode) gcoms(g) # a good place for comments - gstmts(g, n.sons[0].sons[1], c) - var length = sonsLen(n) - for i in countup(1, length - 1): + gstmts(g, n[0][1], c) + for i in 1..<n.len: optNL(g) - gsub(g, n.sons[i], c) + gsub(g, n[i], c) proc gwhile(g: var TSrcGen, n: PNode) = - var c: TContext + var c: TContext = initContext() putWithSpace(g, tkWhile, "while") - gsub(g, n.sons[0]) + gcond(g, n[0]) putWithSpace(g, tkColon, ":") - initContext(c) - if longMode(g, n) or (lsub(g, n.sons[1]) + g.lineLen > MaxLineLen): + 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.sons[1], c) + 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.sons[0]) + g.lineLen > MaxLineLen): + if longMode(g, n) or (lsub(g, n[0]) + g.lineLen > MaxLineLen): incl(c.flags, rfLongMode) gcoms(g) # a good place for comments gstmts(g, n, c) put(g, tkCurlyRi, "}") proc gpragmaBlock(g: var TSrcGen, n: PNode) = - var c: TContext - gsub(g, n.sons[0]) + var c: TContext = initContext() + gsub(g, n[0]) putWithSpace(g, tkColon, ":") - initContext(c) - if longMode(g, n) or (lsub(g, n.sons[1]) + g.lineLen > MaxLineLen): + 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.sons[1], c) + 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.sons[0]) + g.lineLen > MaxLineLen): + if longMode(g, n) or (lsub(g, n[0]) + g.lineLen > MaxLineLen): incl(c.flags, rfLongMode) gcoms(g) # a good place for comments - gstmts(g, n.sons[0], c) + gstmts(g, n[0], c) gsons(g, n, c, 1) proc gfor(g: var TSrcGen, n: PNode) = - var c: TContext - var length = sonsLen(n) + var c: TContext = initContext() putWithSpace(g, tkFor, "for") - initContext(c) if longMode(g, n) or - (lsub(g, n.sons[length - 1]) + lsub(g, n.sons[length - 2]) + 6 + g.lineLen > - MaxLineLen): + (lsub(g, n[^1]) + lsub(g, n[^2]) + 6 + g.lineLen > MaxLineLen): incl(c.flags, rfLongMode) gcomma(g, n, c, 0, - 3) put(g, tkSpaces, Space) putWithSpace(g, tkIn, "in") - gsub(g, n.sons[length - 2], c) + gsub(g, n[^2], c) putWithSpace(g, tkColon, ":") gcoms(g) - gstmts(g, n.sons[length - 1], c) + gstmts(g, n[^1], c) proc gcase(g: var TSrcGen, n: PNode) = - var c: TContext - initContext(c) - var length = sonsLen(n) - if length == 0: return - var last = if n.sons[length-1].kind == nkElse: -2 else: -1 + 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) putWithSpace(g, tkCase, "case") - gsub(g, n.sons[0]) + gcond(g, n[0]) gcoms(g) optNL(g) gsons(g, n, c, 1, last) if last == - 2: - initContext(c) - if longMode(g, n.sons[length - 1]): incl(c.flags, rfLongMode) - gsub(g, n.sons[length - 1], 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 and s.name.id != ord(wUnderscore): + result.add '_' + result.addInt s.id proc gproc(g: var TSrcGen, n: PNode) = - var c: TContext - if n.sons[namePos].kind == nkSym: - let s = n.sons[namePos].sym - put(g, tkSymbol, renderDefinitionName(s)) - if sfGenSym in s.flags: - put(g, tkIntLit, $s.id) - else: - gsub(g, n.sons[namePos]) - - if n.sons[patternPos].kind != nkEmpty: - gpattern(g, n.sons[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]) + var c: TContext = initContext() + if n[namePos].kind == nkSym: + let s = n[namePos].sym + var ret = renderDefinitionName(s) + ret.genSymSuffix(s) + put(g, tkSymbol, ret) else: - gsub(g, n.sons[genericParamsPos]) - g.inGenericParams = oldInGenericParams - gsub(g, n.sons[paramsPos]) - gsub(g, n.sons[pragmasPos]) + gsub(g, n[namePos]) + + if n[patternPos].kind != nkEmpty: + gpattern(g, n[patternPos]) + 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.sons[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) - gstmts(g, n.sons[bodyPos], c) + c = initContext() + gstmts(g, n[bodyPos], c) putNL(g) else: indentNL(g) @@ -759,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 @@ -772,45 +901,54 @@ proc gTypeClassTy(g: var TSrcGen, n: PNode) = dedent(g) proc gblock(g: var TSrcGen, n: PNode) = - var c: TContext - initContext(c) - if n.sons[0].kind != nkEmpty: + # you shouldn't simplify it to `n.len < 2` + # because the following codes should be executed + # even when block stmt has only one child for getting + # better error messages. + if n.len == 0: + return + + var c: TContext = initContext() + + if n[0].kind != nkEmpty: putWithSpace(g, tkBlock, "block") - gsub(g, n.sons[0]) + gsub(g, n[0]) else: put(g, tkBlock, "block") + + # block stmt should have two children + if n.len == 1: + return + putWithSpace(g, tkColon, ":") - if longMode(g, n) or (lsub(g, n.sons[1]) + g.lineLen > MaxLineLen): + + if longMode(g, n) or (lsub(g, n[1]) + g.lineLen > MaxLineLen): incl(c.flags, rfLongMode) gcoms(g) - # XXX I don't get why this is needed here! gstmts should already handle this! - indentNL(g) - gstmts(g, n.sons[1], c) - dedent(g) + 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.sons[0]) + g.lineLen > MaxLineLen): + if longMode(g, n) or (lsub(g, n[0]) + g.lineLen > MaxLineLen): incl(c.flags, rfLongMode) gcoms(g) # a good place for comments - gstmts(g, n.sons[0], c) + gstmts(g, n[0], c) proc gasm(g: var TSrcGen, n: PNode) = putWithSpace(g, tkAsm, "asm") - gsub(g, n.sons[0]) + gsub(g, n[0]) gcoms(g) - if n.sons.len > 1: - gsub(g, n.sons[1]) + if n.len > 1: + 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 - var t: TTokType + var t: TokType var s = atom(g, n) if s.len > 0 and s[0] in lexer.SymChars: if n.kind == nkIdent: @@ -818,17 +956,27 @@ proc gident(g: var TSrcGen, n: PNode) = (n.ident.id > ord(tokKeywordHigh) - ord(tkSymbol)): t = tkSymbol else: - t = TTokType(n.ident.id + ord(tkSymbol)) + t = TokType(n.ident.id + ord(tkSymbol)) else: t = tkSymbol else: t = tkOpr - put(g, t, s) - if n.kind == nkSym and (renderIds in g.flags or sfGenSym in n.sym.flags): + if renderIr in g.flags and n.kind == nkSym: + let localId = disamb(g, n.sym) + if localId != 0 and n.sym.magic == mNone: + s.add '_' + 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 and n.sym.name.id != ord(wUnderscore)) or + n.sym.kind == skTemp): + s.add '_' + s.addInt n.sym.id when defined(debugMagics): - put(g, tkIntLit, $n.sym.id & $n.sym.magic) - else: - put(g, tkIntLit, $n.sym.id) + s.add '_' + s.add $n.sym.magic + put(g, t, s, if n.kind == nkSym and renderSyms in g.flags: n.sym else: nil) proc doParamsAux(g: var TSrcGen, params: PNode) = if params.len > 1: @@ -836,9 +984,10 @@ proc doParamsAux(g: var TSrcGen, params: PNode) = gsemicolon(g, params, 1) put(g, tkParRi, ")") - if params.len > 0 and params.sons[0].kind != nkEmpty: + if params.len > 0 and params[0].kind != nkEmpty: + put(g, tkSpaces, Space) putWithSpace(g, tkOpr, "->") - gsub(g, params.sons[0]) + gsub(g, params[0]) proc gsub(g: var TSrcGen; n: PNode; i: int) = if i < n.len: @@ -846,18 +995,106 @@ proc gsub(g: var TSrcGen; n: PNode; i: int) = else: put(g, tkOpr, "<<" & $i & "th child missing for " & $n.kind & " >>") -proc isBracket*(n: PNode): bool = - case n.kind - of nkClosedSymChoice, nkOpenSymChoice: - if n.len > 0: result = isBracket(n[0]) - of nkSym: result = n.sym.name.s == "[]" - else: result = false +type + BracketKind = enum + bkNone, bkBracket, bkBracketAsgn, bkCurly, bkCurlyAsgn + +proc bracketKind*(g: TSrcGen, n: PNode): BracketKind = + if renderIds notin g.flags: + 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 + of "[]=": bkBracketAsgn + of "{}": bkCurly + 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, nkOpenSym} and result.len > 1: + result = result[1] + elif result.kind in {nkCheckedFieldExpr, nkHiddenAddr, nkHiddenDeref, nkStringToCString, nkCStringToString} and + result.len > 0: + result = result[0] + else: break + +proc accentedName(g: var TSrcGen, n: PNode) = + # 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 ident = n.getPIdent + if ident != nil and ident.s[0] in backticksNeeded: + put(g, tkAccent, "`") + gident(g, n) + put(g, tkAccent, "`") + else: + gsub(g, n) + +proc infixArgument(g: var TSrcGen, n: PNode, i: int) = + if i < 1 or i > 2: return + var needsParenthesis = false + let nNext = n[i].skipHiddenNodes + if nNext.kind == nkInfix: + if nNext[0].kind in {nkSym, nkIdent} and n[0].kind in {nkSym, nkIdent}: + let nextId = if nNext[0].kind == nkSym: nNext[0].sym.name else: nNext[0].ident + let nnId = if n[0].kind == nkSym: n[0].sym.name else: n[0].ident + if i == 1: + if getPrecedence(nextId) < getPrecedence(nnId): + needsParenthesis = true + elif i == 2: + if getPrecedence(nextId) <= getPrecedence(nnId): + needsParenthesis = true + if needsParenthesis: + put(g, tkParLe, "(") + gsub(g, n, i) + if needsParenthesis: + put(g, tkParRi, ")") + +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 gsub(g: var TSrcGen, n: PNode, c: TContext) = +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 - if n.comment != nil: pushCom(g, n) + a: TContext = default(TContext) + if shouldRenderComment(g, n): pushCom(g, n) case n.kind # atoms: of nkTripleStrLit: put(g, tkTripleStrLit, atom(g, n)) of nkEmpty: discard @@ -882,40 +1119,85 @@ 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 > 0 and isBracket(n[0]): - gsub(g, n, 1) - put(g, tkBracketLe, "[") - gcomma(g, n, 2) - put(g, tkBracketRi, "]") - elif n.len > 1 and n.lastSon.kind == nkStmtList: - gsub(g, n[0]) - if n.len > 2: + 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 postExprBlocks: i.inc + if i > 1: put(g, tkParLe, "(") - gcomma(g, n, 1, -2) + gcomma(g, n, 1, i - 1 - n.len) + put(g, tkParRi, ")") + postStatements(g, n, i, fromStmtList) + elif n.len >= 1: + case bracketKind(g, n[0]) + of bkBracket: + gsub(g, n, 1) + put(g, tkBracketLe, "[") + gcomma(g, n, 2) + put(g, tkBracketRi, "]") + of bkBracketAsgn: + gsub(g, n, 1) + put(g, tkBracketLe, "[") + gcomma(g, n, 2, -2) + put(g, tkBracketRi, "]") + put(g, tkSpaces, Space) + putWithSpace(g, tkEquals, "=") + gsub(g, n, n.len - 1) + of bkCurly: + gsub(g, n, 1) + put(g, tkCurlyLe, "{") + gcomma(g, n, 2) + put(g, tkCurlyRi, "}") + of bkCurlyAsgn: + gsub(g, n, 1) + put(g, tkCurlyLe, "{") + gcomma(g, n, 2, -2) + put(g, tkCurlyRi, "}") + put(g, tkSpaces, Space) + putWithSpace(g, tkEquals, "=") + gsub(g, n, n.len - 1) + of bkNone: + accentedName(g, n[0]) + put(g, tkParLe, "(") + gcomma(g, n, 1) put(g, tkParRi, ")") - put(g, tkColon, ":") - gsub(g, n, n.len-1) else: - if sonsLen(n) >= 1: gsub(g, n.sons[0]) put(g, tkParLe, "(") - gcomma(g, n, 1) put(g, tkParRi, ")") of nkCallStrLit: - gsub(g, n, 0) - if n.len > 1 and n.sons[1].kind == nkRStrLit: + if n.len > 0: accentedName(g, n[0]) + if n.len > 1 and n[1].kind == nkRStrLit: put(g, tkRStrLit, '\"' & replace(n[1].strVal, "\"", "\"\"") & '\"') else: - gsub(g, n.sons[1]) - of nkHiddenStdConv, nkHiddenSubConv, nkHiddenCallConv: + gsub(g, n, 1) + of nkHiddenStdConv, nkHiddenSubConv: if n.len >= 2: - gsub(g, n.sons[1]) + when false: + # if {renderIds, renderIr} * g.flags != {}: + put(g, tkSymbol, "(conv)") + put(g, tkParLe, "(") + gsub(g, n[1]) + put(g, tkParRi, ")") + else: + gsub(g, n[1]) + else: + put(g, tkSymbol, "(wrong conv)") + of nkHiddenCallConv: + if {renderIds, renderIr} * g.flags != {}: + accentedName(g, n[0]) + put(g, tkParLe, "(") + gcomma(g, n, 1) + put(g, tkParRi, ")") + elif n.len >= 2: + gsub(g, n[1]) else: put(g, tkSymbol, "(wrong conv)") of nkCast: put(g, tkCast, "cast") - put(g, tkBracketLe, "[") - gsub(g, n, 0) - put(g, tkBracketRi, "]") + if n.len > 0 and n[0].kind != nkEmpty: + put(g, tkBracketLe, "[") + gsub(g, n, 0) + put(g, tkBracketRi, "]") put(g, tkParLe, "(") gsub(g, n, 1) put(g, tkParRi, ")") @@ -923,7 +1205,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = put(g, tkAddr, "addr") if n.len > 0: put(g, tkParLe, "(") - gsub(g, n.sons[0]) + gsub(g, n[0]) put(g, tkParRi, ")") of nkStaticExpr: put(g, tkStatic, "static") @@ -943,14 +1225,26 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = gsub(g, n, 0) gcomma(g, n, 1) of nkCommand: - gsub(g, n, 0) + accentedName(g, n[0]) put(g, tkSpaces, Space) - gcomma(g, n, 1) + 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: gsub(g, n, 0) 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, "(") @@ -966,27 +1260,28 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = put(g, tkParLe, "(") gcomma(g, n) put(g, tkParRi, ")") - of nkObjDownConv, nkObjUpConv, nkStringToCString, nkCStringToString: - if sonsLen(n) >= 1: gsub(g, n.sons[0]) - put(g, tkParLe, "(") - gcomma(g, n, 1) + of nkObjDownConv, nkObjUpConv: + let typ = if (n.typ != nil) and (n.typ.sym != nil): n.typ.sym.name.s else: "" + put(g, tkParLe, typ & "(") + if n.len >= 1: gsub(g, n[0]) put(g, tkParRi, ")") of nkClosedSymChoice, nkOpenSymChoice: if renderIds in g.flags: put(g, tkParLe, "(") - for i in countup(0, sonsLen(n) - 1): + for i in 0..<n.len: if i > 0: put(g, tkOpr, "|") - if n.sons[i].kind == nkSym: + if n[i].kind == nkSym: let s = n[i].sym if s.owner != nil: put g, tkSymbol, n[i].sym.owner.name.s put g, tkOpr, "." put g, tkSymbol, n[i].sym.name.s else: - gsub(g, n.sons[i], c) + gsub(g, n[i], c) 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) @@ -994,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, "{") @@ -1012,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: + 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) @@ -1030,40 +1336,81 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = of nkDo: putWithSpace(g, tkDo, "do") if paramsPos < n.len: - doParamsAux(g, n.sons[paramsPos]) + doParamsAux(g, n[paramsPos]) 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) - var L = sonsLen(n) - if L >= 2 and n.sons[L - 2].kind != nkEmpty: + if n.len >= 2 and n[^2].kind != nkEmpty: putWithSpace(g, tkColon, ":") - gsub(g, n, L - 2) - if L >= 1 and n.sons[L - 1].kind != nkEmpty: + gsub(g, n[^2], c) + + if n.len >= 1 and n[^1].kind != nkEmpty: put(g, tkSpaces, Space) putWithSpace(g, tkEquals, "=") - gsub(g, n.sons[L - 1], c) + gsub(g, n[^1], c) of nkVarTuple: - put(g, tkParLe, "(") - gcomma(g, n, 0, -3) - put(g, tkParRi, ")") - put(g, tkSpaces, Space) - putWithSpace(g, tkEquals, "=") - gsub(g, lastSon(n), c) + if n[^1].kind == nkEmpty: + put(g, tkParLe, "(") + gcomma(g, n, 0, -2) + put(g, tkParRi, ")") + else: + put(g, tkParLe, "(") + gcomma(g, n, 0, -3) + put(g, tkParRi, ")") + put(g, tkSpaces, Space) + putWithSpace(g, tkEquals, "=") + gsub(g, lastSon(n), c) of nkExprColonExpr: gsub(g, n, 0) putWithSpace(g, tkColon, ":") gsub(g, n, 1) of nkInfix: - gsub(g, n, 1) + 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) gsub(g, n, 0) # binary operator - if not fits(g, lsub(g, n.sons[2]) + lsub(g, n.sons[0]) + 1): + # e.g.: `n1 == n2` decompses as following sum: + if n.len == 3 and not fits(g, oldLineLen + lsub(g, n[1]) + lsub(g, n[2]) + lsub(g, n[0]) + len(" ")): optNL(g, g.indent + longIndentWid) else: put(g, tkSpaces, Space) - gsub(g, n, 2) + 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: gsub(g, n, 0) if n.len > 1: @@ -1071,17 +1418,23 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = elif n[0].kind == nkSym: n[0].sym.name elif n[0].kind in {nkOpenSymChoice, nkClosedSymChoice}: n[0][0].sym.name else: nil - if n[1].kind == nkPrefix or (opr != nil and renderer.isKeyword(opr)): + let nNext = skipHiddenNodes(n[1]) + if nNext.kind == nkPrefix or (opr != nil and renderer.isKeyword(opr)): put(g, tkSpaces, Space) - if n.sons[1].kind == nkInfix: + if nNext.kind == nkInfix: put(g, tkParLe, "(") - gsub(g, n.sons[1]) + gsub(g, n[1]) put(g, tkParRi, ")") else: - gsub(g, n.sons[1]) + 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, "..") @@ -1091,20 +1444,33 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = put(g, tkOpr, "[]") of nkAccQuoted: put(g, tkAccent, "`") - if n.len > 0: gsub(g, n.sons[0]) - for i in 1 ..< n.len: - put(g, tkSpaces, Space) - gsub(g, n.sons[i]) + 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: putWithSpace(g, tkIf, "if") - if n.len > 0: gsub(g, n.sons[0], 0) + if n.len > 0: gcond(g, n[0][0]) putWithSpace(g, tkColon, ":") - if n.len > 0: gsub(g, n.sons[0], 1) + if n.len > 0: gsub(g, n[0], 1) gsons(g, n, emptyContext, 1) of nkElifExpr: putWithSpace(g, tkElif, " elif") - gsub(g, n, 0) + gcond(g, n[0]) putWithSpace(g, tkColon, ":") gsub(g, n, 1) of nkElseExpr: @@ -1112,32 +1478,38 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = putWithSpace(g, tkColon, ":") gsub(g, n, 0) of nkTypeOfExpr: - put(g, tkType, "type") + put(g, tkType, "typeof") put(g, tkParLe, "(") - if n.len > 0: gsub(g, n.sons[0]) + if n.len > 0: gsub(g, n[0]) put(g, tkParRi, ")") of nkRefTy: - if sonsLen(n) > 0: + if n.len > 0: putWithSpace(g, tkRef, "ref") - gsub(g, n.sons[0]) + gsub(g, n[0]) else: put(g, tkRef, "ref") of nkPtrTy: - if sonsLen(n) > 0: + if n.len > 0: putWithSpace(g, tkPtr, "ptr") - gsub(g, n.sons[0]) + gsub(g, n[0]) else: put(g, tkPtr, "ptr") of nkVarTy: - if sonsLen(n) > 0: + if n.len > 0: putWithSpace(g, tkVar, "var") - gsub(g, n.sons[0]) + 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") - gsub(g, n.sons[0]) + gsub(g, n[0]) if n.len > 1: if n[1].kind == nkWith: putWithSpace(g, tkSymbol, " with") @@ -1147,41 +1519,47 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = else: put(g, tkDistinct, "distinct") of nkTypeDef: - gsub(g, n, 0) - gsub(g, n, 1) + if n[0].kind == nkPragmaExpr: + # generate pragma after generic + gsub(g, n[0], 0) + gsub(g, n, 1) + gsub(g, n[0], 1) + else: + gsub(g, n, 0) + gsub(g, n, 1) put(g, tkSpaces, Space) - if n.len > 2 and n.sons[2].kind != nkEmpty: + if n.len > 2 and n[2].kind != nkEmpty: putWithSpace(g, tkEquals, "=") - gsub(g, n.sons[2]) + gsub(g, n[2]) of nkObjectTy: - if sonsLen(n) > 0: + if n.len > 0: putWithSpace(g, tkObject, "object") - gsub(g, n.sons[0]) - gsub(g, n.sons[1]) - gcoms(g) - gsub(g, n.sons[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 countup(0, sonsLen(n) - 1): + for i in 0..<n.len: optNL(g) - gsub(g, n.sons[i], c) + gsub(g, n[i], c) gcoms(g) - dedent(g) - putNL(g) of nkOfInherit: putWithSpace(g, tkOf, "of") gsub(g, n, 0) of nkProcTy: - if sonsLen(n) > 0: + if n.len > 0: putWithSpace(g, tkProc, "proc") gsub(g, n, 0) gsub(g, n, 1) else: put(g, tkProc, "proc") of nkIteratorTy: - if sonsLen(n) > 0: + if n.len > 0: putWithSpace(g, tkIterator, "iterator") gsub(g, n, 0) gsub(g, n, 1) @@ -1191,12 +1569,12 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = put(g, tkStatic, "static") put(g, tkBracketLe, "[") if n.len > 0: - gsub(g, n.sons[0]) + gsub(g, n[0]) put(g, tkBracketRi, "]") of nkEnumTy: - if sonsLen(n) > 0: + if n.len > 0: putWithSpace(g, tkEnum, "enum") - gsub(g, n.sons[0]) + gsub(g, n[0]) gcoms(g) indentNL(g) gcommaAux(g, n, g.indent, 1) @@ -1209,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) @@ -1219,7 +1603,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = of nkWhileStmt: gwhile(g, n) of nkPragmaBlock: gpragmaBlock(g, n) of nkCaseStmt, nkRecCase: gcase(g, n) - of nkTryStmt: gtry(g, n) + of nkTryStmt, nkHiddenTryStmt: gtry(g, n) of nkForStmt, nkParForStmt: gfor(g, n) of nkBlockStmt, nkBlockExpr: gblock(g, n) of nkStaticStmt: gstaticStmt(g, n) @@ -1248,28 +1632,30 @@ 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: - var L = sonsLen(n) - if L == 0: return + if n.len == 0: return if n.kind == nkVarSection: putWithSpace(g, tkVar, "var") elif n.kind == nkLetSection: putWithSpace(g, tkLet, "let") else: putWithSpace(g, tkUsing, "using") - if L > 1: + if n.len > 1: gcoms(g) indentNL(g) - for i in countup(0, L - 1): + for i in 0..<n.len: optNL(g) - gsub(g, n.sons[i]) + gsub(g, n[i]) gcoms(g) dedent(g) else: - gsub(g, n.sons[0]) + gsub(g, n[0]) of nkReturnStmt: putWithSpace(g, tkReturn, "return") - gsub(g, n, 0) + if n.len > 0 and n[0].kind == nkAsgn and renderIr notin g.flags: + gsub(g, n[0], 1) + else: + gsub(g, n, 0) of nkRaiseStmt: putWithSpace(g, tkRaise, "raise") gsub(g, n, 0) @@ -1286,17 +1672,16 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = putWithSpace(g, tkContinue, "continue") gsub(g, n, 0) of nkPragma: - if renderNoPragmas notin g.flags: - if g.inPragma <= 0: - inc g.inPragma - #if not previousNL(g): - put(g, tkSpaces, Space) - put(g, tkCurlyDotLe, "{.") - gcomma(g, n, emptyContext) - put(g, tkCurlyDotRi, ".}") - dec g.inPragma - else: - gcomma(g, n, emptyContext) + if g.inPragma <= 0: + inc g.inPragma + #if not previousNL(g): + put(g, tkSpaces, Space) + put(g, tkCurlyDotLe, "{.") + gcomma(g, n, emptyContext) + put(g, tkCurlyDotRi, ".}") + dec g.inPragma + else: + gcomma(g, n, emptyContext) of nkImportStmt, nkExportStmt: if n.kind == nkImportStmt: putWithSpace(g, tkImport, "import") @@ -1359,13 +1744,13 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = gsub(g, n, 0) putWithSpace(g, tkColon, ":") gcoms(g) - gstmts(g, n.sons[1], c) + gstmts(g, n[1], c) of nkElse: optNL(g) put(g, tkElse, "else") putWithSpace(g, tkColon, ":") gcoms(g) - gstmts(g, n.sons[0], c) + gstmts(g, n[0], c) of nkFinally, nkDefer: optNL(g) if n.kind == nkFinally: @@ -1374,7 +1759,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = put(g, tkDefer, "defer") putWithSpace(g, tkColon, ":") gcoms(g) - gstmts(g, n.sons[0], c) + gstmts(g, n[0], c) of nkExceptBranch: optNL(g) if n.len != 1: @@ -1400,9 +1785,9 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = put(g, tkParLe, "(") gsemicolon(g, n, 1) put(g, tkParRi, ")") - if n.len > 0 and n.sons[0].kind != nkEmpty: + if n.len > 0 and n[0].kind != nkEmpty: putWithSpace(g, tkColon, ":") - gsub(g, n.sons[0]) + gsub(g, n[0]) of nkTupleTy: put(g, tkTuple, "tuple") put(g, tkBracketLe, "[") @@ -1415,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, ":") @@ -1431,15 +1814,21 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = of nkBreakState: put(g, tkTuple, "breakstate") + if renderIds in g.flags: + 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 = - var g: TSrcGen - initSrcGen(g, renderFlags, newPartialConfigRef()) + if n == nil: return "<nil tree>" + var g: TSrcGen = initSrcGen(renderFlags, newPartialConfigRef()) # do not indent the initial statement list so that # writeFile("file.nim", repr n) # produces working Nim code: @@ -1451,19 +1840,18 @@ proc renderTree*(n: PNode, renderFlags: TRenderFlags = {}): string = proc `$`*(n: PNode): string = n.renderTree -proc renderModule*(n: PNode, infile, outfile: string, +proc renderModule*(n: PNode, outfile: string, renderFlags: TRenderFlags = {}; 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 countup(0, sonsLen(n) - 1): - gsub(g, n.sons[i]) + for i in 0..<n.len: + gsub(g, n[i]) optNL(g) - case n.sons[i].kind + case n[i].kind of nkTypeSection, nkConstSection, nkVarSection, nkLetSection, nkCommentStmt: putNL(g) else: discard @@ -1474,16 +1862,22 @@ proc renderModule*(n: PNode, infile, 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 TTokType, literal: var string) = - if r.idx < len(r.tokens): +proc getNextTok*(r: var TSrcGen, kind: var TokType, literal: var string) = + if r.idx < r.tokens.len: kind = r.tokens[r.idx].kind - var length = r.tokens[r.idx].length.int + let length = r.tokens[r.idx].length.int literal = substr(r.buf, r.pos, r.pos + length - 1) inc(r.pos, length) inc(r.idx) else: kind = tkEof + +proc getTokSym*(r: TSrcGen): PSym = + if r.idx > 0 and r.idx <= r.tokens.len: + result = r.tokens[r.idx-1].sym + else: + result = nil diff --git a/compiler/renderverbatim.nim b/compiler/renderverbatim.nim new file mode 100644 index 000000000..c12595156 --- /dev/null +++ b/compiler/renderverbatim.nim @@ -0,0 +1,137 @@ +import std/strutils + +import ast, options, msgs + +when defined(nimPreviewSlimSystem): + import std/assertions + + +const isDebug = false +when isDebug: + import renderer + import astalgo + +proc lastNodeRec(n: PNode): PNode = + result = n + while result.safeLen > 0: result = result[^1] + +proc isInIndentationBlock(src: string, indent: int): bool = + #[ + we stop at the first de-indentation; there's an inherent ambiguity with non + doc comments since they can have arbitrary indentation, so we just take the + practical route and require a runnableExamples to keep its code (including non + doc comments) to its indentation level. + ]# + for j in 0..<indent: + if src.len <= j: return true + if src[j] != ' ': return false + return true + +type LineData = object + ## keep track of which lines are starting inside a multiline doc comment. + ## We purposefully avoid re-doing parsing which is already done (we get a PNode) + ## so we don't worry about whether we're inside (nested) doc comments etc. + ## But we sill need some logic to disambiguate different multiline styles. + conf: ConfigRef + lineFirst: int + lines: seq[bool] + ## lines[index] is true if line `lineFirst+index` starts inside a multiline string + ## Using a HashSet (extra dependency) would simplify but not by much. + +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 + doAssert src.continuesWith(tripleQuote, col) # sanity check + var i = col + 3 + var onlySpace = true + while true: + if src.len <= i: + doAssert src.len == i + return onlySpace + elif src.continuesWith(tripleQuote, i) and (src.len == i+3 or src[i+3] != '\"'): + return false # triple lit is in 1 line + elif src[i] != ' ': onlySpace = false + i.inc + +proc visitMultilineStrings(ldata: var LineData, n: PNode) = + var cline = ldata.lineFirst + + template setLine() = + let index = cline - ldata.lineFirst + if ldata.lines.len < index+1: ldata.lines.setLen index+1 + ldata.lines[index] = true + + case n.kind + of nkTripleStrLit: + # same logic should be applied for any multiline token + # we could also consider nkCommentStmt but right now we just assume doc comments, + # unlike triple string litterals, don't de-indent from runnableExamples. + cline = n.info.line.int + if tripleStrLitStartsAtNextLine(ldata.conf, n): + cline.inc + setLine() + for ai in n.strVal: + case ai + of '\n': + cline.inc + setLine() + else: discard + else: + for i in 0..<n.safeLen: + visitMultilineStrings(ldata, n[i]) + +proc startOfLineInsideTriple(ldata: LineData, line: int): bool = + let index = line - ldata.lineFirst + if index >= ldata.lines.len: false + else: ldata.lines[index] + +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 + if first.line == n[0].info.line: + #[ + runnableExamples: assert true + ]# + discard + else: + #[ + runnableExamples: + # non-doc comment that we want to capture even though `first` points to `assert true` + assert true + ]# + first.line = n[0].info.line + 1 + + let last = n.lastNodeRec.info + var info = first + var indent2 = info.col + let numLines = numLines(conf, info.fileIndex).uint16 + var lastNonemptyPos = 0 + + var ldata = LineData(lineFirst: first.line.int, conf: conf) + visitMultilineStrings(ldata, n[^1]) + when isDebug: + debug(n) + for i in 0..<ldata.lines.len: + echo (i+ldata.lineFirst, ldata.lines[i]) + + result = "" + for line in first.line..numLines: # bugfix, see `testNimDocTrailingExample` + 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, indent2): + break + if line > first.line: result.add "\n" + if special: + result.add src + lastNonemptyPos = result.len + elif src.len > indent2: + for i in 0..<indent: result.add ' ' + result.add src[indent2..^1] + lastNonemptyPos = result.len + result.setLen lastNonemptyPos + diff --git a/compiler/reorder.nim b/compiler/reorder.nim index 27b19a373..2f7c04af1 100644 --- a/compiler/reorder.nim +++ b/compiler/reorder.nim @@ -1,9 +1,17 @@ import - intsets, ast, idents, algorithm, renderer, parser, ospaths, strutils, - sequtils, msgs, modulegraphs, syntaxes, options, modulepaths, tables, + 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 + for i in 0..<n.len: + 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) @@ -75,8 +74,8 @@ proc computeDeps(cache: IdentCache; n: PNode, declares, uses: var IntSet; topLev of nkLetSection, nkVarSection, nkUsingStmt: for a in n: if a.kind in {nkIdentDefs, nkVarTuple}: - for j in countup(0, a.len-3): decl(a[j]) - for j in a.len-2..a.len-1: deps(a[j]) + for j in 0..<a.len-2: decl(a[j]) + for j in a.len-2..<a.len: deps(a[j]) of nkConstSection, nkTypeSection: for a in n: if a.len >= 3: @@ -95,48 +94,29 @@ proc computeDeps(cache: IdentCache; n: PNode, declares, uses: var IntSet; topLev of nkSym: uses.incl n.sym.name.id of nkAccQuoted: uses.incl accQuoted(cache, n).id of nkOpenSymChoice, nkClosedSymChoice: - uses.incl n.sons[0].sym.name.id + uses.incl n[0].sym.name.id of nkStmtList, nkStmtListExpr, nkWhenStmt, nkElifBranch, nkElse, nkStaticStmt: - for i in 0..<len(n): computeDeps(cache, n[i], declares, uses, topLevel) + for i in 0..<n.len: computeDeps(cache, n[i], declares, uses, topLevel) of nkPragma: - let a = n.sons[0] - if a.kind == nkExprColonExpr and a.sons[0].kind == nkIdent and - a.sons[0].ident.s == "pragma": - # user defined pragma - decl(a.sons[1]) + let a = n[0] + 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..<safeLen(n): deps(n[i]) + for i in 0..<n.safeLen: deps(n[i]) + of nkMixinStmt, nkBindStmt: discard else: - for i in 0..<safeLen(n): deps(n[i]) - -proc cleanPath(s: string): string = - # Here paths may have the form A / B or "A/B" - result = "" - for c in s: - if c != ' ' and c != '\"': - result.add c - -proc joinPath(parts: seq[string]): string = - let nb = parts.len - assert nb > 0 - if nb == 1: - return parts[0] - result = parts[0] / parts[1] - for i in 2..<parts.len: - result = result / parts[i] - -proc getIncludePath(n: PNode, modulePath: string): string = - let istr = n.renderTree.cleanPath - let (pdir, _) = modulePath.splitPath - let p = istr.split('/').joinPath.addFileExt("nim") - result = pdir / p - -proc hasIncludes(n:PNode): bool = + # 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 = + result = false for a in n: if a.kind == nkIncludeStmt: return true -proc includeModule*(graph: ModuleGraph; s: PSym, fileIdx: FileIndex): PNode {.procvar.} = +proc includeModule*(graph: ModuleGraph; s: PSym, fileIdx: FileIndex): PNode = result = syntaxes.parseFile(fileIdx, graph.cache, graph.config) graph.addDep(s, fileIdx) graph.addIncludeDep(FileIndex s.position, fileIdx) @@ -150,11 +130,11 @@ proc expandIncludes(graph: ModuleGraph, module: PSym, n: PNode, for a in n: if a.kind == nkIncludeStmt: for i in 0..<a.len: - var f = checkModuleName(graph.config, a.sons[i]) - if f != InvalidFileIDX: + var f = checkModuleName(graph.config, a[i]) + if f != InvalidFileIdx: if containsOrIncl(includedFiles, f.int): localError(graph.config, a.info, "recursive dependency: '$1'" % - toFilename(graph.config, f)) + toMsgFilename(graph.config, f)) else: let nn = includeModule(graph, module, f) let nnn = expandIncludes(graph, module, nn, modulePath, @@ -206,53 +186,54 @@ proc mergeSections(conf: ConfigRef; comps: seq[seq[DepN]], res: PNode) = # need to merge them var sn = newNode(kind) for dn in cs: - sn.add dn.pnode.sons[0] + sn.add dn.pnode[0] res.add sn else: - # Problematic circular dependency, we arrange the nodes into - # their original relative order and make sure to re-merge - # consecutive type and const sections - var wmsg = "Circular dependency detected. reorder pragma may not be able to" & - " reorder some nodes properely" - when defined(debugReorder): - wmsg &= ":\n" - for i in 0..<cs.len-1: - for j in i..<cs.len: - for ci in 0..<cs[i].kids.len: - if cs[i].kids[ci].id == cs[j].id: - wmsg &= "line " & $cs[i].pnode.info.line & - " depends on line " & $cs[j].pnode.info.line & - ": " & cs[i].expls[ci] & "\n" - for j in 0..<cs.len-1: - for ci in 0..<cs[^1].kids.len: - if cs[^1].kids[ci].id == cs[j].id: - wmsg &= "line " & $cs[^1].pnode.info.line & - " depends on line " & $cs[j].pnode.info.line & - ": " & cs[^1].expls[ci] & "\n" - message(conf, cs[0].pnode.info, warnUser, wmsg) - - var i = 0 - while i < cs.len: - if cs[i].pnode.kind in {nkTypeSection, nkConstSection}: - let ckind = cs[i].pnode.kind - var sn = newNode(ckind) + # Problematic circular dependency, we arrange the nodes into + # their original relative order and make sure to re-merge + # consecutive type and const sections + var wmsg = "Circular dependency detected. `codeReordering` pragma may not be able to" & + " reorder some nodes properly" + when defined(nimDebugReorder): + wmsg &= ":\n" + for i in 0..<cs.len-1: + for j in i..<cs.len: + for ci in 0..<cs[i].kids.len: + if cs[i].kids[ci].id == cs[j].id: + wmsg &= "line " & $cs[i].pnode.info.line & + " depends on line " & $cs[j].pnode.info.line & + ": " & cs[i].expls[ci] & "\n" + for j in 0..<cs.len-1: + for ci in 0..<cs[^1].kids.len: + if cs[^1].kids[ci].id == cs[j].id: + wmsg &= "line " & $cs[^1].pnode.info.line & + " depends on line " & $cs[j].pnode.info.line & + ": " & cs[^1].expls[ci] & "\n" + message(conf, cs[0].pnode.info, warnUser, wmsg) + + var i = 0 + while i < cs.len: + if cs[i].pnode.kind in {nkTypeSection, nkConstSection}: + let ckind = cs[i].pnode.kind + var sn = newNode(ckind) + sn.add cs[i].pnode[0] + inc i + while i < cs.len and cs[i].pnode.kind == ckind: sn.add cs[i].pnode[0] inc i - while i < cs.len and cs[i].pnode.kind == ckind : - sn.add cs[i].pnode[0] - inc i - res.add sn - else: - res.add cs[i].pnode - inc i + res.add sn + else: + res.add cs[i].pnode + inc i proc hasImportStmt(n: PNode): bool = # Checks if the node is an import statement or # 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 @@ -273,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 @@ -285,23 +267,25 @@ 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: if hasAccQuoted(a): return true -const extandedProcDefs = procDefs + {nkMacroDef, nkTemplateDef} +const extendedProcDefs = procDefs + {nkMacroDef, nkTemplateDef} proc hasAccQuotedDef(n: PNode): bool = # Checks if the node is a function, macro, template ... # with a quoted name or if it contains one case n.kind - of extandedProcDefs: + of extendedProcDefs: result = n[0].hasAccQuoted of nkStmtList, nkStmtListExpr, nkWhenStmt, nkElifBranch, nkElse, nkStaticStmt: + result = false for a in n: - if a.hasAccQuotedDef: + if hasAccQuotedDef(a): return true else: result = false @@ -317,9 +301,10 @@ proc hasBody(n: PNode): bool = case n.kind of nkCommand, nkCall: result = true - of extandedProcDefs: + 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 @@ -332,15 +317,24 @@ 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) for i in 0..<deps.len: - result.add newDepN(i, n.sons[i]) + result.add newDepN(i, n[i]) for i in 0..<deps.len: var ni = result[i] let uses = deps[i][1] @@ -353,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 @@ -367,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], @@ -410,24 +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. - result = newSeq[seq[DepN]]() - var s = newSeq[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/rod.nim b/compiler/rod.nim deleted file mode 100644 index f9208f5dc..000000000 --- a/compiler/rod.nim +++ /dev/null @@ -1,29 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2017 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements the canonalization for the various caching mechanisms. - -import ast, idgen, lineinfos, msgs, incremental, modulegraphs - -when not nimIncremental: - template setupModuleCache*(g: ModuleGraph) = discard - template storeNode*(g: ModuleGraph; module: PSym; n: PNode) = discard - template loadNode*(g: ModuleGraph; module: PSym): PNode = newNode(nkStmtList) - - template getModuleId*(g: ModuleGraph; fileIdx: FileIndex; fullpath: string): int = getID() - - template addModuleDep*(g: ModuleGraph; module, fileIdx: FileIndex; isIncludeFile: bool) = discard - - template storeRemaining*(g: ModuleGraph; module: PSym) = discard - -else: - include rodimpl - - # idea for testing all this logic: *Always* load the AST from the DB, whether - # we already have it in RAM or not! diff --git a/compiler/rodimpl.nim b/compiler/rodimpl.nim deleted file mode 100644 index 7d24e4e67..000000000 --- a/compiler/rodimpl.nim +++ /dev/null @@ -1,885 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2018 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements the new compilation cache. - -import strutils, os, intsets, tables, ropes, db_sqlite, msgs, options, types, - renderer, rodutils, idents, astalgo, btrees, magicsys, cgmeth, extccomp, - btrees, trees, condsyms, nversion - -## Todo: -## - Dependency computation should use *signature* hashes in order to -## avoid recompiling dependent modules. -## - Patch the rest of the compiler to do lazy loading of proc bodies. -## - Patch the C codegen to cache proc bodies and maybe types. - -template db(): DbConn = g.incr.db - -proc encodeConfig(g: ModuleGraph): string = - result = newStringOfCap(100) - result.add RodFileVersion - for d in definedSymbolNames(g.config.symbols): - result.add ' ' - result.add d - - template serialize(field) = - result.add ' ' - result.add($g.config.field) - - depConfigFields(serialize) - -proc needsRecompile(g: ModuleGraph; fileIdx: FileIndex; fullpath: string; - cycleCheck: var IntSet): bool = - let root = db.getRow(sql"select id, fullhash from filenames where fullpath = ?", - fullpath) - if root[0].len == 0: return true - if root[1] != hashFileCached(g.config, fileIdx, fullpath): - return true - # cycle detection: assume "not changed" is correct. - if cycleCheck.containsOrIncl(int fileIdx): - return false - # check dependencies (recursively): - for row in db.fastRows(sql"select fullpath from filenames where id in (select dependency from deps where module = ?)", - root[0]): - let dep = row[0] - if needsRecompile(g, g.config.fileInfoIdx(dep), dep, cycleCheck): - return true - return false - -proc getModuleId*(g: ModuleGraph; fileIdx: FileIndex; fullpath: string): int = - if g.config.symbolFiles in {disabledSf, writeOnlySf} or - g.incr.configChanged: - return getID() - let module = g.incr.db.getRow( - sql"select id, fullHash, nimid from modules where fullpath = ?", fullpath) - let currentFullhash = hashFileCached(g.config, fileIdx, fullpath) - if module[0].len == 0: - result = getID() - db.exec(sql"insert into modules(fullpath, interfHash, fullHash, nimid) values (?, ?, ?, ?)", - fullpath, "", currentFullhash, result) - else: - result = parseInt(module[2]) - if currentFullhash == module[1]: - # not changed, so use the cached AST: - doAssert(result != 0) - var cycleCheck = initIntSet() - if not needsRecompile(g, fileIdx, fullpath, cycleCheck): - echo "cached successfully! ", fullpath - return -result - db.exec(sql"update modules set fullHash = ? where id = ?", currentFullhash, module[0]) - db.exec(sql"delete from deps where module = ?", module[0]) - db.exec(sql"delete from types where module = ?", module[0]) - db.exec(sql"delete from syms where module = ?", module[0]) - db.exec(sql"delete from toplevelstmts where module = ?", module[0]) - db.exec(sql"delete from statics where module = ?", module[0]) - -proc pushType(w: var Writer, t: PType) = - if not containsOrIncl(w.tmarks, t.id): - w.tstack.add(t) - -proc pushSym(w: var Writer, s: PSym) = - if not containsOrIncl(w.smarks, s.id): - w.sstack.add(s) - -template w: untyped = g.incr.w - -proc encodeNode(g: ModuleGraph; fInfo: TLineInfo, n: PNode, - result: var string) = - if n == nil: - # nil nodes have to be stored too: - result.add("()") - return - result.add('(') - encodeVInt(ord(n.kind), result) - # we do not write comments for now - # Line information takes easily 20% or more of the filesize! Therefore we - # omit line information if it is the same as the parent's line information: - if fInfo.fileIndex != n.info.fileIndex: - result.add('?') - encodeVInt(n.info.col, result) - result.add(',') - encodeVInt(int n.info.line, result) - result.add(',') - encodeVInt(toDbFileId(g.incr, g.config, n.info.fileIndex), result) - elif fInfo.line != n.info.line: - result.add('?') - encodeVInt(n.info.col, result) - result.add(',') - encodeVInt(int n.info.line, result) - elif fInfo.col != n.info.col: - result.add('?') - encodeVInt(n.info.col, result) - # No need to output the file index, as this is the serialization of one - # file. - let f = n.flags * PersistentNodeFlags - if f != {}: - result.add('$') - encodeVInt(cast[int32](f), result) - if n.typ != nil: - result.add('^') - encodeVInt(n.typ.id, result) - pushType(w, n.typ) - case n.kind - of nkCharLit..nkUInt64Lit: - if n.intVal != 0: - result.add('!') - encodeVBiggestInt(n.intVal, result) - of nkFloatLit..nkFloat64Lit: - if n.floatVal != 0.0: - result.add('!') - encodeStr($n.floatVal, result) - of nkStrLit..nkTripleStrLit: - if n.strVal != "": - result.add('!') - encodeStr(n.strVal, result) - of nkIdent: - result.add('!') - encodeStr(n.ident.s, result) - of nkSym: - result.add('!') - encodeVInt(n.sym.id, result) - pushSym(w, n.sym) - else: - for i in countup(0, sonsLen(n) - 1): - encodeNode(g, n.info, n.sons[i], result) - add(result, ')') - -proc encodeLoc(g: ModuleGraph; loc: TLoc, result: var string) = - var oldLen = result.len - result.add('<') - if loc.k != low(loc.k): encodeVInt(ord(loc.k), result) - if loc.storage != low(loc.storage): - add(result, '*') - encodeVInt(ord(loc.storage), result) - if loc.flags != {}: - add(result, '$') - encodeVInt(cast[int32](loc.flags), result) - if loc.lode != nil: - add(result, '^') - encodeNode(g, unknownLineInfo(), loc.lode, result) - if loc.r != nil: - add(result, '!') - encodeStr($loc.r, result) - if oldLen + 1 == result.len: - # no data was necessary, so remove the '<' again: - setLen(result, oldLen) - else: - add(result, '>') - -proc encodeType(g: ModuleGraph, t: PType, result: var string) = - if t == nil: - # nil nodes have to be stored too: - result.add("[]") - return - # we need no surrounding [] here because the type is in a line of its own - if t.kind == tyForward: internalError(g.config, "encodeType: tyForward") - # for the new rodfile viewer we use a preceding [ so that the data section - # can easily be disambiguated: - add(result, '[') - encodeVInt(ord(t.kind), result) - add(result, '+') - encodeVInt(t.id, result) - if t.n != nil: - encodeNode(g, unknownLineInfo(), t.n, result) - if t.flags != {}: - add(result, '$') - encodeVInt(cast[int32](t.flags), result) - if t.callConv != low(t.callConv): - add(result, '?') - encodeVInt(ord(t.callConv), result) - if t.owner != nil: - add(result, '*') - encodeVInt(t.owner.id, result) - pushSym(w, t.owner) - if t.sym != nil: - add(result, '&') - encodeVInt(t.sym.id, result) - pushSym(w, t.sym) - if t.size != - 1: - add(result, '/') - encodeVBiggestInt(t.size, result) - if t.align != 2: - add(result, '=') - encodeVInt(t.align, result) - if t.lockLevel.ord != UnspecifiedLockLevel.ord: - add(result, '\14') - encodeVInt(t.lockLevel.int16, result) - if t.destructor != nil and t.destructor.id != 0: - add(result, '\15') - encodeVInt(t.destructor.id, result) - pushSym(w, t.destructor) - if t.deepCopy != nil: - add(result, '\16') - encodeVInt(t.deepcopy.id, result) - pushSym(w, t.deepcopy) - if t.assignment != nil: - add(result, '\17') - encodeVInt(t.assignment.id, result) - pushSym(w, t.assignment) - if t.sink != nil: - add(result, '\18') - encodeVInt(t.sink.id, result) - pushSym(w, t.sink) - for i, s in items(t.methods): - add(result, '\19') - encodeVInt(i, result) - add(result, '\20') - encodeVInt(s.id, result) - pushSym(w, s) - encodeLoc(g, t.loc, result) - for i in countup(0, sonsLen(t) - 1): - if t.sons[i] == nil: - add(result, "^()") - else: - add(result, '^') - encodeVInt(t.sons[i].id, result) - pushType(w, t.sons[i]) - -proc encodeLib(g: ModuleGraph, lib: PLib, info: TLineInfo, result: var string) = - add(result, '|') - encodeVInt(ord(lib.kind), result) - add(result, '|') - encodeStr($lib.name, result) - add(result, '|') - encodeNode(g, info, lib.path, result) - -proc encodeInstantiations(g: ModuleGraph; s: seq[PInstantiation]; - result: var string) = - for t in s: - result.add('\15') - encodeVInt(t.sym.id, result) - pushSym(w, t.sym) - for tt in t.concreteTypes: - result.add('\17') - encodeVInt(tt.id, result) - pushType(w, tt) - result.add('\20') - encodeVInt(t.compilesId, result) - -proc encodeSym(g: ModuleGraph, s: PSym, result: var string) = - if s == nil: - # nil nodes have to be stored too: - result.add("{}") - return - # we need no surrounding {} here because the symbol is in a line of its own - encodeVInt(ord(s.kind), result) - result.add('+') - encodeVInt(s.id, result) - result.add('&') - encodeStr(s.name.s, result) - if s.typ != nil: - result.add('^') - encodeVInt(s.typ.id, result) - pushType(w, s.typ) - result.add('?') - if s.info.col != -1'i16: encodeVInt(s.info.col, result) - result.add(',') - encodeVInt(int s.info.line, result) - result.add(',') - encodeVInt(toDbFileId(g.incr, g.config, s.info.fileIndex), result) - if s.owner != nil: - result.add('*') - encodeVInt(s.owner.id, result) - pushSym(w, s.owner) - if s.flags != {}: - result.add('$') - encodeVInt(cast[int32](s.flags), result) - if s.magic != mNone: - result.add('@') - encodeVInt(ord(s.magic), result) - result.add('!') - encodeVInt(cast[int32](s.options), result) - if s.position != 0: - result.add('%') - encodeVInt(s.position, result) - if s.offset != - 1: - result.add('`') - encodeVInt(s.offset, result) - encodeLoc(g, s.loc, result) - if s.annex != nil: encodeLib(g, s.annex, s.info, result) - if s.constraint != nil: - add(result, '#') - encodeNode(g, unknownLineInfo(), s.constraint, result) - case s.kind - of skType, skGenericParam: - for t in s.typeInstCache: - result.add('\14') - encodeVInt(t.id, result) - pushType(w, t) - of routineKinds: - encodeInstantiations(g, s.procInstCache, result) - if s.gcUnsafetyReason != nil: - result.add('\16') - encodeVInt(s.gcUnsafetyReason.id, result) - pushSym(w, s.gcUnsafetyReason) - of skModule, skPackage: - encodeInstantiations(g, s.usedGenerics, result) - # we don't serialize: - #tab*: TStrTable # interface table for modules - of skLet, skVar, skField, skForVar: - if s.guard != nil: - result.add('\18') - encodeVInt(s.guard.id, result) - pushSym(w, s.guard) - if s.bitsize != 0: - result.add('\19') - encodeVInt(s.bitsize, result) - else: discard - # lazy loading will soon reload the ast lazily, so the ast needs to be - # the last entry of a symbol: - if s.ast != nil: - # we used to attempt to save space here by only storing a dummy AST if - # it is not necessary, but Nim's heavy compile-time evaluation features - # make that unfeasible nowadays: - encodeNode(g, s.info, s.ast, result) - -proc storeSym(g: ModuleGraph; s: PSym) = - if sfForward in s.flags and s.kind != skModule: - w.forwardedSyms.add s - return - var buf = newStringOfCap(160) - encodeSym(g, s, buf) - # XXX only store the name for exported symbols in order to speed up lookup - # times once we enable the skStub logic. - let m = getModule(s) - let mid = if m == nil: 0 else: abs(m.id) - db.exec(sql"insert into syms(nimid, module, name, data, exported) values (?, ?, ?, ?, ?)", - s.id, mid, s.name.s, buf, ord(sfExported in s.flags)) - -proc storeType(g: ModuleGraph; t: PType) = - var buf = newStringOfCap(160) - encodeType(g, t, buf) - let m = if t.owner != nil: getModule(t.owner) else: nil - let mid = if m == nil: 0 else: abs(m.id) - db.exec(sql"insert into types(nimid, module, data) values (?, ?, ?)", - t.id, mid, buf) - -proc storeNode*(g: ModuleGraph; module: PSym; n: PNode) = - if g.config.symbolFiles == disabledSf: return - var buf = newStringOfCap(160) - encodeNode(g, module.info, n, buf) - db.exec(sql"insert into toplevelstmts(module, position, data) values (?, ?, ?)", - abs(module.id), module.offset, buf) - inc module.offset - var i = 0 - while true: - if i > 10_000: - doAssert false, "loop never ends!" - if w.sstack.len > 0: - let s = w.sstack.pop() - when false: - echo "popped ", s.name.s, " ", s.id - storeSym(g, s) - elif w.tstack.len > 0: - let t = w.tstack.pop() - storeType(g, t) - when false: - echo "popped type ", typeToString(t), " ", t.id - else: - break - inc i - -proc recordStmt*(g: ModuleGraph; module: PSym; n: PNode) = - storeNode(g, module, n) - -proc storeRemaining*(g: ModuleGraph; module: PSym) = - if g.config.symbolFiles == disabledSf: return - var stillForwarded: seq[PSym] = @[] - for s in w.forwardedSyms: - if sfForward notin s.flags: - storeSym(g, s) - else: - stillForwarded.add s - swap w.forwardedSyms, stillForwarded - -# ---------------- decoder ----------------------------------- - -type - BlobReader = object - s: string - pos: int - -using - b: var BlobReader - g: ModuleGraph - -proc loadSym(g; id: int, info: TLineInfo): PSym -proc loadType(g; id: int, info: TLineInfo): PType - -proc decodeLineInfo(g; b; info: var TLineInfo) = - if b.s[b.pos] == '?': - inc(b.pos) - if b.s[b.pos] == ',': info.col = -1'i16 - else: info.col = int16(decodeVInt(b.s, b.pos)) - if b.s[b.pos] == ',': - inc(b.pos) - if b.s[b.pos] == ',': info.line = 0'u16 - else: info.line = uint16(decodeVInt(b.s, b.pos)) - if b.s[b.pos] == ',': - inc(b.pos) - info.fileIndex = fromDbFileId(g.incr, g.config, decodeVInt(b.s, b.pos)) - -proc skipNode(b) = - assert b.s[b.pos] == '(' - var par = 0 - var pos = b.pos+1 - while true: - case b.s[pos] - of ')': - if par == 0: break - dec par - of '(': inc par - else: discard - inc pos - b.pos = pos+1 # skip ')' - -proc decodeNodeLazyBody(g; b; fInfo: TLineInfo, - belongsTo: PSym): PNode = - result = nil - if b.s[b.pos] == '(': - inc(b.pos) - if b.s[b.pos] == ')': - inc(b.pos) - return # nil node - result = newNodeI(TNodeKind(decodeVInt(b.s, b.pos)), fInfo) - decodeLineInfo(g, b, result.info) - if b.s[b.pos] == '$': - inc(b.pos) - result.flags = cast[TNodeFlags](int32(decodeVInt(b.s, b.pos))) - if b.s[b.pos] == '^': - inc(b.pos) - var id = decodeVInt(b.s, b.pos) - result.typ = loadType(g, id, result.info) - case result.kind - of nkCharLit..nkUInt64Lit: - if b.s[b.pos] == '!': - inc(b.pos) - result.intVal = decodeVBiggestInt(b.s, b.pos) - of nkFloatLit..nkFloat64Lit: - if b.s[b.pos] == '!': - inc(b.pos) - var fl = decodeStr(b.s, b.pos) - result.floatVal = parseFloat(fl) - of nkStrLit..nkTripleStrLit: - if b.s[b.pos] == '!': - inc(b.pos) - result.strVal = decodeStr(b.s, b.pos) - else: - result.strVal = "" - of nkIdent: - if b.s[b.pos] == '!': - inc(b.pos) - var fl = decodeStr(b.s, b.pos) - result.ident = g.cache.getIdent(fl) - else: - internalError(g.config, result.info, "decodeNode: nkIdent") - of nkSym: - if b.s[b.pos] == '!': - inc(b.pos) - var id = decodeVInt(b.s, b.pos) - result.sym = loadSym(g, id, result.info) - else: - internalError(g.config, result.info, "decodeNode: nkSym") - else: - var i = 0 - while b.s[b.pos] != ')': - when false: - if belongsTo != nil and i == bodyPos: - addSonNilAllowed(result, nil) - belongsTo.offset = b.pos - skipNode(b) - else: - discard - addSonNilAllowed(result, decodeNodeLazyBody(g, b, result.info, nil)) - inc i - if b.s[b.pos] == ')': inc(b.pos) - else: internalError(g.config, result.info, "decodeNode: ')' missing") - else: - internalError(g.config, fInfo, "decodeNode: '(' missing " & $b.pos) - -proc decodeNode(g; b; fInfo: TLineInfo): PNode = - result = decodeNodeLazyBody(g, b, fInfo, nil) - -proc decodeLoc(g; b; loc: var TLoc, info: TLineInfo) = - if b.s[b.pos] == '<': - inc(b.pos) - if b.s[b.pos] in {'0'..'9', 'a'..'z', 'A'..'Z'}: - loc.k = TLocKind(decodeVInt(b.s, b.pos)) - else: - loc.k = low(loc.k) - if b.s[b.pos] == '*': - inc(b.pos) - loc.storage = TStorageLoc(decodeVInt(b.s, b.pos)) - else: - loc.storage = low(loc.storage) - if b.s[b.pos] == '$': - inc(b.pos) - loc.flags = cast[TLocFlags](int32(decodeVInt(b.s, b.pos))) - else: - loc.flags = {} - if b.s[b.pos] == '^': - inc(b.pos) - loc.lode = decodeNode(g, b, info) - # rrGetType(b, decodeVInt(b.s, b.pos), info) - else: - loc.lode = nil - if b.s[b.pos] == '!': - inc(b.pos) - loc.r = rope(decodeStr(b.s, b.pos)) - else: - loc.r = nil - if b.s[b.pos] == '>': inc(b.pos) - else: internalError(g.config, info, "decodeLoc " & b.s[b.pos]) - -proc loadBlob(g; query: SqlQuery; id: int): BlobReader = - let blob = db.getValue(query, id) - if blob.len == 0: - internalError(g.config, "symbolfiles: cannot find ID " & $ id) - result = BlobReader(pos: 0) - shallowCopy(result.s, blob) - # ensure we can read without index checks: - result.s.add '\0' - -proc loadType(g; id: int; info: TLineInfo): PType = - result = g.incr.r.types.getOrDefault(id) - if result != nil: return result - var b = loadBlob(g, sql"select data from types where nimid = ?", id) - - if b.s[b.pos] == '[': - inc(b.pos) - if b.s[b.pos] == ']': - inc(b.pos) - return # nil type - new(result) - result.kind = TTypeKind(decodeVInt(b.s, b.pos)) - if b.s[b.pos] == '+': - inc(b.pos) - result.id = decodeVInt(b.s, b.pos) - setId(result.id) - #if debugIds: registerID(result) - else: - internalError(g.config, info, "decodeType: no id") - # here this also avoids endless recursion for recursive type - g.incr.r.types.add(result.id, result) - if b.s[b.pos] == '(': result.n = decodeNode(g, b, unknownLineInfo()) - if b.s[b.pos] == '$': - inc(b.pos) - result.flags = cast[TTypeFlags](int32(decodeVInt(b.s, b.pos))) - if b.s[b.pos] == '?': - inc(b.pos) - result.callConv = TCallingConvention(decodeVInt(b.s, b.pos)) - if b.s[b.pos] == '*': - inc(b.pos) - result.owner = loadSym(g, decodeVInt(b.s, b.pos), info) - if b.s[b.pos] == '&': - inc(b.pos) - result.sym = loadSym(g, decodeVInt(b.s, b.pos), info) - if b.s[b.pos] == '/': - inc(b.pos) - result.size = decodeVInt(b.s, b.pos) - else: - result.size = -1 - if b.s[b.pos] == '=': - inc(b.pos) - result.align = decodeVInt(b.s, b.pos).int16 - else: - result.align = 2 - - if b.s[b.pos] == '\14': - inc(b.pos) - result.lockLevel = decodeVInt(b.s, b.pos).TLockLevel - else: - result.lockLevel = UnspecifiedLockLevel - - if b.s[b.pos] == '\15': - inc(b.pos) - result.destructor = loadSym(g, decodeVInt(b.s, b.pos), info) - if b.s[b.pos] == '\16': - inc(b.pos) - result.deepCopy = loadSym(g, decodeVInt(b.s, b.pos), info) - if b.s[b.pos] == '\17': - inc(b.pos) - result.assignment = loadSym(g, decodeVInt(b.s, b.pos), info) - if b.s[b.pos] == '\18': - inc(b.pos) - result.sink = loadSym(g, decodeVInt(b.s, b.pos), info) - while b.s[b.pos] == '\19': - inc(b.pos) - let x = decodeVInt(b.s, b.pos) - doAssert b.s[b.pos] == '\20' - inc(b.pos) - let y = loadSym(g, decodeVInt(b.s, b.pos), info) - result.methods.safeAdd((x, y)) - decodeLoc(g, b, result.loc, info) - while b.s[b.pos] == '^': - inc(b.pos) - if b.s[b.pos] == '(': - inc(b.pos) - if b.s[b.pos] == ')': inc(b.pos) - else: internalError(g.config, info, "decodeType ^(" & b.s[b.pos]) - rawAddSon(result, nil) - else: - let d = decodeVInt(b.s, b.pos) - rawAddSon(result, loadType(g, d, info)) - -proc decodeLib(g; b; info: TLineInfo): PLib = - result = nil - if b.s[b.pos] == '|': - new(result) - inc(b.pos) - result.kind = TLibKind(decodeVInt(b.s, b.pos)) - if b.s[b.pos] != '|': internalError(g.config, "decodeLib: 1") - inc(b.pos) - result.name = rope(decodeStr(b.s, b.pos)) - if b.s[b.pos] != '|': internalError(g.config, "decodeLib: 2") - inc(b.pos) - result.path = decodeNode(g, b, info) - -proc decodeInstantiations(g; b; info: TLineInfo; - s: var seq[PInstantiation]) = - while b.s[b.pos] == '\15': - inc(b.pos) - var ii: PInstantiation - new ii - ii.sym = loadSym(g, decodeVInt(b.s, b.pos), info) - ii.concreteTypes = @[] - while b.s[b.pos] == '\17': - inc(b.pos) - ii.concreteTypes.add loadType(g, decodeVInt(b.s, b.pos), info) - if b.s[b.pos] == '\20': - inc(b.pos) - ii.compilesId = decodeVInt(b.s, b.pos) - s.safeAdd ii - -proc loadSymFromBlob(g; b; info: TLineInfo): PSym = - if b.s[b.pos] == '{': - inc(b.pos) - if b.s[b.pos] == '}': - inc(b.pos) - return # nil sym - var k = TSymKind(decodeVInt(b.s, b.pos)) - var id: int - if b.s[b.pos] == '+': - inc(b.pos) - id = decodeVInt(b.s, b.pos) - setId(id) - else: - internalError(g.config, info, "decodeSym: no id") - var ident: PIdent - if b.s[b.pos] == '&': - inc(b.pos) - ident = g.cache.getIdent(decodeStr(b.s, b.pos)) - else: - internalError(g.config, info, "decodeSym: no ident") - #echo "decoding: {", ident.s - new(result) - result.id = id - result.kind = k - result.name = ident # read the rest of the symbol description: - g.incr.r.syms.add(result.id, result) - if b.s[b.pos] == '^': - inc(b.pos) - result.typ = loadType(g, decodeVInt(b.s, b.pos), info) - decodeLineInfo(g, b, result.info) - if b.s[b.pos] == '*': - inc(b.pos) - result.owner = loadSym(g, decodeVInt(b.s, b.pos), result.info) - if b.s[b.pos] == '$': - inc(b.pos) - result.flags = cast[TSymFlags](int32(decodeVInt(b.s, b.pos))) - if b.s[b.pos] == '@': - inc(b.pos) - result.magic = TMagic(decodeVInt(b.s, b.pos)) - if b.s[b.pos] == '!': - inc(b.pos) - result.options = cast[TOptions](int32(decodeVInt(b.s, b.pos))) - if b.s[b.pos] == '%': - inc(b.pos) - result.position = decodeVInt(b.s, b.pos) - if b.s[b.pos] == '`': - inc(b.pos) - result.offset = decodeVInt(b.s, b.pos) - else: - result.offset = -1 - decodeLoc(g, b, result.loc, result.info) - result.annex = decodeLib(g, b, info) - if b.s[b.pos] == '#': - inc(b.pos) - result.constraint = decodeNode(g, b, unknownLineInfo()) - case result.kind - of skType, skGenericParam: - while b.s[b.pos] == '\14': - inc(b.pos) - result.typeInstCache.safeAdd loadType(g, decodeVInt(b.s, b.pos), result.info) - of routineKinds: - decodeInstantiations(g, b, result.info, result.procInstCache) - if b.s[b.pos] == '\16': - inc(b.pos) - result.gcUnsafetyReason = loadSym(g, decodeVInt(b.s, b.pos), result.info) - of skModule, skPackage: - decodeInstantiations(g, b, result.info, result.usedGenerics) - of skLet, skVar, skField, skForVar: - if b.s[b.pos] == '\18': - inc(b.pos) - result.guard = loadSym(g, decodeVInt(b.s, b.pos), result.info) - if b.s[b.pos] == '\19': - inc(b.pos) - result.bitsize = decodeVInt(b.s, b.pos).int16 - else: discard - - if b.s[b.pos] == '(': - #if result.kind in routineKinds: - # result.ast = decodeNodeLazyBody(b, result.info, result) - #else: - result.ast = decodeNode(g, b, result.info) - if sfCompilerProc in result.flags: - registerCompilerProc(g, result) - #echo "loading ", result.name.s - -proc loadSym(g; id: int; info: TLineInfo): PSym = - result = g.incr.r.syms.getOrDefault(id) - if result != nil: return result - var b = loadBlob(g, sql"select data from syms where nimid = ?", id) - result = loadSymFromBlob(g, b, info) - doAssert id == result.id, "symbol ID is not consistent!" - -proc loadModuleSymTab(g; module: PSym) = - ## goal: fill module.tab - g.incr.r.syms.add(module.id, module) - for row in db.fastRows(sql"select nimid, data from syms where module = ? and exported = 1", abs(module.id)): - let id = parseInt(row[0]) - var s = g.incr.r.syms.getOrDefault(id) - if s == nil: - var b = BlobReader(pos: 0) - shallowCopy(b.s, row[1]) - # ensure we can read without index checks: - b.s.add '\0' - s = loadSymFromBlob(g, b, module.info) - assert s != nil - strTableAdd(module.tab, s) - if sfSystemModule in module.flags: - g.systemModule = module - -proc replay(g: ModuleGraph; module: PSym; n: PNode) = - # XXX check if we need to replay nkStaticStmt here. - case n.kind - #of nkStaticStmt: - #evalStaticStmt(module, g, n[0], module) - #of nkVarSection, nkLetSection: - # nkVarSections are already covered by the vmgen which produces nkStaticStmt - of nkMethodDef: - methodDef(g, n[namePos].sym, fromCache=true) - of nkCommentStmt: - # pragmas are complex and can be user-overriden via templates. So - # instead of using the original ``nkPragma`` nodes, we rely on the - # fact that pragmas.nim was patched to produce specialized recorded - # statements for us in the form of ``nkCommentStmt`` with (key, value) - # pairs. Ordinary nkCommentStmt nodes never have children so this is - # not ambiguous. - # Fortunately only a tiny subset of the available pragmas need to - # be replayed here. This is always a subset of ``pragmas.stmtPragmas``. - if n.len >= 2: - internalAssert g.config, n[0].kind == nkStrLit and n[1].kind == nkStrLit - case n[0].strVal - of "hint": message(g.config, n.info, hintUser, n[1].strVal) - of "warning": message(g.config, n.info, warnUser, n[1].strVal) - of "error": localError(g.config, n.info, errUser, n[1].strVal) - of "compile": - internalAssert g.config, n.len == 3 and n[2].kind == nkStrLit - var cf = Cfile(cname: n[1].strVal, obj: n[2].strVal, - flags: {CfileFlag.External}) - extccomp.addExternalFileToCompile(g.config, cf) - of "link": - extccomp.addExternalFileToLink(g.config, n[1].strVal) - of "passl": - extccomp.addLinkOption(g.config, n[1].strVal) - of "passc": - extccomp.addCompileOption(g.config, n[1].strVal) - of "cppdefine": - options.cppDefine(g.config, n[1].strVal) - of "inc": - let destKey = n[1].strVal - let by = n[2].intVal - let v = getOrDefault(g.cacheCounters, destKey) - g.cacheCounters[destKey] = v+by - of "put": - let destKey = n[1].strVal - let key = n[2].strVal - let val = n[3] - if not contains(g.cacheTables, destKey): - g.cacheTables[destKey] = initBTree[string, PNode]() - if not contains(g.cacheTables[destKey], key): - g.cacheTables[destKey].add(key, val) - else: - internalError(g.config, n.info, "key already exists: " & key) - of "incl": - let destKey = n[1].strVal - let val = n[2] - if not contains(g.cacheSeqs, destKey): - g.cacheSeqs[destKey] = newTree(nkStmtList, val) - else: - block search: - for existing in g.cacheSeqs[destKey]: - if exprStructuralEquivalent(existing, val, strictSymEquality=true): - break search - g.cacheSeqs[destKey].add val - of "add": - let destKey = n[1].strVal - let val = n[2] - if not contains(g.cacheSeqs, destKey): - g.cacheSeqs[destKey] = newTree(nkStmtList, val) - else: - g.cacheSeqs[destKey].add val - else: - internalAssert g.config, false - of nkImportStmt: - for x in n: - internalAssert g.config, x.kind == nkStrLit - let imported = g.importModuleCallback(g, module, fileInfoIdx(g.config, n[0].strVal)) - internalAssert g.config, imported.id < 0 - of nkStmtList, nkStmtListExpr: - for x in n: replay(g, module, x) - else: discard "nothing to do for this node" - -proc loadNode*(g: ModuleGraph; module: PSym): PNode = - loadModuleSymTab(g, module) - result = newNodeI(nkStmtList, module.info) - for row in db.rows(sql"select data from toplevelstmts where module = ? order by position asc", - abs module.id): - - var b = BlobReader(pos: 0) - # ensure we can read without index checks: - b.s = row[0] & '\0' - result.add decodeNode(g, b, module.info) - - db.exec(sql"insert into controlblock(idgen) values (?)", gFrontEndId) - replay(g, module, result) - -proc setupModuleCache*(g: ModuleGraph) = - if g.config.symbolFiles == disabledSf: return - g.recordStmt = recordStmt - let dbfile = getNimcacheDir(g.config) / "rodfiles.db" - if g.config.symbolFiles == writeOnlySf: - removeFile(dbfile) - if not fileExists(dbfile): - db = open(connection=dbfile, user="nim", password="", - database="nim") - createDb(db) - db.exec(sql"insert into config(config) values (?)", encodeConfig(g)) - else: - db = open(connection=dbfile, user="nim", password="", - database="nim") - let oldConfig = db.getValue(sql"select config from config") - g.incr.configChanged = oldConfig != encodeConfig(g) - db.exec(sql"pragma journal_mode=off") - db.exec(sql"pragma SYNCHRONOUS=off") - db.exec(sql"pragma LOCKING_MODE=exclusive") - let lastId = db.getValue(sql"select max(idgen) from controlblock") - if lastId.len > 0: - idgen.setId(parseInt lastId) diff --git a/compiler/rodutils.nim b/compiler/rodutils.nim index 66d7f63c2..5355829c1 100644 --- a/compiler/rodutils.nim +++ b/compiler/rodutils.nim @@ -8,14 +8,50 @@ # ## Serialization utilities for the compiler. -import strutils, math - -proc c_snprintf(s: cstring; n:uint; frmt: cstring): cint {.importc: "snprintf", header: "<stdio.h>", nodecl, varargs.} - -proc toStrMaxPrecision*(f: BiggestFloat, literalPostfix = ""): string = +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 + #include <stdarg.h> + static int c99_vsnprintf(char *outBuf, size_t size, const char *format, va_list ap) { + int count = -1; + if (size != 0) count = _vsnprintf_s(outBuf, size, _TRUNCATE, format, ap); + if (count == -1) count = _vscprintf(format, ap); + return count; + } + int snprintf(char *outBuf, size_t size, const char *format, ...) { + int count; + va_list ap; + va_start(ap, format); + count = c99_vsnprintf(outBuf, size, format, ap); + va_end(ap); + return count; + } + #endif + """.} + +proc c_snprintf(s: cstring; n: uint; frmt: cstring): cint {.importc: "snprintf", header: "<stdio.h>", nodecl, varargs.} + + +when not declared(signbit): + proc c_signbit(x: SomeFloat): cint {.importc: "signbit", header: "<math.h>".} + proc signbit*(x: SomeFloat): bool {.inline.} = + result = c_signbit(x) != 0 + +import std/formatfloat + +proc toStrMaxPrecision*(f: BiggestFloat | float32): string = + const literalPostfix = when f is float32: "f" else: "" case classify(f) - of fcNaN: - result = "NAN" + of fcNan: + if signbit(f): + result = "-NAN" + else: + result = "NAN" of fcNegZero: result = "-0.0" & literalPostfix of fcZero: @@ -25,20 +61,15 @@ proc toStrMaxPrecision*(f: BiggestFloat, literalPostfix = ""): string = of fcNegInf: result = "-INF" else: - when defined(nimNoArrayToCstringConversion): - result = newString(81) - let n = c_snprintf(result.cstring, result.len.uint, "%#.16e%s", f, literalPostfix.cstring) - setLen(result, n) - else: - var buf: array[0..80, char] - discard c_snprintf(buf.cstring, buf.len.uint, "%#.16e%s", f, literalPostfix.cstring) - result = $buf.cstring + result = "" + result.addFloatRoundtrip(f) + result.add literalPostfix proc encodeStr*(s: string, result: var string) = - for i in countup(0, len(s) - 1): + for i in 0..<s.len: case s[i] - of 'a'..'z', 'A'..'Z', '0'..'9', '_': add(result, s[i]) - else: add(result, '\\' & toHex(ord(s[i]), 2)) + of 'a'..'z', 'A'..'Z', '0'..'9', '_': result.add(s[i]) + else: result.add('\\' & toHex(ord(s[i]), 2)) proc hexChar(c: char, xi: var int) = case c @@ -57,30 +88,28 @@ proc decodeStr*(s: cstring, pos: var int): string = var xi = 0 hexChar(s[i-2], xi) hexChar(s[i-1], xi) - add(result, chr(xi)) + result.add(chr(xi)) of 'a'..'z', 'A'..'Z', '0'..'9', '_': - add(result, s[i]) + result.add(s[i]) inc(i) else: break pos = i -const - chars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" +const chars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" {.push overflowChecks: off.} # since negative numbers require a leading '-' they use up 1 byte. Thus we # subtract/add `vintDelta` here to save space for small negative numbers # which are common in ROD files: -const - vintDelta = 5 +const vintDelta = 5 template encodeIntImpl(self) = var d: char var v = x var rem = v mod 190 if rem < 0: - add(result, '-') + result.add('-') v = - (v div 190) rem = - rem else: @@ -89,7 +118,7 @@ template encodeIntImpl(self) = if idx < 62: d = chars[idx] else: d = chr(idx - 62 + 128) if v != 0: self(v, result) - add(result, d) + result.add(d) proc encodeVBiggestIntAux(x: BiggestInt, result: var string) = ## encode a biggest int as a variable length base 190 int. diff --git a/compiler/ropes.nim b/compiler/ropes.nim index 973f16916..e0d5aa0d3 100644 --- a/compiler/ropes.nim +++ b/compiler/ropes.nim @@ -7,229 +7,66 @@ # 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. +# Ropes for the C code generator. Ropes are mapped to `string` directly nowadays. -import - hashes +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 - length*: int - data*: string # != nil if a leaf - -proc len*(a: Rope): int = - ## the rope's length - if a == nil: result = 0 - else: result = a.length + Rope* = string -proc newRope(data: string = nil): Rope = - new(result) - if data != nil: - result.length = len(data) - result.data = data +proc newRopeAppender*(cap = 80): string {.inline.} = + result = newStringOfCap(cap) -proc newMutableRope*(capacity = 30): Rope = - ## creates a new rope that supports direct modifications of the rope's - ## 'data' and 'length' fields. - new(result) - result.data = newStringOfCap(capacity) +proc freeze*(r: Rope) {.inline.} = discard -proc freezeMutableRope*(r: Rope) {.inline.} = - r.length = r.data.len +proc resetRopeCache* = discard -var - cache: array[0..2048*2 - 1, Rope] # XXX Global here! - -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 insertInCache(s: string): Rope = - 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 - -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.length = a.length + b.length - 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 countup(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: string): bool = - var f: File - if open(f, filename, fmWrite): - if head != nil: writeRope(f, head) +proc writeRope*(head: Rope, filename: AbsoluteFile): bool = + var f: File = default(File) + if open(f, filename.string, fmWrite): + 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): add(result, s) - -proc ropeConcat*(a: varargs[Rope]): Rope = - # not overloaded version of concat to speed-up `rfmt` a little bit - for i in countup(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 `%`*(frmt: FormatStr, args: openArray[Rope]): Rope = +proc runtimeFormat*(frmt: FormatStr, args: openArray[Rope]): Rope = var i = 0 - var length = len(frmt) - result = nil + result = newRopeAppender() var num = 0 - while i < length: + while i < frmt.len: if frmt[i] == '$': inc(i) # skip '$' case frmt[i] of '$': - add(result, "$") + result.add("$") inc(i) of '#': inc(i) - add(result, args[num]) + result.add(args[num]) inc(num) of '0'..'9': var j = 0 @@ -239,9 +76,9 @@ proc `%`*(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: - add(result, args[j-1]) + result.add(args[j-1]) of '{': inc(i) var j = 0 @@ -251,60 +88,47 @@ proc `%`*(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: - add(result, args[j-1]) + result.add(args[j-1]) of 'n': - add(result, "\n") + result.add("\n") inc(i) of 'N': - add(result, "\n") + result.add("\n") inc(i) else: - doAssert false, "invalid format string: " & frmt - var start = i - while i < length: - if frmt[i] != '$': inc(i) - else: break - if i - 1 >= start: - add(result, substr(frmt, start, i - 1)) - assert(ropeInvariant(result)) + raiseAssert "invalid format string: " & frmt + else: + result.add(frmt[i]) + inc(i) -proc addf*(c: var Rope, frmt: FormatStr, args: openArray[Rope]) = - ## shortcut for ``add(c, frmt % args)``. - add(c, frmt % args) +proc `%`*(frmt: static[FormatStr], args: openArray[Rope]): Rope = + runtimeFormat(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.} +template addf*(c: var Rope, frmt: FormatStr, args: openArray[Rope]) = + ## shortcut for ``add(c, frmt % args)``. + c.add(frmt % args) 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 - let slen = s.len - rtotal += slen - while spos < slen: + rtotal += s.len + while spos < s.len: if bpos == blen: # Read more data bpos = 0 @@ -313,7 +137,7 @@ proc equalsFile*(r: Rope, f: File): bool = if blen == 0: # no more data in file result = false return - let n = min(blen - bpos, slen - spos) + let n = min(blen - bpos, s.len - spos) # TODO There's gotta be a better way of comparing here... if not equalMem(addr(buf[bpos]), cast[pointer](cast[int](cstring(s))+spos), n): result = false @@ -324,18 +148,11 @@ proc equalsFile*(r: Rope, f: File): bool = result = readBuffer(f, addr(buf[0]), 1) == 0 and btotal == rtotal # check that we've read all -proc equalsFile*(r: Rope, filename: string): 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 - result = open(f, filename) + var f: File = default(File) + result = open(f, filename.string) if result: result = equalsFile(r, f) close(f) - -proc writeRopeIfNotEqual*(r: Rope, filename: string): bool = - # returns true if overwritten - if not equalsFile(r, filename): - result = writeRope(r, filename) - else: - result = false diff --git a/compiler/saturate.nim b/compiler/saturate.nim index 065cb5128..fe6e03c8b 100644 --- a/compiler/saturate.nim +++ b/compiler/saturate.nim @@ -15,33 +15,33 @@ proc `|+|`*(a, b: BiggestInt): BiggestInt = if (result xor a) >= 0'i64 or (result xor b) >= 0'i64: return result if a < 0 or b < 0: - result = low(result) + result = low(typeof(result)) else: - result = high(result) + result = high(typeof(result)) proc `|-|`*(a, b: BiggestInt): BiggestInt = result = a -% b if (result xor a) >= 0'i64 or (result xor not b) >= 0'i64: return result if b > 0: - result = low(result) + result = low(typeof(result)) else: - result = high(result) + result = high(typeof(result)) proc `|abs|`*(a: BiggestInt): BiggestInt = - if a != low(a): + if a != low(typeof(a)): if a >= 0: result = a else: result = -a else: - result = low(a) + result = low(typeof(a)) proc `|div|`*(a, b: BiggestInt): BiggestInt = - # (0..5) div (0..4) == (0..5) div (1..4) == (0 div 4) .. (5 div 1) + # (0..5) div (0..4) == (0..5) div (1..4) == (0 div 4)..(5 div 1) if b == 0'i64: # make the same as ``div 1``: result = a - elif a == low(a) and b == -1'i64: - result = high(result) + elif a == low(typeof(a)) and b == -1'i64: + result = high(typeof(result)) else: result = a div b @@ -74,6 +74,6 @@ proc `|*|`*(a, b: BiggestInt): BiggestInt = return result if floatProd >= 0.0: - result = high(result) + result = high(typeof(result)) else: - result = low(result) + result = low(typeof(result)) diff --git a/compiler/scriptconfig.nim b/compiler/scriptconfig.nim index ae7e030b8..e3d2bcd45 100644 --- a/compiler/scriptconfig.nim +++ b/compiler/scriptconfig.nim @@ -11,12 +11,18 @@ ## language. import - ast, modules, idents, passes, passaux, condsyms, - options, nimconf, sem, semdata, llstream, vm, vmdef, commands, msgs, - os, times, osproc, wordrecg, strtabs, modulegraphs, lineinfos + 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) @@ -26,9 +32,9 @@ proc listDirs(a: VmArgs, filter: set[PathComponent]) = setResult(a, result) proc setupVM*(module: PSym; cache: IdentCache; scriptName: string; - graph: ModuleGraph): PEvalContext = + graph: ModuleGraph; idgen: IdGenerator): PEvalContext = # For Nimble we need to export 'setupVM'. - result = newCtx(module, cache, graph) + result = newCtx(module, cache, graph, idgen) result.mode = emRepl registerAdditionalOps(result) let conf = graph.config @@ -42,48 +48,74 @@ proc setupVM*(module: PSym; cache: IdentCache; scriptName: string; proc (a: VmArgs) = body - template cbos(name, body) {.dirty.} = + template cbexc(name, exc, body) {.dirty.} = result.registerCallback "stdlib.system." & astToStr(name), proc (a: VmArgs) = - errorMsg = nil + errorMsg = "" try: body - except OSError: + except exc: errorMsg = getCurrentExceptionMsg() + template cbos(name, body) {.dirty.} = + cbexc(name, OSError, body) + # Idea: Treat link to file as a file, but ignore link to directory to prevent # endless recursions out of the box. - cbos listFiles: + cbos listFilesImpl: listDirs(a, {pcFile, pcLinkToFile}) - cbos listDirs: + cbos listDirsImpl: listDirs(a, {pcDir}) cbos removeDir: - os.removeDir getString(a, 0) + if defined(nimsuggest) or graph.config.cmd == cmdCheck: + discard + else: + os.removeDir(getString(a, 0), getBool(a, 1)) cbos removeFile: - os.removeFile getString(a, 0) + if defined(nimsuggest) or graph.config.cmd == cmdCheck: + discard + else: + os.removeFile getString(a, 0) cbos createDir: os.createDir getString(a, 0) - cbos getOsError: - setResult(a, errorMsg) + + result.registerCallback "stdlib.system.getError", + proc (a: VmArgs) = setResult(a, errorMsg) + cbos setCurrentDir: os.setCurrentDir getString(a, 0) cbos getCurrentDir: setResult(a, os.getCurrentDir()) cbos moveFile: - os.moveFile(getString(a, 0), getString(a, 1)) + if defined(nimsuggest) or graph.config.cmd == cmdCheck: + discard + else: + os.moveFile(getString(a, 0), getString(a, 1)) cbos moveDir: - os.moveDir(getString(a, 0), getString(a, 1)) + if defined(nimsuggest) or graph.config.cmd == cmdCheck: + discard + else: + os.moveDir(getString(a, 0), getString(a, 1)) cbos copyFile: - os.copyFile(getString(a, 0), getString(a, 1)) + if defined(nimsuggest) or graph.config.cmd == cmdCheck: + discard + else: + os.copyFile(getString(a, 0), getString(a, 1)) cbos copyDir: - os.copyDir(getString(a, 0), getString(a, 1)) + if defined(nimsuggest) or graph.config.cmd == cmdCheck: + discard + else: + os.copyDir(getString(a, 0), getString(a, 1)) cbos getLastModificationTime: setResult(a, getLastModificationTime(getString(a, 0)).toUnix) cbos findExe: setResult(a, os.findExe(getString(a, 0))) cbos rawExec: - setResult(a, osproc.execCmd getString(a, 0)) + if defined(nimsuggest) or graph.config.cmd == cmdCheck: + discard + else: + setResult(a, osproc.execCmd getString(a, 0)) cbconf getEnv: setResult(a, os.getEnv(a.getString 0, a.getString 1)) @@ -91,11 +123,19 @@ proc setupVM*(module: PSym; cache: IdentCache; scriptName: string; setResult(a, os.existsEnv(a.getString 0)) cbconf putEnv: os.putEnv(a.getString 0, a.getString 1) + cbconf delEnv: + os.delEnv(a.getString 0) cbconf dirExists: setResult(a, os.dirExists(a.getString 0)) cbconf fileExists: setResult(a, os.fileExists(a.getString 0)) + cbconf projectName: + setResult(a, conf.projectName) + cbconf projectDir: + setResult(a, conf.projectPath.string) + cbconf projectPath: + setResult(a, conf.projectFull.string) cbconf thisDir: setResult(a, vthisDir) cbconf put: @@ -105,7 +145,7 @@ proc setupVM*(module: PSym; cache: IdentCache; scriptName: string; cbconf exists: setResult(a, options.existsConfigVar(conf, a.getString 0)) cbconf nimcacheDir: - setResult(a, options.getNimcacheDir(conf)) + setResult(a, options.getNimcacheDir(conf).string) cbconf paramStr: setResult(a, os.paramStr(int a.getInt 0)) cbconf paramCount: @@ -115,20 +155,14 @@ proc setupVM*(module: PSym; cache: IdentCache; scriptName: string; cbconf cmpIgnoreCase: setResult(a, strutils.cmpIgnoreCase(a.getString 0, a.getString 1)) cbconf setCommand: - conf.command = a.getString 0 + conf.setCommandEarly(a.getString 0) let arg = a.getString 1 - if arg.len > 0: - conf.projectName = arg - let path = - if conf.projectName.isAbsolute: conf.projectName - else: conf.projectPath / conf.projectName - try: - conf.projectFull = canonicalizePath(conf, path) - except OSError: - conf.projectFull = path + incl(conf.globalOptions, optWasNimscript) + 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, @@ -148,28 +182,68 @@ proc setupVM*(module: PSym; cache: IdentCache; scriptName: string; setResult(a, os.getAppFilename()) cbconf cppDefine: options.cppDefine(conf, a.getString(0)) - -proc runNimScript*(cache: IdentCache; scriptName: string; - freshDefines=true; conf: ConfigRef) = - rawMessage(conf, hintConf, scriptName) + cbexc stdinReadLine, EOFError: + if defined(nimsuggest) or graph.config.cmd == cmdCheck: + setResult(a, "") + else: + setResult(a, stdin.readLine()) + cbexc stdinReadAll, EOFError: + if defined(nimsuggest) or graph.config.cmd == cmdCheck: + setResult(a, "") + else: + setResult(a, stdin.readAll()) + +proc runNimScript*(cache: IdentCache; scriptName: AbsoluteFile; + idgen: IdGenerator; + freshDefines=true; conf: ConfigRef, stream: PLLStream) = + let oldSymbolFiles = conf.symbolFiles + 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 + unregisterArcOrc(conf) + conf.globalOptions.excl optOwnedRefs + conf.selectedGC = gcUnselected + var m = graph.makeModule(scriptName) incl(m.flags, sfMainModule) - graph.vm = setupVM(m, cache, scriptName, graph) - - graph.compileSystemModule() - discard graph.processModule(m, llStreamOpen(scriptName, fmRead)) + var vm = setupVM(m, cache, scriptName.string, graph, idgen) + graph.vm = vm + + 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: + if conf.selectedGC == gcUnselected: + conf.selectedGC = oldSelectedGC + if optOwnedRefs in oldGlobalOptions: + conf.globalOptions.incl {optTinyRtti, optOwnedRefs, optSeqDestructors} + defineSymbol(conf.symbols, "nimv2") + 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) @@ -177,3 +251,4 @@ proc runNimScript*(cache: IdentCache; scriptName: string; #initDefines() undefSymbol(conf.symbols, "nimscript") undefSymbol(conf.symbols, "nimconfig") + conf.symbolFiles = oldSymbolFiles diff --git a/compiler/sem.nim b/compiler/sem.nim index 3b16e0938..2cf93d365 100644 --- a/compiler/sem.nim +++ b/compiler/sem.nim @@ -10,34 +10,41 @@ # This module implements the semantic checking pass. import - ast, strutils, hashes, options, lexer, astalgo, trees, treetab, - wordrecg, ropes, msgs, os, condsyms, idents, renderer, types, platform, math, - magicsys, parser, nversion, nimsets, semfold, modulepaths, importer, - procfind, lookups, pragmas, passes, semdata, semtypinst, sigmatch, - intsets, transf, vmdef, vm, idgen, aliases, cgmeth, lambdalifting, + ast, options, astalgo, trees, + wordrecg, ropes, msgs, idents, renderer, types, platform, + magicsys, nversion, nimsets, semfold, modulepaths, importer, + procfind, lookups, pragmas, semdata, semtypinst, sigmatch, + transf, vmdef, vm, aliases, cgmeth, lambdalifting, evaltempl, patterns, parampatterns, sempass2, linter, semmacrosanity, - semparallel, lowerings, pluginsupport, plugins.active, rod, lineinfos + lowerings, plugins/active, lineinfos, int128, + isolation_check, typeallowed, modulegraphs, enumtostr, concepts, astmsgs, + extccomp -from modulegraphs import ModuleGraph +import vtables +import std/[strtabs, math, tables, intsets, strutils, packedsets] -when defined(nimfix): - import nimfix.prettybase +when not defined(leanCompiler): + import spawn + +when defined(nimPreviewSlimSystem): + import std/[ + formatfloat, + assertions, + ] # implementation -proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode {.procvar.} -proc semExprWithType(c: PContext, n: PNode, flags: TExprFlags = {}): PNode {. - procvar.} +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) -proc semLambda(c: PContext, n: PNode, flags: TExprFlags): PNode proc semTypeNode(c: PContext, n: PNode, prev: PType): PType -proc semStmt(c: PContext, n: PNode): PNode +proc semStmt(c: PContext, n: PNode; flags: TExprFlags): PNode proc semOpAux(c: PContext, n: PNode) proc semParamList(c: PContext, n, genericParams: PNode, s: PSym) proc addParams(c: PContext, n: PNode, kind: TSymKind) @@ -48,7 +55,12 @@ 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; 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 +proc defaultConstructionError(c: PContext, t: PType, info: TLineInfo) +proc hasUnresolvedArgs(c: PContext, n: PNode): bool proc isArrayConstr(n: PNode): bool {.inline.} = result = n.kind == nkBracket and n.typ.skipTypes(abstractInst).kind == tyArray @@ -70,6 +82,15 @@ template semIdeForTemplateOrGeneric(c: PContext; n: PNode; # echo "passing to safeSemExpr: ", renderTree(n) discard safeSemExpr(c, n) +proc fitNodePostMatch(c: PContext, formal: PType, arg: PNode): PNode = + let x = arg.skipConv + 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) + + proc fitNode(c: PContext, formal: PType, arg: PNode; info: TLineInfo): PNode = if arg.typ.isNil: localError(c.config, arg.info, "expression has no type: " & @@ -77,28 +98,39 @@ 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: - typeMismatch(c.config, info, formal, arg.typ) + typeMismatch(c.config, info, formal, arg.typ, arg) # error correction: result = copyTree(arg) result.typ = formal else: - let x = result.skipConv - if x.kind in {nkPar, nkTupleConstr} and formal.kind != tyExpr: - changeType(c, x, formal, check=true) - else: - result = skipHiddenSubConv(result) - #result.typ = takeType(formal, arg.typ) - #echo arg.info, " picked ", result.typ.typeToString + 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 -template commonTypeBegin*(): PType = PType(kind: tyExpr) +template commonTypeBegin*(): PType = PType(kind: tyUntyped) -proc commonType*(x, y: PType): PType = +proc commonType*(c: PContext; x, y: PType): PType = # new type relation that is used for array constructors, # if expressions, etc.: if x == nil: return x @@ -106,40 +138,43 @@ proc commonType*(x, y: PType): PType = var a = skipTypes(x, {tyGenericInst, tyAlias, tySink}) var b = skipTypes(y, {tyGenericInst, tyAlias, tySink}) result = x - if a.kind in {tyExpr, tyNil}: result = y - elif b.kind in {tyExpr, tyNil}: result = x - elif a.kind == tyStmt: result = a - elif b.kind == tyStmt: result = b + if a.kind in {tyUntyped, tyNil}: result = y + elif b.kind in {tyUntyped, tyNil}: result = x + elif a.kind == tyTyped: result = a + elif b.kind == tyTyped: result = b elif a.kind == tyTypeDesc: # turn any concrete typedesc into the abstract typedesc type - if a.sons == nil: result = a + if not a.hasElementType: result = a else: - result = newType(tyTypeDesc, a.owner) - rawAddSon(result, newType(tyNone, 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.sons[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.sons[i]) - let bEmpty = isEmptyContainer(b.sons[i]) + if a[idx].kind == tyEmpty: return y + 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, a.owner, false) - nt.sons[i] = if aEmpty: b.sons[i] else: a.sons[i] + if nt.isNil: + nt = copyType(a, c.idgen, a.owner) + copyTypeProps(c.graph, c.idgen.module, nt, a) + + nt[i] = if aEmpty: bb else: aa if not nt.isNil: result = nt - #elif b.sons[idx].kind == tyEmpty: return x + #elif b[idx].kind == tyEmpty: return x elif a.kind == tyRange and b.kind == tyRange: # consider: (range[0..3], range[0..4]) here. We should make that # range[0..4]. But then why is (range[0..4], 6) not range[0..6]? # But then why is (2,4) not range[2..4]? But I think this would break # too much code. So ... it's the same range or the base type. This means - # type(if b: 0 else 1) == int and not range[0..1]. For now. In the long + # typeof(if b: 0 else 1) == int and not range[0..1]. For now. In the long # run people expect ranges to work properly within a tuple. if not sameType(a, b): - result = skipTypes(a, {tyRange}).skipIntLit + result = skipTypes(a, {tyRange}).skipIntLit(c.idgen) when false: if a.kind != tyRange and b.kind == tyRange: # XXX This really needs a better solution, but a proper fix now breaks @@ -149,14 +184,20 @@ proc commonType*(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: @@ -166,48 +207,55 @@ proc commonType*(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, r.owner) - result.addSonSkipIntLit(r) - -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 == nkRaiseStmt or - it.kind in nkCallKinds and it[0].kind == nkSym and sfNoReturn in it[0].sym.flags - -proc commonType*(x: PType, y: PNode): PType = + result = newType(k, c.idgen, r.owner) + result.addSonSkipIntLit(r, c.idgen) + +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 if endsInNoReturn(y): return x - commonType(x, y.typ) + commonType(c, x, y.typ) proc newSymS(kind: TSymKind, n: PNode, c: PContext): PSym = - result = newSym(kind, considerQuotedIdent(c, n), getCurrOwner(c), n.info) + result = newSym(kind, considerQuotedIdent(c, n), c.idgen, getCurrOwner(c), n.info) when defined(nimsuggest): suggestDecl(c, n, result) proc newSymG*(kind: TSymKind, n: PNode, c: PContext): PSym = - proc `$`(kind: TSymKind): string = substr(system.`$`(kind), 2).toLowerAscii - # like newSymS, but considers gensym'ed symbols if n.kind == nkSym: # and sfGenSym in n.sym.flags: result = n.sym - if result.kind != kind: - localError(c.config, n.info, "cannot use symbol of kind '" & - $result.kind & "' as a '" & $kind & "'") - if sfGenSym in result.flags and result.kind notin {skTemplate, skMacro, skParam}: - # declarative context, so produce a fresh gensym: - result = copySym(result) - result.ast = n.sym.ast - put(c.p, n.sym, result) + if result.kind notin {kind, skTemp}: + localError(c.config, n.info, "cannot use symbol of kind '$1' as a '$2'" % + [result.kind.toHumanStr, kind.toHumanStr]) + when false: + if sfGenSym in result.flags and result.kind notin {skTemplate, skMacro, skParam}: + # declarative context, so produce a fresh gensym: + result = copySym(result) + result.ast = n.sym.ast + put(c.p, n.sym, result) # when there is a nested proc inside a template, semtmpl # will assign a wrong owner during the first pass over the # template; we must fix it here: see #909 result.owner = getCurrOwner(c) else: - result = newSym(kind, considerQuotedIdent(c, n), 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): @@ -217,40 +265,32 @@ 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(conf: ConfigRef; info: TLineInfo; typ: PType; kind: TSymKind; +proc typeAllowedCheck(c: PContext; info: TLineInfo; typ: PType; kind: TSymKind; flags: TTypeAllowedFlags = {}) = - let t = typeAllowed(typ, kind, flags) + let t = typeAllowed(typ, kind, c, flags) if t != nil: + var err: string if t == typ: - localError(conf, info, "invalid type: '" & typeToString(typ) & - "' for " & substr($kind, 2).toLowerAscii) + err = "invalid type: '$1' for $2" % [typeToString(typ), toHumanStr(kind)] + if kind in {skVar, skLet, skConst} and taIsTemplateOrMacro in flags: + err &= ". Did you mean to call the $1 with '()'?" % [toHumanStr(typ.owner.kind)] else: - localError(conf, info, "invalid type: '" & typeToString(t) & - "' in this context: '" & typeToString(typ) & - "' for " & substr($kind, 2).toLowerAscii) + err = "invalid type: '$1' in this context: '$2' for $3" % [typeToString(t), + typeToString(typ), toHumanStr(kind)] + localError(c.config, info, err) proc paramsTypeCheck(c: PContext, typ: PType) {.inline.} = - typeAllowedCheck(c.config, typ.n.info, typ, skProc) + 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"), 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 = @@ -268,8 +308,9 @@ when false: result = isOpImpl(c, n) proc hasCycle(n: PNode): bool = + result = false incl n.flags, nfNone - for i in 0..<safeLen(n): + for i in 0..<n.safeLen: if nfNone in n[i].flags or hasCycle(n[i]): result = true break @@ -279,14 +320,13 @@ proc fixupTypeAfterEval(c: PContext, evaluated, eOrig: PNode): PNode = # recompute the types as 'eval' isn't guaranteed to construct types nor # that the types are sound: when true: - if eOrig.typ.kind in {tyExpr, tyStmt, tyTypeDesc}: + if eOrig.typ.kind in {tyUntyped, tyTyped, tyTypeDesc}: result = semExprWithType(c, evaluated) else: 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: @@ -301,11 +341,11 @@ 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.graph) + result = getConstExpr(c.module, e, c.idgen, c.graph) if result != nil: return let oldErrorCount = c.config.errorCounter @@ -313,10 +353,15 @@ proc tryConstExpr(c: PContext, n: PNode): PNode = let oldErrorOutputs = c.config.m.errorOutputs c.config.m.errorOutputs = {} - c.config.errorMax = high(int) + 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.graph, e) + result = evalConstExpr(c.module, c.idgen, c.graph, e) if result == nil or result.kind == nkEmpty: result = nil else: @@ -325,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 @@ -332,15 +381,17 @@ 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 - result = getConstExpr(c.module, e, c.graph) + 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) - result = evalConstExpr(c.module, c.graph, e) + result = evalConstExpr(c.module, c.idgen, c.graph, e) if result == nil or result.kind == nkEmpty: if e.info != n.info: pushInfoContext(c.config, n.info) @@ -353,31 +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.graph) + var evaluated = getConstExpr(c.module, result, c.idgen, c.graph) if evaluated != nil: return evaluated evaluated = evalAtCompileTime(c, result) if evaluated != nil: return evaluated +proc semGenericStmt(c: PContext, n: PNode): PNode + include hlo, seminst, semcall -when false: - # hopefully not required: - proc resetSemFlag(n: PNode) = +proc resetSemFlag(n: PNode) = + if n != nil: excl n.flags, nfSem - for i in 0 ..< n.safeLen: + 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 @@ -387,43 +439,59 @@ proc semAfterMacroCall(c: PContext, call, macroResult: PNode, if c.config.evalTemplateCounter > evalTemplateLimit: globalError(c.config, s.info, "template instantiation too nested") c.friendModules.add(s.owner.getModule) - result = macroResult - excl(result.flags, nfSem) - #resetSemFlag n - if s.typ.sons[0] == nil: - result = semStmt(c, result) + resetSemFlag result + if s.typ.returnType == nil: + result = semStmt(c, result, flags) else: - case s.typ.sons[0].kind - of tyExpr: - # BUGFIX: we cannot expect a type here, because module aliases would not - # work then (see the ``tmodulealias`` test) - # semExprWithType(c, result) - result = semExpr(c, result, flags) - of tyStmt: - result = semStmt(c, result) + var retType = s.typ.returnType + if retType.kind == tyTypeDesc and tfUnresolved in retType.flags and + retType.hasElementType: + # bug #11941: template fails(T: type X, v: auto): T + # does not mean we expect a tyTypeDesc. + retType = retType.skipModifier + case retType.kind + of tyUntyped, tyAnything: + # Not expecting a type here allows templates like in ``tmodulealias.in``. + result = semExpr(c, result, flags, expectedType) + of tyTyped: + # More restrictive version. + result = semExprWithType(c, result, flags, expectedType) of tyTypeDesc: - if result.kind == nkStmtList: result.kind = nkStmtListType + if result.kind == nkStmtList: result.transitionSonsKind(nkStmtListType) var typ = semTypeNode(c, result, nil) - result.typ = makeTypeDesc(c, typ) + if typ == nil: + localError(c.config, result.info, "expression has no type: " & + renderTree(result, {renderNoComments})) + result = newSymNode(errorSym(c, result)) + else: + result.typ = makeTypeDesc(c, typ) #result = symNodeFromType(c, typ, n.info) else: - var retType = s.typ.sons[0] if s.ast[genericParamsPos] != nil and retType.isMetaType: # The return type may depend on the Macro arguments # 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.sons[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() @@ -431,26 +499,29 @@ const errMissingGenericParamsForTemplate = "'$1' has unspecified generic parameters" proc semMacroExpr(c: PContext, n, nOrig: PNode, sym: PSym, - flags: TExprFlags = {}): PNode = - pushInfoContext(c.config, nOrig.info) + flags: TExprFlags = {}; expectedType: PType = nil): PNode = + rememberExpansion(c, nOrig.info, sym) + pushInfoContext(c.config, nOrig.info, sym.detailedInfo) - markUsed(c.config, n.info, sym, c.graph.usageSym) - styleCheckUse(n.info, sym) + let info = getCallLineInfo(n) + markUsed(c, info, sym) + onUse(info, sym) if sym == c.p.owner: - globalError(c.config, n.info, "recursive dependency: '$1'" % sym.name.s) + globalError(c.config, info, "recursive dependency: '$1'" % sym.name.s) - let genericParams = if sfImmediate in sym.flags: 0 - else: sym.ast[genericParamsPos].len + let genericParams = sym.ast[genericParamsPos].len let suppliedParams = max(n.safeLen - 1, 0) if suppliedParams < genericParams: - globalError(c.config, n.info, errMissingGenericParamsForTemplate % n.renderTree) + globalError(c.config, info, errMissingGenericParamsForTemplate % n.renderTree) #if c.evalContext == nil: # c.evalContext = c.createEvalContext(emStatic) - result = evalMacroCall(c.module, c.graph, n, nOrig, sym) + 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) popInfoContext(c.config) @@ -459,84 +530,257 @@ proc forceBool(c: PContext, n: PNode): PNode = if result == nil: result = n proc semConstBoolExpr(c: PContext, n: PNode): PNode = - let nn = semExprWithType(c, n) - result = fitNode(c, getSysType(c.graph, n.info, tyBool), nn, nn.info) - if result == nil: + result = forceBool(c, semConstExpr(c, n, getSysType(c.graph, n.info, tyBool))) + if result.kind != nkIntLit: localError(c.config, n.info, errConstExprExpected) - return nn - result = getConstExpr(c.module, result, c.graph) - if result == nil: - localError(c.config, n.info, errConstExprExpected) - result = nn - -proc semGenericStmt(c: PContext, n: PNode): PNode proc semConceptBody(c: PContext, n: PNode): PNode -include semtypes, semtempl, semgnrc, semstmts, semexprs +include semtypes + +proc setGenericParamsMisc(c: PContext; n: PNode) = + ## used by call defs (procs, templates, macros, ...) to analyse their generic + ## params, and store the originals in miscPos for better error reporting. + let orig = n[genericParamsPos] + + doAssert orig.kind in {nkEmpty, nkGenericParams} + + if n[genericParamsPos].kind == nkEmpty: + n[genericParamsPos] = newNodeI(nkGenericParams, n.info) + else: + # we keep the original params around for better error messages, see + # issue https://github.com/nim-lang/Nim/issues/1713 + n[genericParamsPos] = semGenericParamList(c, orig) + + if n[miscPos].kind == nkEmpty: + n[miscPos] = newTree(nkBracket, c.graph.emptyNode, orig) + 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) = - for i in countup(c.lastGenericIdx, c.generics.len - 1): + for i in c.lastGenericIdx..<c.generics.len: var prc = c.generics[i].inst.sym if prc.kind in {skProc, skFunc, skMethod, skConverter} and prc.magic == mNone: - if prc.ast == nil or prc.ast.sons[bodyPos] == nil: + if prc.ast == nil or prc.ast[bodyPos] == nil: internalError(c.config, prc.info, "no code for " & prc.name.s) else: - addSon(n, prc.ast) + n.add prc.ast c.lastGenericIdx = c.generics.len -proc myOpen(graph: ModuleGraph; module: PSym): PPassContext = - var c = newContext(graph, module) - if c.p != nil: internalError(graph.config, module.info, "sem.myOpen") - c.semConstExpr = semConstExpr - c.semExpr = semExpr - c.semTryExpr = tryExpr - c.semTryConstExpr = tryConstExpr - c.semOperand = semOperand - c.semConstBoolExpr = semConstBoolExpr - c.semOverloadedCall = semOverloadedCall - c.semInferredLambda = semInferredLambda - c.semGenerateInstance = generateInstance - c.semTypeNode = semTypeNode - c.instTypeBoundOp = sigmatch.instTypeBoundOp - - pushProcCon(c, module) - pushOwner(c, c.module) - c.importTable = openScope(c) - c.importTable.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) - # don't be verbose unless the module belongs to the main package: - if module.owner.id == 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 - 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 + of nkStmtList: + for it in n: + if not isEmptyTree(it): return false + result = true + of nkEmpty, nkCommentStmt: result = true + else: result = false proc semStmtAndGenerateGenerics(c: PContext, n: PNode): PNode = - if n.kind == nkDefer: - localError(c.config, n.info, "defer statement not supported at top level") if c.topStmts == 0 and not isImportSystemStmt(c.graph, n): - if sfSystemModule notin c.module.flags and - n.kind notin {nkEmpty, nkCommentStmt}: - c.importTable.addSym c.graph.systemModule # import the "System" identifier + if sfSystemModule notin c.module.flags and not isEmptyTree(n): + assert c.graph.systemModule != nil + c.moduleScope.addSym c.graph.systemModule # import the "System" identifier importAllSymbols(c, c.graph.systemModule) inc c.topStmts else: @@ -545,7 +789,7 @@ proc semStmtAndGenerateGenerics(c: PContext, n: PNode): PNode = result = semAllTypeSections(c, n) else: result = n - result = semStmt(c, result) + result = semStmt(c, result, {}) when false: # Code generators are lazy now and can deal with undeclared procs, so these # steps are not required anymore and actually harmful for the upcoming @@ -554,16 +798,23 @@ proc semStmtAndGenerateGenerics(c: PContext, n: PNode): PNode = if c.lastGenericIdx < c.generics.len: var a = newNodeI(nkStmtList, n.info) addCodeForGenerics(c, a) - if sonsLen(a) > 0: + if a.len > 0: # a generic has been added to `a`: - if result.kind != nkEmpty: addSon(a, result) + if result.kind != nkEmpty: a.add result result = a result = hloStmt(c, result) if c.config.cmd == cmdInteractive and not isEmptyType(result.typ): result = buildEchoStmt(c, result) if c.config.cmd == cmdIdeTools: appendToModule(c.module, result) - result = transformStmt(c.graph, 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 @@ -573,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 = - 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) @@ -593,26 +843,21 @@ proc myProcess(context: PPassContext, n: PNode): PNode = else: result = newNodeI(nkEmpty, n.info) #if c.config.cmd == cmdIdeTools: findSuggest(c, n) - rod.storeNode(c.graph, c.module, result) - -proc testExamples(c: PContext) = - let inp = toFullPath(c.config, c.module.info) - let outp = inp.changeFileExt"" & "_examples.nim" - renderModule(c.runnableExamples, inp, outp) - let backend = if isDefined(c.config, "js"): "js" - elif isDefined(c.config, "cpp"): "cpp" - elif isDefined(c.config, "objc"): "objc" - else: "c" - if os.execShellCmd(os.getAppFilename() & " " & backend & " -r " & outp) != 0: - quit "[Examples] failed" - removeFile(outp) - -proc myClose(graph: ModuleGraph; context: PPassContext, n: PNode): PNode = - var c = PContext(context) + 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 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 rawCloseScope(c) # imported symbols; don't check for unused ones! + reportUnusedModules(c) result = newNode(nkStmtList) if n != nil: internalError(c.config, n.info, "n is not nil") #result := n; @@ -621,8 +866,4 @@ proc myClose(graph: ModuleGraph; context: PPassContext, n: PNode): PNode = result.add(c.module.ast) popOwner(c) popProcCon(c) - storeRemaining(c.graph, c.module) - if c.runnableExamples != nil: testExamples(c) - -const semPass* = makePass(myOpen, myProcess, myClose, - isFrontend = true) + sealRodFile(c) diff --git a/compiler/semasgn.nim b/compiler/semasgn.nim deleted file mode 100644 index 97ff4a7fc..000000000 --- a/compiler/semasgn.nim +++ /dev/null @@ -1,337 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2015 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements lifting for type-bound operations -## (``=sink``, ``=``, ``=destroy``, ``=deepCopy``). - -# included from sem.nim - -type - TLiftCtx = object - c: PContext - info: TLineInfo # for construction - kind: TTypeAttachedOp - fn: PSym - asgnForType: PType - recurse: bool - -proc liftBodyAux(c: var TLiftCtx; t: PType; body, x, y: PNode) -proc liftBody(c: PContext; typ: PType; kind: TTypeAttachedOp; - info: TLineInfo): PSym {.discardable.} - -proc at(a, i: PNode, elemType: PType): PNode = - result = newNodeI(nkBracketExpr, a.info, 2) - result.sons[0] = a - result.sons[1] = i - result.typ = elemType - -proc liftBodyTup(c: var TLiftCtx; t: PType; body, x, y: PNode) = - for i in 0 ..< t.len: - let lit = lowerings.newIntLit(c.c.graph, x.info, i) - liftBodyAux(c, t.sons[i], body, x.at(lit, t.sons[i]), y.at(lit, t.sons[i])) - -proc dotField(x: PNode, f: PSym): PNode = - result = newNodeI(nkDotExpr, x.info, 2) - result.sons[0] = x - result.sons[1] = newSymNode(f, x.info) - result.typ = f.typ - -proc liftBodyObj(c: var TLiftCtx; n, body, x, y: PNode) = - case n.kind - of nkSym: - let f = n.sym - liftBodyAux(c, f.typ, body, x.dotField(f), y.dotField(f)) - of nkNilLit: discard - of nkRecCase: - # copy the selector: - liftBodyObj(c, n[0], body, x, y) - # we need to generate a case statement: - var caseStmt = newNodeI(nkCaseStmt, c.info) - # XXX generate 'if' that checks same branches - # generate selector: - var access = dotField(x, n[0].sym) - caseStmt.add(access) - # copy the branches over, but replace the fields with the for loop body: - for i in 1 ..< n.len: - var branch = copyTree(n[i]) - let L = branch.len - branch.sons[L-1] = newNodeI(nkStmtList, c.info) - - liftBodyObj(c, n[i].lastSon, branch.sons[L-1], x, y) - caseStmt.add(branch) - body.add(caseStmt) - localError(c.c.config, c.info, "cannot lift assignment operator to 'case' object") - of nkRecList: - for t in items(n): liftBodyObj(c, t, body, x, y) - else: - illFormedAstLocal(n, c.c.config) - -proc genAddr(c: PContext; x: PNode): PNode = - if x.kind == nkHiddenDeref: - checkSonsLen(x, 1, c.config) - result = x.sons[0] - else: - result = newNodeIT(nkHiddenAddr, x.info, makeVarType(c, x.typ)) - addSon(result, x) - -proc newAsgnCall(c: PContext; op: PSym; x, y: PNode): PNode = - if sfError in op.flags: - localError(c.config, x.info, "usage of '$1' is a user-defined error" % op.name.s) - result = newNodeI(nkCall, x.info) - result.add newSymNode(op) - result.add genAddr(c, x) - result.add y - -proc newAsgnStmt(le, ri: PNode): PNode = - result = newNodeI(nkAsgn, le.info, 2) - result.sons[0] = le - result.sons[1] = ri - -proc newOpCall(op: PSym; x: PNode): PNode = - result = newNodeIT(nkCall, x.info, op.typ.sons[0]) - result.add(newSymNode(op)) - result.add x - -proc destructorCall(c: PContext; op: PSym; x: PNode): PNode = - result = newNodeIT(nkCall, x.info, op.typ.sons[0]) - result.add(newSymNode(op)) - if destructor in c.features: - result.add genAddr(c, x) - else: - result.add x - -proc newDeepCopyCall(op: PSym; x, y: PNode): PNode = - result = newAsgnStmt(x, newOpCall(op, y)) - -proc considerAsgnOrSink(c: var TLiftCtx; t: PType; body, x, y: PNode; - field: PSym): bool = - if tfHasAsgn in t.flags: - var op: PSym - if sameType(t, c.asgnForType): - # generate recursive call: - if c.recurse: - op = c.fn - else: - c.recurse = true - return false - else: - op = field - if op == nil: - op = liftBody(c.c, t, c.kind, c.info) - markUsed(c.c.config, c.info, op, c.c.graph.usageSym) - styleCheckUse(c.info, op) - body.add newAsgnCall(c.c, op, x, y) - result = true - -proc considerOverloadedOp(c: var TLiftCtx; t: PType; body, x, y: PNode): bool = - case c.kind - of attachedDestructor: - let op = t.destructor - if op != nil: - markUsed(c.c.config, c.info, op, c.c.graph.usageSym) - styleCheckUse(c.info, op) - body.add destructorCall(c.c, op, x) - result = true - of attachedAsgn: - result = considerAsgnOrSink(c, t, body, x, y, t.assignment) - of attachedSink: - result = considerAsgnOrSink(c, t, body, x, y, t.sink) - of attachedDeepCopy: - let op = t.deepCopy - if op != nil: - markUsed(c.c.config, c.info, op, c.c.graph.usageSym) - styleCheckUse(c.info, op) - body.add newDeepCopyCall(op, x, y) - result = true - -proc defaultOp(c: var TLiftCtx; t: PType; body, x, y: PNode) = - if c.kind != attachedDestructor: - body.add newAsgnStmt(x, y) - -proc addVar(father, v, value: PNode) = - var vpart = newNodeI(nkIdentDefs, v.info, 3) - vpart.sons[0] = v - vpart.sons[1] = newNodeI(nkEmpty, v.info) - vpart.sons[2] = value - addSon(father, vpart) - -proc declareCounter(c: var TLiftCtx; body: PNode; first: BiggestInt): PNode = - var temp = newSym(skTemp, getIdent(c.c.cache, lowerings.genPrefix), c.fn, c.info) - temp.typ = getSysType(c.c.graph, body.info, tyInt) - incl(temp.flags, sfFromGeneric) - - var v = newNodeI(nkVarSection, c.info) - result = newSymNode(temp) - v.addVar(result, lowerings.newIntLit(c.c.graph, body.info, first)) - body.add v - -proc genBuiltin(g: ModuleGraph; magic: TMagic; name: string; i: PNode): PNode = - result = newNodeI(nkCall, i.info) - result.add createMagic(g, name, magic).newSymNode - result.add i - -proc genWhileLoop(c: var TLiftCtx; i, dest: PNode): PNode = - result = newNodeI(nkWhileStmt, c.info, 2) - let cmp = genBuiltin(c.c.graph, mLeI, "<=", i) - cmp.add genHigh(c.c.graph, dest) - cmp.typ = getSysType(c.c.graph, c.info, tyBool) - result.sons[0] = cmp - result.sons[1] = newNodeI(nkStmtList, c.info) - -proc addIncStmt(c: var TLiftCtx; body, i: PNode) = - let incCall = genBuiltin(c.c.graph, mInc, "inc", i) - incCall.add lowerings.newIntLit(c.c.graph, c.info, 1) - body.add incCall - -proc newSeqCall(c: PContext; x, y: PNode): PNode = - # don't call genAddr(c, x) here: - result = genBuiltin(c.graph, mNewSeq, "newSeq", x) - let lenCall = genBuiltin(c.graph, mLengthSeq, "len", y) - lenCall.typ = getSysType(c.graph, x.info, tyInt) - result.add lenCall - -proc liftBodyAux(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, - tyPtr, tyString, tyRef, tyOpt: - defaultOp(c, t, body, x, y) - of tyArray, tySequence: - if {tfHasAsgn, tfUncheckedArray} * t.flags == {tfHasAsgn}: - if t.kind == tySequence: - # XXX add 'nil' handling here - body.add newSeqCall(c.c, x, y) - let i = declareCounter(c, body, firstOrd(c.c.config, t)) - let whileLoop = genWhileLoop(c, i, x) - let elemType = t.lastSon - liftBodyAux(c, elemType, whileLoop.sons[1], x.at(i, elemType), - y.at(i, elemType)) - addIncStmt(c, whileLoop.sons[1], i) - body.add whileLoop - else: - defaultOp(c, t, body, x, y) - of tyObject, tyDistinct: - if not considerOverloadedOp(c, t, body, x, y): - if t.sons[0] != nil: - liftBodyAux(c, t.sons[0].skipTypes(skipPtrs), body, x, y) - if t.kind == tyObject: liftBodyObj(c, t.n, body, x, y) - of tyTuple: - liftBodyTup(c, t, body, x, y) - of tyProc: - if t.callConv != ccClosure or c.kind != attachedDeepCopy: - defaultOp(c, t, body, x, y) - else: - # a big problem is that we don't know the enviroment's type here, so we - # have to go through some indirection; we delegate this to the codegen: - let call = newNodeI(nkCall, c.info, 2) - call.typ = t - call.sons[0] = newSymNode(createMagic(c.c.graph, "deepCopy", mDeepCopy)) - call.sons[1] = y - body.add newAsgnStmt(x, call) - of tyVarargs, tyOpenArray: - localError(c.c.config, c.info, "cannot copy openArray") - of tyFromExpr, tyProxy, tyBuiltInTypeClass, tyUserTypeClass, - tyUserTypeClassInst, tyCompositeTypeClass, tyAnd, tyOr, tyNot, tyAnything, - tyGenericParam, tyGenericBody, tyNil, tyExpr, tyStmt, - tyTypeDesc, tyGenericInvocation, tyForward: - internalError(c.c.config, c.info, "assignment requested for type: " & typeToString(t)) - of tyOrdinal, tyRange, tyInferred, - tyGenericInst, tyStatic, tyVar, tyLent, tyAlias, tySink: - liftBodyAux(c, lastSon(t), body, x, y) - of tyUnused, tyOptAsRef: internalError(c.c.config, "liftBodyAux") - -proc newProcType(info: TLineInfo; owner: PSym): PType = - result = newType(tyProc, owner) - result.n = newNodeI(nkFormalParams, info) - rawAddSon(result, nil) # return type - # result.n[0] used to be `nkType`, but now it's `nkEffectList` because - # the effects are now stored in there too ... this is a bit hacky, but as - # usual we desperately try to save memory: - addSon(result.n, newNodeI(nkEffectList, info)) - -proc addParam(procType: PType; param: PSym) = - param.position = procType.len-1 - addSon(procType.n, newSymNode(param)) - rawAddSon(procType, param.typ) - -proc liftBody(c: PContext; typ: PType; kind: TTypeAttachedOp; - info: TLineInfo): PSym = - var a: TLiftCtx - a.info = info - a.c = c - a.kind = kind - let body = newNodeI(nkStmtList, info) - let procname = case kind - of attachedAsgn: getIdent(c.cache, "=") - of attachedSink: getIdent(c.cache, "=sink") - of attachedDeepCopy: getIdent(c.cache, "=deepcopy") - of attachedDestructor: getIdent(c.cache, "=destroy") - - result = newSym(skProc, procname, typ.owner, info) - a.fn = result - a.asgnForType = typ - - let dest = newSym(skParam, getIdent(c.cache, "dest"), result, info) - let src = newSym(skParam, getIdent(c.cache, "src"), result, info) - dest.typ = makeVarType(c, typ) - src.typ = typ - - result.typ = newProcType(info, typ.owner) - result.typ.addParam dest - if kind != attachedDestructor: - result.typ.addParam src - - liftBodyAux(a, typ, body, newSymNode(dest).newDeref, newSymNode(src)) - # recursion is handled explicitly, do not register the type based operation - # before 'liftBodyAux': - case kind - of attachedAsgn: typ.assignment = result - of attachedSink: typ.sink = result - of attachedDeepCopy: typ.deepCopy = result - of attachedDestructor: typ.destructor = result - - var n = newNodeI(nkProcDef, info, bodyPos+1) - for i in 0 ..< n.len: n.sons[i] = newNodeI(nkEmpty, info) - n.sons[namePos] = newSymNode(result) - n.sons[paramsPos] = result.typ.n - n.sons[bodyPos] = body - result.ast = n - incl result.flags, sfFromGeneric - - -proc getAsgnOrLiftBody(c: PContext; typ: PType; info: TLineInfo): PSym = - let t = typ.skipTypes({tyGenericInst, tyVar, tyLent, tyAlias, tySink}) - result = t.assignment - if result.isNil: - result = liftBody(c, t, attachedAsgn, info) - -proc overloadedAsgn(c: PContext; dest, src: PNode): PNode = - let a = getAsgnOrLiftBody(c, dest.typ, dest.info) - result = newAsgnCall(c, a, dest, src) - -proc liftTypeBoundOps*(c: PContext; typ: PType; info: TLineInfo) = - ## In the semantic pass this is called in strategic places - ## to ensure we lift assignment, destructors and moves properly. - ## The later 'destroyer' pass depends on it. - if destructor notin c.features or not hasDestructor(typ): return - when false: - # do not produce wrong liftings while we're still instantiating generics: - # now disabled; breaks topttree.nim! - if c.typesWithOps.len > 0: return - let typ = typ.skipTypes({tyGenericInst, tyAlias}) - # we generate the destructor first so that other operators can depend on it: - if typ.destructor == nil: - liftBody(c, typ, attachedDestructor, info) - if typ.assignment == nil: - liftBody(c, typ, attachedAsgn, info) - if typ.sink == nil: - liftBody(c, typ, attachedSink, info) - -#proc patchResolvedTypeBoundOp*(c: PContext; n: PNode): PNode = -# if n.kind == nkCall and diff --git a/compiler/semcall.nim b/compiler/semcall.nim index 5d3df064f..13f2273a9 100644 --- a/compiler/semcall.nim +++ b/compiler/semcall.nim @@ -10,6 +10,9 @@ ## This module implements semantic checking for calls. # included from sem.nim +from std/algorithm import sort + + proc sameMethodDispatcher(a, b: PSym): bool = result = false if a.kind == skMethod and b.kind == skMethod: @@ -40,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 @@ -60,44 +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 != nil: + 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: - #if sym.name.s == "==" and (n.info ?? "temp3"): - # echo typeToString(sym.typ) - # writeMatches(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: @@ -105,29 +120,42 @@ proc pickBestCandidate(c: PContext, headSymbol: PNode, if cmp < 0: best = z # x is better than the best so far elif cmp == 0: alt = z # x is as good as the best so far elif errorsEnabled or z.diagnosticsEnabled: - errors.safeAdd(CandidateError( + errors.add(CandidateError( sym: sym, - unmatchedVarParam: int z.mutabilityProblem, 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 -proc effectProblem(f, a: PType; result: var string) = + # 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: result.add "\n This expression is not GC-safe. Annotate the " & @@ -135,10 +163,33 @@ proc effectProblem(f, a: PType; result: var string) = elif tfNoSideEffect in f.flags and tfNoSideEffect notin a.flags: result.add "\n This expression can have side effects. Annotate the " & "proc with {.noSideEffect.} to get extended error information." + else: + case compatibleEffects(f, a) + of efCompat: discard + of efRaisesDiffer: + result.add "\n The `.raises` requirements differ." + of efRaisesUnknown: + result.add "\n The `.raises` requirements differ. Annotate the " & + "proc with {.raises: [].} to get extended error information." + of efTagsDiffer: + result.add "\n The `.tags` requirements differ." + of efTagsUnknown: + result.add "\n The `.tags` requirements differ. Annotate the " & + "proc with {.tags: [].} to get extended error information." + of 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." proc renderNotLValue(n: PNode): string = result = $n - if n.kind in {nkHiddenStdConv, nkHiddenSubConv, nkHiddenCallConv} and n.len == 2: + let n = if n.kind == nkHiddenDeref: n[0] else: n + if n.kind == nkHiddenCallConv and n.len > 1: + result = $n[0] & "(" & result & ")" + elif n.kind in {nkHiddenStdConv, nkHiddenSubConv} and n.len == 2: result = typeToString(n.typ.skipTypes(abstractVar)) & "(" & result & ")" proc presentFailedCandidates(c: PContext, n: PNode, errors: CandidateErrors): @@ -154,136 +205,329 @@ proc presentFailedCandidates(c: PContext, n: PNode, errors: CandidateErrors): for err in errors: var errProto = "" let n = err.sym.typ.n - for i in countup(1, n.len - 1): - var p = n.sons[i] + for i in 1..<n.len: + var p = n[i] if p.kind == nkSym: - add(errProto, typeToString(p.sym.typ, preferName)) - if i != n.len-1: add(errProto, ", ") + errProto.add(typeToString(p.sym.typ, preferName)) + if i != n.len-1: errProto.add(", ") # else: ignore internal error as we're already in error handling mode if errProto == proto: prefer = preferModuleInfo break + # we pretend procs are attached to the type of the first + # 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 and verboseTypeMismatch in c.config.legacyFeatures: + for err in errors: + if err.firstMismatch.arg > 1: + filterOnlyFirst = true + break + + var maybeWrongSpace = false + + var candidatesAll: seq[string] = @[] var candidates = "" + var skipped = 0 for err in errors: + candidates.setLen 0 + 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: - add(candidates, renderTree(err.sym.ast, + candidates.add(renderTree(err.sym.ast, {renderNoBody, renderNoComments, renderNoPragmas})) else: - add(candidates, getProcHeader(c.config, err.sym, prefer)) - add(candidates, "\n") - if err.firstMismatch != 0 and n.len > 1: - let cond = n.len > 2 - if cond: - candidates.add(" first type mismatch at position: " & $err.firstMismatch & - "\n required type: ") - var wanted, got: PType = nil - if err.firstMismatch < err.sym.typ.len: - wanted = err.sym.typ.sons[err.firstMismatch] - if cond: candidates.add typeToString(wanted) + candidates.add(getProcHeader(c.config, err.sym, prefer)) + candidates.addDeclaredLocMaybe(c.config, err.sym) + candidates.add("\n") + 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: + 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'" + 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 + 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: - if cond: candidates.add "none" - if err.firstMismatch < n.len: - if cond: + 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 '" - candidates.add renderTree(n[err.firstMismatch]) - candidates.add "' is of type: " - got = n[err.firstMismatch].typ - if cond: candidates.add typeToString(got) - if wanted != nil and got != nil: - effectProblem(wanted, got, candidates) - if cond: candidates.add "\n" - if err.unmatchedVarParam != 0 and err.unmatchedVarParam < n.len: - candidates.add(" for a 'var' type a variable needs to be passed, but '" & - renderNotLValue(n[err.unmatchedVarParam]) & - "' is immutable\n") + 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") + candidatesAll.add candidates + candidatesAll.sort # fix #13538 + candidates = join(candidatesAll) + if skipped > 0: + candidates.add($skipped & " other mismatching symbols have been " & + "suppressed; compile with --showAllMismatches:on to see them\n") + if maybeWrongSpace: + candidates.add("maybe misplaced space between " & renderTree(n[0]) & " and '(' \n") result = (prefer, candidates) const errTypeMismatch = "type mismatch: got <" - errButExpected = "but expected one of: " + 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 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)) + result.add('>') + if candidates != "": + result.add("\n" & errButExpected & "\n" & candidates) + localError(c.config, n.info, result & "\nexpression: " & $n) + 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 + # 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, "expression '$1' cannot be called" % n[0].renderTree) + 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 - let (prefer, candidates) = presentFailedCandidates(c, n, errors) - var result = errTypeMismatch - add(result, describeArgs(c, n, 1, prefer)) - add(result, '>') - if candidates != "": - add(result, "\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, - unmatchedVarParam: 0, firstMismatch: 0, - diagnostics: nil, - enabled: false)) - symx = nextOverloadIter(o, c, headSymbol) - if errors.len == 0: - localError(c.config, n.info, "could not resolve: " & $n) + 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 = 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 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 + # in a concept, e.g.: + # ExplainedConcept {.explain.} = concept x + # x.foo is int + # We could use: `(c.config $ n[1].info)` to get more context. + discard + else: + typeHint = " for type " & getProcHeader(c.config, sym) + let suffix = if result.len > 0: " " & result else: "" + result = errUndeclaredField % ident & typeHint & suffix + else: + if result.len == 0: result = errUndeclaredRoutine % ident + else: result = errBadRoutine % [ident, result] 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 f = n.sons[0] + var alt: TCandidate = default(TCandidate) + var f = n[0] if f.kind == nkBracketExpr: # fill in the bindings: semOpAux(c, f) initialBinding = f - f = f.sons[0] + f = f[0] 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 @@ -294,9 +538,9 @@ proc resolveOverloads(c: PContext, n, orig: PNode, template tryOp(x) = let op = newIdentNode(getIdent(c.cache, x), n.info) - n.sons[0] = op - orig.sons[0] = op - pickBest(op) + n[0] = op + orig[0] = op + pickSpecialOp(op) if nfExplicitCall in n.flags: tryOp ".()" @@ -306,17 +550,20 @@ proc resolveOverloads(c: PContext, n, orig: PNode, elif nfDotSetter in n.flags and f.kind == nkIdent and n.len == 3: # we need to strip away the trailing '=' here: - let calleeName = newIdentNode(getIdent(c.cache, f.ident.s[0..f.ident.s.len-2]), n.info) + let calleeName = newIdentNode(getIdent(c.cache, f.ident.s[0..^2]), n.info) 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 nfDotField in n.flags and nfExplicitCall notin n.flags: - localError(c.config, n.info, errUndeclaredField % considerQuotedIdent(c, f, n).s) - else: - localError(c.config, n.info, errUndeclaredRoutine % considerQuotedIdent(c, f, n).s) + 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 elif result.state != csMatch: if nfExprCall in n.flags: @@ -326,7 +573,7 @@ proc resolveOverloads(c: PContext, n, orig: PNode, if {nfDotField, nfDotSetter} * n.flags != {}: # clean up the inserted ops n.sons.delete(2) - n.sons[0] = f + n[0] = f return if alt.state == csMatch and cmpCandidates(result, alt) == 0 and not sameMethodDispatcher(result.calleeSym, alt.calleeSym): @@ -339,42 +586,74 @@ proc resolveOverloads(c: PContext, n, orig: PNode, elif c.config.errorCounter == 0: # don't cascade errors var args = "(" - for i in countup(1, sonsLen(n) - 1): - if i > 1: add(args, ", ") - add(args, typeToString(n.sons[i].typ)) - add(args, ")") + for i in 1..<n.len: + if i > 1: args.add(", ") + args.add(typeToString(n[i].typ)) + args.add(")") localError(c.config, n.info, errAmbiguousCallXYZ % [ getProcHeader(c.config, result.calleeSym), getProcHeader(c.config, alt.calleeSym), args]) +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) = - if a.kind == nkHiddenCallConv and a.sons[0].kind == nkSym: - let s = a.sons[0].sym - if s.ast != nil and s.ast[genericParamsPos].kind != nkEmpty: + let a = if a.kind == nkHiddenDeref: a[0] else: a + if a.kind == nkHiddenCallConv and a[0].kind == nkSym: + let s = a[0].sym + if s.isGenericRoutineStrict: let finalCallee = generateInstance(c, s, x.bindings, a.info) - a.sons[0].sym = finalCallee - a.sons[0].typ = finalCallee.typ - #a.typ = finalCallee.typ.sons[0] + a[0].sym = finalCallee + a[0].typ = finalCallee.typ + #a.typ = finalCallee.typ.returnType proc instGenericConvertersSons*(c: PContext, n: PNode, x: TCandidate) = assert n.kind in nkCallKinds if x.genericConverter: - for i in 1 ..< n.len: - instGenericConvertersArg(c, n.sons[i], x) + for i in 1..<n.len: + instGenericConvertersArg(c, n[i], x) proc indexTypesMatch(c: PContext, f, a: PType, arg: PNode): PNode = - var m: TCandidate - initCandidate(c, m, f) + var m = newCandidate(c, f) result = paramTypesMatch(m, f, a, arg, nil) if m.genericConverter and result != nil: instGenericConvertersArg(c, result, m) proc inferWithMetatype(c: PContext, formal: PType, arg: PNode, coerceDistincts = false): PNode = - var m: TCandidate - initCandidate(c, m, formal) + var m = newCandidate(c, formal) m.coerceDistincts = coerceDistincts result = paramTypesMatch(m, formal, arg.typ, arg, nil) if m.genericConverter and result != nil: @@ -386,46 +665,154 @@ proc inferWithMetatype(c: PContext, formal: PType, result.typ = generateTypeInstance(c, m.bindings, arg.info, formal.skipTypes({tyCompositeTypeClass})) else: - typeMismatch(c.config, arg.info, formal, arg.typ) + typeMismatch(c.config, arg.info, formal, arg.typ, arg) # error correction: result = copyTree(arg) result.typ = formal -proc semResolvedCall(c: PContext, n: PNode, x: TCandidate): 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 + # that was used during sigmatch. sigmatch is responsible for marking + # the default params with `nfDefaultParam` and `instantiateProcType` + # computes correctly the default values for each instantiation. + let calleeParams = call[0].sym.typ.n + for i in 1..<call.len: + if nfDefaultParam in call[i].flags: + 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 = + case n.kind + of nkAccQuoted, nkBracketExpr, nkCall, nkCallStrLit, nkCommand: + if len(n) > 0: + return getCallLineInfo(n[0]) + of nkDotExpr: + if len(n) > 1: + return getCallLineInfo(n[1]) + else: + discard + result = n.info + +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 - markUsed(c.config, n.sons[0].info, finalCallee, c.graph.usageSym) - styleCheckUse(n.sons[0].info, finalCallee) + 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.sons[0] = newSymNode(finalCallee, result.sons[0].info) - if containsGenericType(result.typ) or x.fauxMatch == tyUnknown: - result.typ = newTypeS(x.fauxMatch, c) + result[0] = newSymNode(finalCallee, getCallLineInfo(result[0])) + if containsGenericType(result.typ): + result.typ = newTypeS(tyError, c) + incl result.typ.flags, tfCheckedForDestructor return - let gp = finalCallee.ast.sons[genericParamsPos] - if gp.kind != nkEmpty: + let gp = finalCallee.ast[genericParamsPos] + if gp.isGenericParams: if x.calleeSym.kind notin {skMacro, skTemplate}: 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: - 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.sons[0] = newSymNode(finalCallee, result.sons[0].info) - result.typ = finalCallee.typ.sons[0] + result[0] = newSymNode(finalCallee, getCallLineInfo(result[0])) + 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; @@ -433,12 +820,13 @@ proc canDeref(n: PNode): bool {.inline.} = proc tryDeref(n: PNode): PNode = result = newNodeI(nkHiddenDeref, n.info) - result.typ = n.typ.skipTypes(abstractInst).sons[0] - result.addSon(n) + result.typ = n.typ.skipTypes(abstractInst)[0] + result.add n proc semOverloadedCall(c: PContext, n, nOrig: PNode, - filter: TSymKinds, flags: TExprFlags): PNode = - var errors: CandidateErrors = if efExplain in flags: @[] else: nil + 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: # this may be triggered, when the explain pragma is used @@ -447,70 +835,70 @@ proc semOverloadedCall(c: PContext, n, nOrig: PNode, message(c.config, n.info, hintUserRaw, "Non-matching candidates for " & renderTree(n) & "\n" & candidates) - result = semResolvedCall(c, n, r) - 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.sons[1] = n.sons[1].tryDeref - var r = resolveOverloads(c, n, nOrig, filter, flags, errors, efExplain in flags) - if r.state == csMatch: result = semResolvedCall(c, n, r) - else: - # get rid of the deref again for a better error message: - n.sons[1] = n.sons[1].sons[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}) - else: - 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}) - else: + 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, n.info, errCannotInstantiateX % renderTree(n)) + localError(c.config, getCallLineInfo(n), errCannotInstantiateX % renderTree(n)) result = n proc explicitGenericSym(c: PContext, n: PNode, s: PSym): PNode = - var m: TCandidate + 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! - initCandidate(c, m, s, nil) - - for i in 1..sonsLen(n)-1: - let formal = s.ast.sons[genericParamsPos].sons[i-1].typ - let arg = n[i].typ - let tm = typeRel(m, formal, arg) - if tm in {isNone, isConvertible}: return nil + var m = newCandidate(c, s, 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 - markUsed(c.config, n.info, s, c.graph.usageSym) - styleCheckUse(n.info, s) - result = newSymNode(newInst, n.info) + let info = getCallLineInfo(n) + markUsed(c, info, s) + onUse(info, s) + result = newSymNode(newInst, info) + +proc setGenericParams(c: PContext, n, expectedParams: PNode) = + ## sems generic params in subscript expression + for i in 1..<n.len: + 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 - for i in 1..sonsLen(n)-1: - let e = semExpr(c, n.sons[i]) - n.sons[i].typ = e.typ.skipTypes({tyTypeDesc}) + setGenericParams(c, n, s.ast[genericParamsPos]) var s = s - var a = n.sons[0] + var a = n[0] if a.kind == nkSym: # common case; check the only candidate has the right # number of generic type parameters: - if safeLen(s.ast.sons[genericParamsPos]) != n.len-1: - let expected = safeLen(s.ast.sons[genericParamsPos]) - localError(c.config, n.info, errGenerated, "cannot instantiate: '" & renderTree(n) & - "'; got " & $(n.len-1) & " type(s) but expected " & $expected) + if s.ast[genericParamsPos].safeLen != n.len-1: + let expected = s.ast[genericParamsPos].safeLen + localError(c.config, getCallLineInfo(n), errGenerated, "cannot instantiate: '" & renderTree(n) & + "'; got " & $(n.len-1) & " typeof(s) but expected " & $expected) return n result = explicitGenericSym(c, n, s) if result == nil: result = explicitGenericInstError(c, n) @@ -518,14 +906,14 @@ proc explicitGenericInstantiation(c: PContext, n: PNode, s: PSym): PNode = # choose the generic proc with the proper number of type parameters. # XXX I think this could be improved by reusing sigmatch.paramTypesMatch. # It's good enough for now. - result = newNodeI(a.kind, n.info) - for i in countup(0, len(a)-1): - var candidate = a.sons[i].sym + result = newNodeI(a.kind, getCallLineInfo(n)) + for i in 0..<a.len: + var candidate = a[i].sym if candidate.kind in {skProc, skMethod, skConverter, skFunc, skIterator}: # it suffices that the candidate has the proper number of generic # type parameters: - if safeLen(candidate.ast.sons[genericParamsPos]) == n.len-1: + if candidate.ast[genericParamsPos].safeLen == n.len-1: let x = explicitGenericSym(c, n, candidate) if x != nil: result.add(x) # get rid of nkClosedSymChoice if not ambiguous: @@ -536,31 +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 = - # Searchs for the fn in the symbol table. If the parameter lists are suitable +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.sons[i] - let t = skipTypes(param.typ, abstractVar-{tyTypeDesc, tyDistinct}) - if t.kind == tyDistinct or param.typ.kind == tyDistinct: hasDistinct = true - var x: PType + let param = fn.typ.n[i] + #[. + # 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(tyVar, c) - x.addSonSkipIntLit t.baseOfDistinct + x = newTypeS(param.typ.kind, c) + x.addSonSkipIntLit(getType(isDistinct, t), c.idgen) else: - x = t.baseOfDistinct - 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: - var resolved = semOverloadedCall(c, call, call, {fn.kind}, {}) + 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.sons[0].sym - if not compareTypes(result.typ.sons[0], fn.typ.sons[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 c858b6839..ca35ddc53 100644 --- a/compiler/semdata.nim +++ b/compiler/semdata.nim @@ -9,12 +9,16 @@ ## This module contains the data structures for the semantic checking phase. +import std/[tables, intsets, sets] + +when defined(nimPreviewSlimSystem): + import std/assertions + import - strutils, intsets, options, lexer, ast, astalgo, trees, treetab, - wordrecg, - ropes, msgs, platform, os, condsyms, idents, renderer, types, extccomp, math, - magicsys, nversion, nimsets, parser, times, passes, vmdef, - modulegraphs, lineinfos + options, ast, astalgo, msgs, idents, renderer, + magicsys, vmdef, modulegraphs, lineinfos, pathutils + +import ic / ic type TOptionEntry* = object # entries to put on a stack for pragma parsing @@ -22,22 +26,24 @@ type defaultCC*: TCallingConvention dynlib*: PLib notes*: TNoteKinds + features*: set[Feature] otherPragmas*: PNode # every pragma can be pushed + warningAsErrors*: TNoteKinds 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 - wasForwarded*: bool # whether the current proc has a separate header - mapping*: TIdTable + mappingExists*: bool + mapping*: Table[ItemId, PSym] + caseContext*: seq[tuple[n: PNode, idx: int]] + localBindStmts*: seq[PNode] TMatchedConcept* = object candidateType*: PType @@ -49,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, @@ -62,57 +68,80 @@ type # you may be in position to supply a better error message # to the user. efWantStmt, efAllowStmt, efDetermineType, efExplain, - efAllowDestructor, efWantValue, efOperand, efNoSemCheck, - efNoEvaluateGeneric, efInCall, efFromHlo + efWantValue, efOperand, efNoSemCheck, + efNoEvaluateGeneric, efInCall, efFromHlo, efNoSem2Check, + 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] - TTypeAttachedOp* = enum - attachedAsgn, - attachedSink, - attachedDeepCopy, - attachedDestructor + ImportMode* = enum + importAll, importSet, importExcept + ImportedModule* = object + m*: PSym + case mode*: ImportMode + of importAll: discard + of importSet: + imported*: IntSet # of PIdent.id + of importExcept: + exceptSet*: IntSet # of PIdent.id PContext* = ref TContext - TContext* = object of TPassContext # a context represents a module + 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 - importTable*: PScope # scope for all imported symbols + moduleScope*: PScope # scope for modules + imports*: seq[ImportedModule] # scope for all imported symbols topLevelScope*: PScope # scope for all top-level symbols p*: PProcCon # procedure context + intTypeCache*: array[-5..32, PType] # cache some common integer types + # to avoid type allocations + nilTypeCache*: PType matchedConcept*: ptr TMatchedConcept # the current concept being matched friendModules*: seq[PSym] # friend modules; may access private data; # this is used so that generic instantiations # can access private object fields instCounter*: int # to prevent endless instantiations - - ambiguousSymbols*: IntSet # ids of all ambiguous symbols (cannot - # store this info in the syms themselves!) + templInstCounter*: ref int # gives every template instantiation a unique id inGenericContext*: int # > 0 if we are in a generic type inStaticContext*: int # > 0 if we are inside a static: block inUnrolledContext*: int # > 0 if we are unrolling a loop compilesContextId*: int # > 0 if we are in a ``compiles`` magic compilesContextIdGenerator*: int inGenericInst*: int # > 0 if we are instantiating a generic - converters*: TSymSeq # sequence of converters - patterns*: TSymSeq # sequence of pattern matchers + 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 @@ -126,30 +155,78 @@ 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 recursiveDep*: string suggestionsMade*: bool + isAmbiguous*: bool # little hack features*: set[Feature] - inTypeContext*: int - typesWithOps*: seq[(PType, PType)] #\ - # We need to instantiate the type bound ops lazily after - # the generic type has been constructed completely. See - # tests/destructor/topttree.nim for an example that - # would otherwise fail. - runnableExamples*: PNode + inTypeContext*, inConceptDecl*: int + unusedImports*: seq[(PSym, TLineInfo)] + 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 +proc getIntLitType*(c: PContext; literal: PNode): PType = + # we cache some common integer literal types for performance: + let value = literal.intVal + if value >= low(c.intTypeCache) and value <= high(c.intTypeCache): + result = c.intTypeCache[value.int] + if result == nil: + let ti = getSysType(c.graph, literal.info, tyInt) + 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, c.idgen, ti.owner) + result.n = literal + +proc setIntLitType*(c: PContext; result: PNode) = + let i = result.intVal + case c.config.target.intSize + of 8: result.typ = getIntLitType(c, result) + of 4: + if i >= low(int32) and i <= high(int32): + result.typ = getIntLitType(c, result) + else: + result.typ = getSysType(c.graph, result.info, tyInt64) + of 2: + if i >= low(int16) and i <= high(int16): + result.typ = getIntLitType(c, result) + elif i >= low(int32) and i <= high(int32): + result.typ = getSysType(c.graph, result.info, tyInt32) + else: + result.typ = getSysType(c.graph, result.info, tyInt64) + of 1: + # 8 bit CPUs are insane ... + if i >= low(int8) and i <= high(int8): + result.typ = getIntLitType(c, result) + elif i >= low(int16) and i <= high(int16): + result.typ = getSysType(c.graph, result.info, tyInt16) + elif i >= low(int32) and i <= high(int32): + result.typ = getSysType(c.graph, result.info, tyInt32) + else: + result.typ = getSysType(c.graph, result.info, tyInt64) + else: + 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 @@ -163,11 +240,10 @@ proc getCurrOwner*(c: PContext): PSym = result = c.graph.owners[^1] proc pushOwner*(c: PContext; owner: PSym) = - add(c.graph.owners, owner) + c.graph.owners.add(owner) proc popOwner*(c: PContext) = - var length = len(c.graph.owners) - if length > 0: setLen(c.graph.owners, length - 1) + if c.graph.owners.len > 0: setLen(c.graph.owners, c.graph.owners.len - 1) else: internalError(c.config, "popOwner") proc lastOptionEntry*(c: PContext): POptionEntry = @@ -176,13 +252,15 @@ proc lastOptionEntry*(c: PContext): POptionEntry = proc popProcCon*(c: PContext) {.inline.} = c.p = c.p.next proc put*(p: PProcCon; key, val: PSym) = - if p.mapping.data == nil: initIdTable(p.mapping) + if not p.mappingExists: + 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 p.mapping.data == nil: return nil - result = PSym(p.mapping.idTableGet(key)) + if not p.mappingExists: return nil + result = p.mapping.getOrDefault(key.itemId) proc getGenSym*(c: PContext; s: PSym): PSym = if sfGenSym notin s.flags: return s @@ -196,71 +274,138 @@ 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 else: for i in 0..<n.safeLen: - considerGenSyms(c, n.sons[i]) + considerGenSyms(c, n[i]) proc newOptionEntry*(conf: ConfigRef): POptionEntry = new(result) result.options = conf.options - result.defaultCC = ccDefault + result.defaultCC = ccNimCall result.dynlib = nil result.notes = conf.notes + result.warningAsErrors = conf.warningAsErrors + +proc pushOptionEntry*(c: PContext): POptionEntry = + new(result) + var prev = c.optionStack[^1] + result.options = c.config.options + result.defaultCC = prev.defaultCC + result.dynlib = prev.dynlib + result.notes = c.config.notes + result.warningAsErrors = c.config.warningAsErrors + result.features = c.features + c.optionStack.add(result) + +proc popOptionEntry*(c: PContext) = + c.config.options = c.optionStack[^1].options + c.config.notes = c.optionStack[^1].notes + c.config.warningAsErrors = c.optionStack[^1].warningAsErrors + c.features = c.optionStack[^1].features + c.optionStack.setLen(c.optionStack.len - 1) proc newContext*(graph: ModuleGraph; module: PSym): PContext = new(result) - result.enforceVoidContext = PType(kind: tyStmt) - result.ambiguousSymbols = initIntSet() - result.optionStack = @[] + result.optionStack = @[newOptionEntry(graph.config)] result.libs = @[] - result.optionStack.add(newOptionEntry(graph.config)) result.module = module result.friendModules = @[module] 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.typesWithOps = @[] + result.signatures = initStrTable() result.features = graph.config.features - -proc inclSym(sq: var TSymSeq, s: PSym) = - var L = len(sq) - for i in countup(0, L - 1): - if sq[i].id == s.id: return - setLen(sq, L + 1) - sq[L] = s - -proc addConverter*(c: PContext, conv: PSym) = - inclSym(c.converters, conv) - -proc addPattern*(c: PContext, p: PSym) = - inclSym(c.patterns, p) + if graph.config.symbolFiles != disabledSf: + let id = module.position + 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 + +template packedRepr*(c): untyped = c.graph.packed[c.module.position].fromDisk +template encoder*(c): untyped = c.graph.encoders[c.module.position] + +proc addIncludeFileDep*(c: PContext; f: FileIndex) = + if c.config.symbolFiles != disabledSf: + addIncludeFileDep(c.encoder, c.packedRepr, f) + +proc addImportFileDep*(c: PContext; f: FileIndex) = + if c.config.symbolFiles != disabledSf: + addImportFileDep(c.encoder, c.packedRepr, f) + +proc addPragmaComputation*(c: PContext; n: PNode) = + if c.config.symbolFiles != disabledSf: + addPragmaComputation(c.encoder, c.packedRepr, n) + +proc inclSym(sq: var seq[PSym], s: PSym): bool = + for i in 0..<sq.len: + if sq[i].id == s.id: return false + sq.add s + result = true + +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) + +proc addPureEnum*(c: PContext, e: LazySym) = + assert e.sym != nil + add(c.graph.ifaces[c.module.position].pureEnums, e) + if c.config.symbolFiles != disabledSf: + addPureEnum(c.encoder, c.packedRepr, e.sym) + +proc addPattern*(c: PContext, p: LazySym) = + assert p.sym != nil + if inclSym(c.patterns, p.sym): + add(c.graph.ifaces[c.module.position].patterns, p) + if c.config.symbolFiles != disabledSf: + addTrmacro(c.encoder, c.packedRepr, p.sym) + +proc exportSym*(c: PContext; s: PSym) = + strTableAdds(c.graph, c.module, s) + if c.config.symbolFiles != disabledSf: + addExported(c.encoder, c.packedRepr, s) + +proc reexportSym*(c: PContext; s: PSym) = + 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, 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, idgen, owner, skipIntLit(baseType, idgen)) proc makePtrType*(c: PContext, baseType: PType): PType = - result = newTypeS(tyPtr, c) - addSonSkipIntLit(result, baseType) + makePtrType(getCurrOwner(c), baseType, c.idgen) proc makeTypeWithModifier*(c: PContext, modifier: TTypeKind, @@ -270,65 +415,62 @@ proc makeTypeWithModifier*(c: PContext, if modifier in {tyVar, tyLent, tyTypeDesc} and baseType.kind == modifier: result = baseType else: - result = newTypeS(modifier, c) - addSonSkipIntLit(result, baseType) + 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) - -proc makeTypeDesc*(c: PContext, typ: PType): PType = - if typ.kind == tyTypeDesc: - result = typ - else: - result = newTypeS(tyTypeDesc, c) - result.addSonSkipIntLit(typ) + result = newTypeS(kind, c, skipIntLit(baseType, c.idgen)) proc makeTypeSymNode*(c: PContext, typ: PType, info: TLineInfo): PNode = - let typedesc = makeTypeDesc(c, typ) - let sym = newSym(skType, c.cache.idAnon, getCurrOwner(c), info, + 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, c.idgen, getCurrOwner(c), info, c.config.options).linkTo(typedesc) - return newSymNode(sym, info) + result = newSymNode(sym, info) proc makeTypeFromExpr*(c: PContext, n: PNode): PType = result = newTypeS(tyFromExpr, c) assert n != nil result.n = n -proc newTypeWithSons*(owner: PSym, kind: TTypeKind, sons: seq[PType]): PType = - result = newType(kind, 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, 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) @@ -339,26 +481,22 @@ 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 proc nMinusOne(c: PContext; n: PNode): PNode = - result = newNode(nkCall, n.info, @[ - newSymNode(getSysMagic(c.graph, n.info, "pred", mPred)), n]) + result = newTreeI(nkCall, n.info, newSymNode(getSysMagic(c.graph, n.info, "pred", mPred)), n) # 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 = newNode(nkRange, n.info, @[ - newIntTypeNode(nkIntLit, 0, intType), - makeStaticExpr(c, nMinusOne(c, n))]) + result.n = newTreeI(nkRange, n.info, newIntTypeNode(0, intType), + makeStaticExpr(c, nMinusOne(c, n))) template rangeHasUnresolvedStatic*(t: PType): bool = tfUnresolved in t.flags @@ -366,11 +504,31 @@ template rangeHasUnresolvedStatic*(t: PType): bool = proc errorType*(c: PContext): PType = ## creates a type representing an error state result = newTypeS(tyError, c) + result.flags.incl tfCheckedForDestructor 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) @@ -380,11 +538,32 @@ proc makeRangeType*(c: PContext; first, last: BiggestInt; info: TLineInfo; intType: PType = nil): PType = let intType = if intType != nil: intType else: getSysType(c.graph, info, tyInt) var n = newNodeI(nkRange, info) - addSon(n, newIntTypeNode(nkIntLit, first, intType)) - addSon(n, newIntTypeNode(nkIntLit, last, intType)) + n.add newIntTypeNode(first, intType) + n.add newIntTypeNode(last, intType) result = newTypeS(tyRange, c) result.n = n - addSonSkipIntLit(result, intType) # basetype of range + 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}: @@ -398,10 +577,59 @@ proc illFormedAstLocal*(n: PNode; conf: ConfigRef) = localError(conf, n.info, errIllFormedAstX, renderTree(n, {renderNoComments})) proc checkSonsLen*(n: PNode, length: int; conf: ConfigRef) = - if sonsLen(n) != length: illFormedAst(n, conf) + if n.len != length: illFormedAst(n, conf) proc checkMinSonsLen*(n: PNode, length: int; conf: ConfigRef) = - if sonsLen(n) < length: illFormedAst(n, conf) + if n.len < length: illFormedAst(n, conf) 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)) + +proc popCaseContext*(c: PContext) = + discard pop(c.p.caseContext) + +proc setCaseContextIdx*(c: PContext, idx: int) = + c.p.caseContext[^1].idx = idx + +template addExport*(c: PContext; s: PSym) = + ## convenience to export a symbol from the current module + addExport(c.graph, c.module, s) + +proc storeRodNode*(c: PContext, n: PNode) = + if c.config.symbolFiles != disabledSf: + toPackedNodeTopLevel(n, c.encoder, c.packedRepr) + +proc addToGenericProcCache*(c: PContext; s: PSym; inst: PInstantiation) = + c.graph.procInstCache.mgetOrPut(s.itemId, @[]).add LazyInstantiation(module: c.module.position, inst: inst) + if c.config.symbolFiles != disabledSf: + storeInstantiation(c.encoder, c.packedRepr, s, inst) + +proc addToGenericCache*(c: PContext; s: PSym; inst: PType) = + c.graph.typeInstCache.mgetOrPut(s.itemId, @[]).add LazyType(typ: inst) + if c.config.symbolFiles != disabledSf: + storeTypeInst(c.encoder, c.packedRepr, s, inst) + +proc sealRodFile*(c: PContext) = + if c.config.symbolFiles != disabledSf: + if c.graph.vm != nil: + for (m, n) in PCtx(c.graph.vm).vmstateDiff: + 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 9d7c493a7..2885142a7 100644 --- a/compiler/semexprs.nim +++ b/compiler/semexprs.nim @@ -10,12 +10,15 @@ # this module does the semantic checking for expressions # included from sem.nim +when defined(nimCompilerStacktraceHints): + import std/stackframes + const errExprXHasNoType = "expression '$1' has no type (or is ambiguous)" errXExpectsTypeOrValue = "'$1' expects a type or value" errVarForOutParamNeededX = "for a 'var' type a variable needs to be passed; but '$1' is immutable" errXStackEscape = "address of '$1' may not escape its stack frame" - errExprHasNoAddress = "expression has no address; maybe use 'unsafeAddr'" + errExprHasNoAddress = "expression has no address" errCannotInterpretNodeX = "cannot evaluate '$1'" errNamedExprExpected = "named expression expected" errNamedExprNotAllowed = "named expression not allowed here" @@ -23,30 +26,34 @@ const errUndeclaredFieldX = "undeclared field: '$1'" proc semTemplateExpr(c: PContext, n: PNode, s: PSym, - flags: TExprFlags = {}): PNode = - markUsed(c.config, n.info, s, c.graph.usageSym) - styleCheckUse(n.info, s) - pushInfoContext(c.config, n.info) - result = evalTemplate(n, s, getCurrOwner(c), c.config, efFromHlo in flags) - if efNoSemCheck notin flags: result = semAfterMacroCall(c, n, result, s, flags) + flags: TExprFlags = {}; expectedType: PType = nil): PNode = + rememberExpansion(c, n.info, s) + let info = getCallLineInfo(n) + markUsed(c, info, s) + onUse(info, s) + # Note: This is n.info on purpose. It prevents template from creating an info + # context when called from an another template + pushInfoContext(c.config, n.info, s.detailedInfo) + 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, expectedType) popInfoContext(c.config) # XXX: A more elaborate line info rewrite might be needed - result.info = n.info + result.info = info proc semFieldAccess(c: PContext, n: PNode, flags: TExprFlags = {}): PNode +template rejectEmptyNode(n: PNode) = + # No matter what a nkEmpty node is not what we want here + if n.kind == nkEmpty: illFormedAst(n, c.config) + 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}) - #if result.kind == nkEmpty and result.typ.isNil: - # do not produce another redundant error message: - #raiseRecoverableError("") - # result = errorNode(c, n) + 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) @@ -55,24 +62,51 @@ proc semOperand(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = renderTree(result, {renderNoComments})) result.typ = errorType(c) -proc semExprWithType(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = - result = semExpr(c, n, flags+{efWantValue}) - if result.isNil or result.kind == nkEmpty: +proc semExprCheck(c: PContext, n: PNode, flags: TExprFlags, expectedType: PType = nil): PNode = + rejectEmptyNode(n) + result = semExpr(c, n, flags+{efWantValue}, expectedType) + + let + isEmpty = result.kind == nkEmpty + isTypeError = result.typ != nil and result.typ.kind == tyError + + if isEmpty or isTypeError: + # bug #12741, redundant error messages are the lesser evil here: + localError(c.config, n.info, errExprXHasNoType % + renderTree(result, {renderNoComments})) + + if isEmpty: # do not produce another redundant error message: - #raiseRecoverableError("") result = errorNode(c, n) - 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) proc semExprNoDeref(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = - result = semExpr(c, n, flags) - if result.kind == nkEmpty: - # do not produce another redundant error message: - result = errorNode(c, n) + result = semExprCheck(c, n, flags) if result.typ == nil: localError(c.config, n.info, errExprXHasNoType % renderTree(result, {renderNoComments})) @@ -81,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) @@ -94,7 +234,8 @@ type TConvStatus = enum convOK, convNotNeedeed, - convNotLegal + convNotLegal, + convNotInRange proc checkConversionBetweenObjects(castDest, src: PType; pointers: int): TConvStatus = let diff = inheritanceDiff(castDest, src) @@ -106,44 +247,79 @@ proc checkConversionBetweenObjects(castDest, src: PType; pointers: int): TConvSt const IntegralTypes = {tyBool, tyEnum, tyChar, tyInt..tyUInt64} -proc checkConvertible(c: PContext, castDest, src: PType): TConvStatus = +proc checkConvertible(c: PContext, targetTyp: PType, src: PNode): TConvStatus = + let srcTyp = src.typ.skipTypes({tyStatic}) result = convOK - if sameType(castDest, src) and castDest.sym == src.sym: + if sameType(targetTyp, srcTyp) and targetTyp.sym == srcTyp.sym: # don't annoy conversions that may be needed on another processor: - if castDest.kind notin IntegralTypes+{tyRange}: + if targetTyp.kind notin IntegralTypes+{tyRange}: result = convNotNeedeed return - var d = skipTypes(castDest, abstractVar) - var s = src + var d = skipTypes(targetTyp, abstractVar) + var s = srcTyp if s.kind in tyUserTypeClasses and s.isResolvedUserTypeClass: - s = s.lastSon - s = skipTypes(s, abstractVar-{tyTypeDesc}) + s = s.last + s = skipTypes(s, abstractVar-{tyTypeDesc, tyOwned}) + if s.kind == tyOwned and d.kind != tyOwned: + s = s.skipModifier var pointers = 0 - while (d != nil) and (d.kind in {tyPtr, tyRef}) and (d.kind == s.kind): - d = d.lastSon - s = s.lastSon + while (d != nil) and (d.kind in {tyPtr, tyRef, tyOwned}): + if s.kind == tyOwned and d.kind != tyOwned: + s = s.skipModifier + elif d.kind != s.kind: + break + else: + d = d.elementType + s = s.elementType inc pointers + + let targetBaseTyp = skipTypes(targetTyp, abstractVarRange) + let srcBaseTyp = skipTypes(srcTyp, abstractVarRange-{tyTypeDesc}) + if d == nil: result = convNotLegal - elif d.kind == tyObject and s.kind == tyObject: - result = checkConversionBetweenObjects(d, s, pointers) - elif (skipTypes(castDest, abstractVarRange).kind in IntegralTypes) and - (skipTypes(src, abstractVarRange-{tyTypeDesc}).kind in IntegralTypes): - # accept conversion between integral types - discard + elif d.skipTypes(abstractInst).kind == tyObject and s.skipTypes(abstractInst).kind == tyObject: + 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) and + targetTyp.kind notin {tyUInt..tyUInt64}: + result = convNotInRange + elif src.kind in nkFloatLit..nkFloat64Lit and + (classify(src.floatVal) in {fcNan, fcNegInf, fcInf} or + src.floatVal.int64 notin firstOrd(c.config, targetTyp)..lastOrd(c.config, targetTyp)): + result = convNotInRange + elif targetBaseTyp.kind in tyFloat..tyFloat64: + if src.kind in nkFloatLit..nkFloat64Lit and + not floatRangeCheck(src.floatVal, targetTyp): + result = convNotInRange + elif src.kind in nkCharLit..nkUInt64Lit and + not floatRangeCheck(src.intVal.float, targetTyp): + 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(castDest, src, dcEqIgnoreDistinct): + if not compareTypes(targetTyp.skipTypes(abstractVar), srcTyp.skipTypes({tyOwned}), dcEqIgnoreDistinct): result = convNotLegal else: discard -proc isCastable(conf: ConfigRef; 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, @@ -153,27 +329,38 @@ proc isCastable(conf: ConfigRef; dst, src: PType): bool = return false if skipTypes(src, abstractInst-{tyTypeDesc}).kind == tyTypeDesc: return false + if skipTypes(dst, abstractInst).kind == tyBuiltInTypeClass: + return false + let conf = c.config + 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) srcSize = computeSize(conf, src) + if dstSize == -3 or srcSize == -3: # szUnknownSize + # The Nim compiler can't detect if it's legal or not. + # 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) != 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 @@ -185,101 +372,145 @@ proc maybeLiftType(t: var PType, c: PContext, info: TLineInfo) = closeScope(c) if lifted != nil: t = lifted -proc semConv(c: PContext, n: PNode): PNode = - if sonsLen(n) != 2: +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; flags: TExprFlags = {}, expectedType: PType = nil): PNode = + if n.len != 2: localError(c.config, n.info, "a type conversion takes exactly one argument") return n result = newNodeI(nkConv, n.info) - var targetType = semTypeNode(c, n.sons[0], nil).skipTypes({tyTypeDesc}) + + var targetType = semTypeNode(c, n[0], nil) + case targetType.skipTypes({tyDistinct}).kind + of tyTypeDesc: + internalAssert c.config, targetType.len > 0 + if targetType.base.kind == tyNone: + return semTypeOf(c, n) + else: + targetType = targetType.base + of tyStatic: + 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) + return + elif targetType.base.kind == tyNone: + 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}: - let baseType = semTypeNode(c, n.sons[1], nil).skipTypes({tyTypeDesc}) - let t = newTypeS(targetType.kind, c) - t.rawAddSonNoPropagationOfTypeFlags baseType + if targetType.kind in {tySink, tyLent} or isOwnedSym(c, n[0]): + let baseType = semTypeNode(c, n[1], nil).skipTypes({tyTypeDesc}) + let t = newTypeS(targetType.kind, c, baseType) + if targetType.kind == tyOwned: + t.flags.incl tfHasOwned result = newNodeI(nkType, n.info) result.typ = makeTypeDesc(c, t) return - result.addSon copyTree(n.sons[0]) + result.add copyTree(n[0]) # special case to make MyObject(x = 3) produce a nicer error message: if n[1].kind == nkExprEqExpr and targetType.skipTypes(abstractPtrs).kind == tyObject: - localError(c.config, n.info, "object contruction uses ':', not '='") - var op = semExprWithType(c, n.sons[1]) - if targetType.isMetaType: + localError(c.config, n.info, "object construction uses ':', not '='") + 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.addSon final + result.add final result.typ = final.typ return result.typ = targetType # XXX op is overwritten later on, this is likely added too early # here or needs to be overwritten too then. - addSon(result, op) + result.add op + + 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 if not isSymChoice(op): - let status = checkConvertible(c, result.typ, op.typ) + let status = checkConvertible(c, result.typ, op) case status of convOK: # handle SomeProcType(SomeGenericProc) if op.kind == nkSym and op.sym.isGenericRoutine: - result.sons[1] = fitNode(c, result.typ, result.sons[1], result.info) + result[1] = fitNode(c, result.typ, result[1], result.info) 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.sons[1], result.info) + result = fitNode(c, result.typ, result[1], result.info) if result == nil: localError(c.config, n.info, "illegal conversion from '$1' to '$2'" % [op.typ.typeToString, result.typ.typeToString]) + of convNotInRange: + let value = + if op.kind in {nkCharLit..nkUInt64Lit}: $op.getInt else: $op.getFloat + localError(c.config, n.info, errGenerated, value & " can't be converted to " & + result.typ.typeToString) else: - for i in countup(0, sonsLen(op) - 1): - let it = op.sons[i] - let status = checkConvertible(c, result.typ, it.typ) + for i in 0..<op.len: + let it = op[i] + let status = checkConvertible(c, result.typ, it) if status in {convOK, convNotNeedeed}: - markUsed(c.config, n.info, it.sym, c.graph.usageSym) - styleCheckUse(n.info, it.sym) + markUsed(c, n.info, it.sym) + onUse(n.info, it.sym) markIndirect(c, it.sym) return it - errorUseQualifier(c, n.info, op.sons[0].sym) + errorUseQualifier(c, n.info, op[0].sym) proc semCast(c: PContext, n: PNode): PNode = ## Semantically analyze a casting ("cast[type](param)") checkSonsLen(n, 2, c.config) - let targetType = semTypeNode(c, n.sons[0], nil) - let castedExpr = semExprWithType(c, n.sons[1]) + 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.sons[0].info, "cannot cast to a non concrete type: '$1'" % $targetType) - if not isCastable(c.config, 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) + localError(c.config, n[0].info, "cannot cast to a non concrete type: '$1'" % $targetType) + 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 - addSon(result, copyTree(n.sons[0])) - addSon(result, castedExpr) + result.add copyTree(n[0]) + result.add castedExpr proc semLowHigh(c: PContext, n: PNode, m: TMagic): PNode = const opToStr: array[mLow..mHigh, string] = ["low", "high"] - if sonsLen(n) != 2: + if n.len != 2: localError(c.config, n.info, errXExpectsTypeOrValue % opToStr[m]) else: - n.sons[1] = semExprWithType(c, n.sons[1], {efDetermineType}) - var typ = skipTypes(n.sons[1].typ, abstractVarRange + {tyTypeDesc}) + 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.sons[0] # indextype - of tyInt..tyInt64, tyChar, tyBool, tyEnum, tyUInt8, tyUInt16, tyUInt32: - # do not skip the range! - n.typ = n.sons[1].typ.skipTypes(abstractVar) + 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: # prepare this for resolving in semtypinst: # we must use copyTree here in order to avoid creating a cycle @@ -289,104 +520,157 @@ proc semLowHigh(c: PContext, n: PNode, m: TMagic): PNode = localError(c.config, n.info, "invalid argument for: " & opToStr[m]) result = n -proc semSizeof(c: PContext, n: PNode): PNode = - if sonsLen(n) != 2: - localError(c.config, n.info, errXExpectsTypeOrValue % "sizeof") - else: - n.sons[1] = semExprWithType(c, n.sons[1], {efDetermineType}) - #restoreOldStyleType(n.sons[1]) - n.typ = getSysType(c.graph, n.info, tyInt) - result = n +proc fixupStaticType(c: PContext, n: PNode) = + # This proc can be applied to evaluated expressions to assign + # them a static type. + # + # XXX: with implicit static, this should not be necessary, + # because the output type of operations such as `semConstExpr` + # should be a static type (as well as the type of any other + # expression that can be implicitly evaluated). For now, we + # apply this measure only in code that is enlightened to work + # with static types. + if n.typ.kind != tyStatic: + n.typ = newTypeS(tyStatic, c, n.typ) + n.typ.n = n # XXX: cycles like the one here look dangerous. + # Consider using `n.copyTree` proc isOpImpl(c: PContext, n: PNode, flags: TExprFlags): PNode = - internalAssert c.config, n.sonsLen == 3 and - n[1].typ != nil and n[1].typ.kind == tyTypeDesc and + internalAssert c.config, + n.len == 3 and + n[1].typ != nil and n[2].kind in {nkStrLit..nkTripleStrLit, nkType} - let t1 = n[1].typ.skipTypes({tyTypeDesc}) + var + res = false + t1 = n[1].typ + t2 = n[2].typ + + if t1.kind == tyTypeDesc and t2.kind != tyTypeDesc: + t1 = t1.base if n[2].kind in {nkStrLit..nkTripleStrLit}: case n[2].strVal.normalize of "closure": let t = skipTypes(t1, abstractRange) - result = newIntNode(nkIntLit, ord(t.kind == tyProc and - t.callConv == ccClosure and - tfIterator notin t.flags)) + 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 + tfIterator in t.flags else: - result = newIntNode(nkIntLit, 0) + res = false else: - var rhsOrigType = n[2].typ - var t2 = rhsOrigType.skipTypes({tyTypeDesc}) - maybeLiftType(t2, c, n.info) - var m: TCandidate - initCandidate(c, m, t2) + if t1.skipTypes({tyGenericInst, tyAlias, tySink, tyDistinct}).kind != tyGenericBody: + maybeLiftType(t2, c, n.info) + else: + #[ + for this case: + type Foo = object[T] + Foo is Foo + ]# + discard + var m = newCandidate(c, t2) if efExplain in flags: m.diagnostics = @[] m.diagnosticsEnabled = true - let match = typeRel(m, t2, t1) >= isSubtype # isNone - result = newIntNode(nkIntLit, ord(match)) + res = typeRel(m, t2, t1) >= isSubtype # isNone + # `res = sameType(t1, t2)` would be wrong, e.g. for `int is (int|float)` + result = newIntNode(nkIntLit, ord(res)) result.typ = n.typ proc semIs(c: PContext, n: PNode, flags: TExprFlags): PNode = - if sonsLen(n) != 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 - n.typ = getSysType(c.graph, n.info, tyBool) + n.typ = boolType + var liftLhs = true - n.sons[1] = semExprWithType(c, n[1], {efDetermineType, efWantIterator}) + n[1] = semExprWithType(c, n[1], {efDetermineType, efWantIterator}) if n[2].kind notin {nkStrLit..nkTripleStrLit}: let t2 = semTypeNode(c, n[2], nil) - n.sons[2] = newNodeIT(nkType, n[2].info, t2) + n[2] = newNodeIT(nkType, n[2].info, t2) + if t2.kind == tyStatic: + let evaluated = tryConstExpr(c, n[1]) + if evaluated != nil: + c.fixupStaticType(evaluated) + n[1] = evaluated + else: + result = newIntNode(nkIntLit, 0) + result.typ = boolType + return + elif t2.kind == tyTypeDesc and + (t2.base.kind == tyNone or tfExplicit in t2.flags): + # When the right-hand side is an explicit type, we must + # not allow regular values to be matched against the type: + liftLhs = false + else: + n[2] = semExpr(c, n[2]) - let lhsType = n[1].typ + var lhsType = n[1].typ if lhsType.kind != tyTypeDesc: - n.sons[1] = makeTypeSymNode(c, lhsType, n[1].info) - elif lhsType.base.kind == tyNone: - # this is a typedesc variable, leave for evals - return + if liftLhs: + n[1] = makeTypeSymNode(c, lhsType, n[1].info) + lhsType = n[1].typ + else: + if c.inGenericContext > 0 and lhsType.base.containsUnresolvedType: + # BUGFIX: don't evaluate this too early: ``T is void`` + return - # BUGFIX: don't evaluate this too early: ``T is void`` - if not n[1].typ.base.containsGenericType: result = isOpImpl(c, n, flags) + result = isOpImpl(c, n, flags) proc semOpAux(c: PContext, n: PNode) = - const flags = {efDetermineType} - for i in countup(1, n.sonsLen-1): - var a = n.sons[i] - if a.kind == nkExprEqExpr and sonsLen(a) == 2: - let info = a.sons[0].info - a.sons[0] = newIdentNode(considerQuotedIdent(c, a.sons[0], a), info) - a.sons[1] = semExprWithType(c, a.sons[1], flags) - a.typ = a.sons[1].typ + const flags = {efDetermineType, efAllowSymChoice} + for i in 1..<n.len: + var a = n[i] + if a.kind == nkExprEqExpr and a.len == 2: + let info = a[0].info + a[0] = newIdentNode(considerQuotedIdent(c, a[0], a), info) + a[1] = semExprWithType(c, a[1], flags) + a.typ = a[1].typ else: - n.sons[i] = semExprWithType(c, a, flags) + n[i] = semExprWithType(c, a, flags) proc overloadedCallOpr(c: PContext, n: PNode): PNode = # quick check if there is *any* () operator overloaded: var par = getIdent(c.cache, "()") - if searchInScopes(c, par) == nil: + var amb = false + if searchInScopes(c, par, amb) == nil: result = nil else: result = newNodeI(nkCall, n.info) - addSon(result, newIdentNode(par, n.info)) - for i in countup(0, sonsLen(n) - 1): addSon(result, n.sons[i]) - result = semExpr(c, result) + result.add newIdentNode(par, n.info) + for i in 0..<n.len: result.add n[i] + result = semExpr(c, result, flags = {efNoUndeclared}) proc changeType(c: PContext; n: PNode, newType: PType, check: bool) = case n.kind - of nkCurly, nkBracket: - for i in countup(0, sonsLen(n) - 1): - changeType(c, n.sons[i], elemType(newType), check) + 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: - let tup = newType.skipTypes({tyGenericInst, tyAlias, tySink}) + let tup = newType.skipTypes({tyGenericInst, tyAlias, tySink, tyDistinct}) if tup.kind != tyTuple: if tup.kind == tyObject: return globalError(c.config, n.info, "no tuple type for constructor") - elif sonsLen(n) > 0 and n.sons[0].kind == nkExprColonExpr: + elif n.len > 0 and n[0].kind == nkExprColonExpr: # named tuple? - for i in countup(0, sonsLen(n) - 1): - var m = n.sons[i].sons[0] + for i in 0..<n.len: + var m = n[i][0] if m.kind != nkSym: globalError(c.config, m.info, "invalid tuple constructor") return @@ -395,106 +679,212 @@ proc changeType(c: PContext; n: PNode, newType: PType, check: bool) = if f == nil: globalError(c.config, m.info, "unknown identifier: " & m.sym.name.s) return - changeType(c, n.sons[i].sons[1], f.typ, check) + changeType(c, n[i][1], f.typ, check) else: - changeType(c, n.sons[i].sons[1], tup.sons[i], check) + changeType(c, n[i][1], tup[i], check) else: - for i in countup(0, sonsLen(n) - 1): - changeType(c, n.sons[i], tup.sons[i], check) + for i in 0..<n.len: + changeType(c, n[i], tup[i], check) when false: - var m = n.sons[i] - var a = newNodeIT(nkExprColonExpr, m.info, newType.sons[i]) - addSon(a, newSymNode(newType.n.sons[i].sym)) - addSon(a, m) - changeType(m, tup.sons[i], check) + var m = n[i] + var a = newNodeIT(nkExprColonExpr, m.info, newType[i]) + a.add newSymNode(newType.n[i].sym) + a.add m + changeType(m, tup[i], check) of nkCharLit..nkUInt64Lit: - if check and n.kind != nkUInt64Lit: + 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, 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 proc arrayConstrType(c: PContext, n: PNode): PType = var typ = newTypeS(tyArray, c) rawAddSon(typ, nil) # index type - if sonsLen(n) == 0: + if n.len == 0: rawAddSon(typ, newTypeS(tyEmpty, c)) # needs an empty basetype! else: - var t = skipTypes(n.sons[0].typ, {tyGenericInst, tyVar, tyLent, tyOrdinal, tyAlias, tySink}) - addSonSkipIntLit(typ, t) - typ.sons[0] = makeRangeType(c, 0, sonsLen(n) - 1, n.info) + var t = skipTypes(n[0].typ, {tyGenericInst, tyVar, tyLent, tyOrdinal, tyAlias, tySink}) + addSonSkipIntLit(typ, t, c.idgen) + 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 - if sonsLen(n) == 0: - rawAddSon(result.typ, newTypeS(tyEmpty, c)) # needs an empty basetype! + # 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 = Zero + indexType = getSysType(c.graph, n.info, tyInt) + lastValidIndex = lastOrd(c.config, indexType) + if n.len == 0: + 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.sons[0] - var lastIndex: BiggestInt = 0 - var indexType = getSysType(c.graph, n.info, tyInt) - if x.kind == nkExprColonExpr and sonsLen(x) == 2: - var idx = semConstExpr(c, x.sons[0]) - lastIndex = getOrdValue(idx) - indexType = idx.typ - x = x.sons[1] - - let yy = semExprWithType(c, x) - var typ = yy.typ - addSon(result, yy) - #var typ = skipTypes(result.sons[0].typ, {tyGenericInst, tyVar, tyLent, tyOrdinal}) - for i in countup(1, sonsLen(n) - 1): - x = n.sons[i] - if x.kind == nkExprColonExpr and sonsLen(x) == 2: - var idx = semConstExpr(c, x.sons[0]) + var x = n[0] + if x.kind == nkExprColonExpr and x.len == 2: + 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)) + else: + firstIndex = getOrdValue(idx) + lastIndex = firstIndex + indexType = idx.typ + lastValidIndex = lastOrd(c.config, indexType) + x = x[1] + + 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: + if lastIndex == lastValidIndex: + let validIndex = makeRangeType(c, toInt64(firstIndex), toInt64(lastValidIndex), n.info, + indexType) + localError(c.config, n.info, "size of array exceeds range of index " & + "type '$1' by $2 elements" % [typeToString(validIndex), $(n.len-i)]) + + x = n[i] + if x.kind == nkExprColonExpr and x.len == 2: + 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.sons[1] + x = x[1] - let xx = semExprWithType(c, x, flags*{efAllowDestructor}) + let xx = semExprWithType(c, x, {efTypeAllowed}, expectedElementType) result.add xx - typ = commonType(typ, xx.typ) - #n.sons[i] = semExprWithType(c, x, flags*{efAllowDestructor}) - #addSon(result, fitNode(c, typ, n.sons[i])) + 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) - for i in 0 ..< result.len: - result.sons[i] = fitNode(c, typ, result.sons[i], result.sons[i].info) - result.typ.sons[0] = makeRangeType(c, 0, sonsLen(result) - 1, n.info) + if constructType: + addSonSkipIntLit(result.typ, typ, c.idgen) + for i in 0..<result.len: + result[i] = fitNode(c, typ, result[i], result[i].info) + 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.sons[i] + 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.sons[1].typ, abstractVar).kind in + if skipTypes(it[1].typ, abstractVar).kind in {tyNil, tyTuple, tySet} or it[1].isArrayConstr: - var s = skipTypes(it.typ, abstractVar) - if s.kind != tyExpr: - changeType(c, it.sons[1], s, check=true) - n.sons[i] = it.sons[1] - -proc isAssignable(c: PContext, n: PNode; isUnsafeAddr=false): TAssignableResult = - result = parampatterns.isAssignable(c.p.owner, n, isUnsafeAddr) + 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): 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 sfTemplateParam in s.flags)) or + (s.kind == skType and + s.typ.flags * {tfGenericTypeParam, tfImplicitTypeParam} != {}) + +proc hasUnresolvedArgs(c: PContext, n: PNode): bool = + # Checks whether an expression depends on generic parameters that + # don't have bound values yet. E.g. this could happen in situations + # such as: + # type Slot[T] = array[T.size, byte] + # proc foo[T](x: default(T)) + # + # Both static parameter and type parameters can be unresolved. + case n.kind + of nkSym: + return isUnresolvedSym(n.sym) + of nkIdent, nkAccQuoted: + let ident = considerQuotedIdent(c, n) + var amb = false + let sym = searchInScopes(c, ident, amb) + if sym != nil: + return isUnresolvedSym(sym) + else: + return false + else: + for i in 0..<n.safeLen: + if hasUnresolvedArgs(c, n[i]): return true + return false -proc newHiddenAddrTaken(c: PContext, n: PNode): PNode = - if n.kind == nkHiddenDeref and not (c.config.cmd == cmdCompileToCpp or +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) - result = n.sons[0] + result = n[0] else: result = newNodeIT(nkHiddenAddr, n.info, makeVarType(c, n.typ)) - addSon(result, n) - if isAssignable(c, n) notin {arLValue, arLocalLValue}: - localError(c.config, n.info, errVarForOutParamNeededX % renderNotLValue(n)) + result.add 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: @@ -502,44 +892,59 @@ 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.sons[1].kind != nkSym: + if n[1].kind != nkSym: internalError(c.config, n.info, "analyseIfAddressTaken") return - if skipTypes(n.sons[1].sym.typ, abstractInst-{tyTypeDesc}).kind notin {tyVar, tyLent}: - incl(n.sons[1].sym.flags, sfAddrTaken) - result = newHiddenAddrTaken(c, n) + if skipTypes(n[1].sym.typ, abstractInst-{tyTypeDesc}).kind notin {tyVar, tyLent}: + incl(n[1].sym.flags, sfAddrTaken) + result = newHiddenAddrTaken(c, n, isOutParam) of nkBracketExpr: checkMinSonsLen(n, 1, c.config) - if skipTypes(n.sons[0].typ, abstractInst-{tyTypeDesc}).kind notin {tyVar, tyLent}: - if n.sons[0].kind == nkSym: incl(n.sons[0].sym.flags, sfAddrTaken) - result = newHiddenAddrTaken(c, n) + 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, 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} - + 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.sons[0].typ.skipTypes({tyGenericInst, tyAlias, tySink}) - - if n.sons[0].kind == nkSym and n.sons[0].sym.magic in FakeVarParams: + 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: - for i in countup(1, sonsLen(n) - 1): - if i < sonsLen(t) and t.sons[i] != nil and - skipTypes(t.sons[i], abstractInst-{tyTypeDesc}).kind == tyVar: + for i in 1..<n.len: + 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 @@ -549,22 +954,22 @@ proc analyseIfAddressTakenInCall(c: PContext, n: PNode) = localError(c.config, n.info, errXStackEscape % renderTree(n[1], {renderNoComments})) return - for i in countup(1, sonsLen(n) - 1): - if n.sons[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.sons[i]) - if i < sonsLen(t) and - skipTypes(t.sons[i], abstractInst-{tyTypeDesc}).kind == tyVar: - if n.sons[i].kind != nkHiddenAddr: - n.sons[i] = analyseIfAddressTaken(c, n.sons[i]) + for i in 1..<n.len: + let n = if n.kind == nkHiddenDeref: n[0] else: n + c.checkIfConverterCalled(n[i]) + if i < t.len and + skipTypes(t[i], abstractInst-{tyTypeDesc}).kind in {tyVar}: + # 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 proc evalAtCompileTime(c: PContext, n: PNode): PNode = result = n - if n.kind notin nkCallKinds or n.sons[0].kind != nkSym: return - var callee = n.sons[0].sym + if n.kind notin nkCallKinds or n[0].kind != nkSym: return + var callee = n[0].sym # workaround for bug #537 (overly aggressive inlining leading to # wrong NimNode semantics): if n.typ != nil and tfTriggersCompileTime in n.typ.flags: return @@ -572,17 +977,17 @@ proc evalAtCompileTime(c: PContext, n: PNode): PNode = # constant folding that is necessary for correctness of semantic pass: if callee.magic != mNone and callee.magic in ctfeWhitelist and n.typ != nil: var call = newNodeIT(nkCall, n.info, n.typ) - call.add(n.sons[0]) + call.add(n[0]) var allConst = true - for i in 1 ..< n.len: - var a = getConstExpr(c.module, n.sons[i], c.graph) + for i in 1..<n.len: + var a = getConstExpr(c.module, n[i], c.idgen, c.graph) if a == nil: allConst = false - a = n.sons[i] - if a.kind == nkHiddenStdConv: a = a.sons[1] + a = n[i] + if a.kind == nkHiddenStdConv: a = a[1] call.add(a) if allConst: - result = semfold.getConstExpr(c.module, call, c.graph) + result = semfold.getConstExpr(c.module, call, c.idgen, c.graph) if result.isNil: result = n else: return result @@ -592,49 +997,62 @@ proc evalAtCompileTime(c: PContext, n: PNode): PNode = # done until we have a more robust infrastructure for # implicit statics. if n.len > 1: - for i in 1 ..< n.len: + for i in 1..<n.len: # see bug #2113, it's possible that n[i].typ for errornous code: 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 - if {sfNoSideEffect, sfCompileTime} * callee.flags != {} and + if callee.kind == skConst or + {sfNoSideEffect, sfCompileTime} * callee.flags != {} and {sfForward, sfImportc} * callee.flags == {} and n.typ != nil: - if sfCompileTime notin callee.flags and - optImplicitStatic notin c.config.options: return + + if callee.kind != skConst and + sfCompileTime notin callee.flags and + optImplicitStatic notin c.config.options: return if callee.magic notin ctfeWhitelist: return - if callee.kind notin {skProc, skFunc, skConverter} or callee.isGenericRoutine: + + if callee.kind notin {skProc, skFunc, skConverter, skConst} or + callee.isGenericRoutineStrict: return - if n.typ != nil and typeAllowed(n.typ, skConst) != nil: return + if n.typ != nil and typeAllowed(n.typ, skConst, c) != nil: return var call = newNodeIT(nkCall, n.info, n.typ) - call.add(n.sons[0]) - for i in 1 ..< n.len: - let a = getConstExpr(c.module, n.sons[i], c.graph) + call.add(n[0]) + for i in 1..<n.len: + let a = getConstExpr(c.module, n[i], c.idgen, c.graph) if a == nil: return n call.add(a) + #echo "NOW evaluating at compile time: ", call.renderTree - if sfCompileTime in callee.flags: - result = evalStaticExpr(c.module, c.graph, call, c.p.owner) - if result.isNil: - localError(c.config, n.info, errCannotInterpretNodeX % renderTree(call)) - else: result = fixupTypeAfterEval(c, result, n) + if c.inStaticContext == 0 or sfNoSideEffect in callee.flags: + if sfCompileTime in callee.flags: + result = evalStaticExpr(c.module, c.idgen, c.graph, call, c.p.owner) + if result.isNil: + localError(c.config, n.info, errCannotInterpretNodeX % renderTree(call)) + else: result = fixupTypeAfterEval(c, result, n) + else: + result = evalConstExpr(c.module, c.idgen, c.graph, call) + if result.isNil: result = n + else: result = fixupTypeAfterEval(c, result, n) else: - result = evalConstExpr(c.module, c.graph, call) - if result.isNil: result = n - else: result = fixupTypeAfterEval(c, result, n) + result = n #if result != n: # echo "SUCCESS evaluated at compile time: ", call.renderTree -proc semStaticExpr(c: PContext, n: PNode): PNode = - let a = semExpr(c, n.sons[0]) +proc semStaticExpr(c: PContext, n: PNode; expectedType: PType = nil): PNode = + inc c.inStaticContext + openScope(c) + let a = semExprWithType(c, n, expectedType = expectedType) + closeScope(c) + dec c.inStaticContext if a.findUnresolvedStatic != nil: return a - result = evalStaticExpr(c.module, c.graph, a, c.p.owner) + result = evalStaticExpr(c.module, c.idgen, c.graph, a, c.p.owner) if result.isNil: localError(c.config, n.info, errCannotInterpretNodeX % renderTree(n)) result = c.graph.emptyNode @@ -642,105 +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 ``type(countup(1,3))``, see ``tests/ttoseq``. + # 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.sons[0].kind != nkSym: - internalError(c.config, "semOverloadedCallAnalyseEffects") + if result[0].kind != nkSym: + if not (c.inGenericContext > 0): # see generic context check in semOverloadedCall + internalError(c.config, "semOverloadedCallAnalyseEffects") return - let callee = result.sons[0].sym + let callee = result[0].sym case callee.kind of skMacro, skTemplate: discard else: - if callee.kind == skIterator and callee.id == c.p.owner.id: - localError(c.config, n.info, errRecursiveDependencyX % callee.name.s) + 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.sons[0] = newSymNode(errorSym(c, n)) - -proc semObjConstr(c: PContext, n: PNode, flags: TExprFlags): PNode + result[0] = newSymNode(errorSym(c, n)) + 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.sons[1] = n.sons[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 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 -proc afterCallActions(c: PContext; n, orig: PNode, flags: TExprFlags): PNode = result = n - let callee = result.sons[0].sym + + 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) - if result.typ != nil: liftTypeBoundOps(c, result.typ, n.info) + result = magicsAfterOverloadResolution(c, result, flags, expectedType) + when false: + if result.typ != nil and + 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.sons[0] - if n.sons[0].kind == nkDotExpr: - checkSonsLen(n.sons[0], 2, c.config) - let n0 = semFieldAccess(c, n.sons[0]) + var prc = n[0] + if n[0].kind == nkDotExpr: + checkSonsLen(n[0], 2, c.config) + let n0 = semFieldAccess(c, n[0], {efIsDotCall}) if n0.kind == nkDotCall: # it is a static call! result = n0 - result.kind = nkCall + result.transitionSonsKind(nkCall) result.flags.incl nfExplicitCall - for i in countup(1, sonsLen(n) - 1): addSon(result, n.sons[i]) - return semExpr(c, result, flags) + for i in 1..<n.len: result.add n[i] + return semExpr(c, result, flags, expectedType) + elif n0.typ.kind == tyFromExpr and c.inGenericContext > 0: + # don't make assumptions, entire expression needs to be tyFromExpr + result = semGenericStmt(c, n) + result.typ = makeTypeFromExpr(c, result.copyTree) + return else: - n.sons[0] = n0 + n[0] = n0 else: - n.sons[0] = semExpr(c, n.sons[0], {efInCall}) - let t = n.sons[0].typ + n[0] = semExpr(c, n[0], {efInCall, efAllowSymChoice}) + let t = n[0].typ if t != nil and t.kind in {tyVar, tyLent}: - n.sons[0] = newDeref(n.sons[0]) - elif n.sons[0].kind == nkBracketExpr: - let s = bracketedMacro(n.sons[0]) - if s != nil: - setGenericParams(c, n[0]) - return semDirectOp(c, n, flags) + n[0] = newDeref(n[0]) + 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) + + 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) - var t: PType = nil - if n.sons[0].typ != nil: - t = skipTypes(n.sons[0].typ, abstractInst-{tyTypeDesc}) if t != nil and t.kind == tyProc: # This is a proc variable, apply normal overload resolution let m = resolveIndirectCall(c, n, nOrig, t) @@ -752,34 +1211,41 @@ proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode = else: var hasErrorType = false var msg = "type mismatch: got <" - for i in countup(1, sonsLen(n) - 1): - if i > 1: add(msg, ", ") - let nt = n.sons[i].typ - add(msg, typeToString(nt)) + for i in 1..<n.len: + if i > 1: msg.add(", ") + let nt = n[i].typ + msg.add(typeToString(nt)) if nt.kind == tyError: hasErrorType = true break if not hasErrorType: - add(msg, ">\nbut expected one of: \n" & - typeToString(n.sons[0].typ)) + let typ = n[0].typ + msg.add(">\nbut expected one of:\n" & + typeToString(typ)) + # prefer notin preferToResolveSymbols + # t.sym != nil + # sfAnon notin t.sym.flags + # t.kind != tySequence(It is tyProc) + if typ.sym != nil and sfAnon notin typ.sym.flags and + typ.kind == tyProc: + # when can `typ.sym != nil` ever happen? + msg.add(" = " & typeToString(typ, preferDesc)) + 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.sons[0] = prc - nOrig.sons[0] = prc + n[0] = prc + nOrig[0] = prc n.flags.incl nfExprCall result = semOverloadedCallAnalyseEffects(c, n, nOrig, flags) if result == nil: return errorNode(c, n) @@ -788,48 +1254,38 @@ proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode = # See bug #904 of how to trigger it: return result #result = afterCallActions(c, result, nOrig, flags) - if result.sons[0].kind == nkSym: - result = afterCallActions(c, result, nOrig, flags) + if result[0].kind == nkSym: + 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 = # we MUST not check 'n' for semantics again here! But for now we give up: result = newNodeI(nkCall, n.info) - var e = strTableGet(c.graph.systemModule.tab, getIdent(c.cache, "echo")) + let e = systemModuleSym(c.graph, getIdent(c.cache, "echo")) if e != nil: - add(result, newSymNode(e)) + result.add(newSymNode(e)) else: - localError(c.config, n.info, "system needs: echo") - add(result, errorNode(c, n)) - add(result, 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 = + let isPush = c.config.hasHint(hintExtendedContext) + if isPush: pushInfoContext(c.config, n.info) result = semExpr(c, n, {efWantStmt}) - # make an 'if' expression an 'if' statement again for backwards - # compatibility (.discardable was a bad idea!); bug #6980 - var isStmt = false - if result.kind == nkIfExpr: - isStmt = true - for condActionPair in result: - let action = condActionPair.lastSon - if not implicitlyDiscardable(action) and not - endsInNoReturn(action): - isStmt = false - if isStmt: - result.kind = nkIfStmt - result.typ = nil - discardCheck(c, result) + discardCheck(c, result, {}) + if isPush: popInfoContext(c.config) proc isTypeExpr(n: PNode): bool = case n.kind @@ -849,50 +1305,50 @@ proc lookupInRecordAndBuildCheck(c: PContext, n, r: PNode, field: PIdent, result = nil case r.kind of nkRecList: - for i in countup(0, sonsLen(r) - 1): - result = lookupInRecordAndBuildCheck(c, n, r.sons[i], field, check) + for i in 0..<r.len: + result = lookupInRecordAndBuildCheck(c, n, r[i], field, check) if result != nil: return of nkRecCase: checkMinSonsLen(r, 2, c.config) - if (r.sons[0].kind != nkSym): illFormedAst(r, c.config) - result = lookupInRecordAndBuildCheck(c, n, r.sons[0], field, check) + if (r[0].kind != nkSym): illFormedAst(r, c.config) + result = lookupInRecordAndBuildCheck(c, n, r[0], field, check) if result != nil: return - let setType = createSetType(c, r.sons[0].typ) + let setType = createSetType(c, r[0].typ) var s = newNodeIT(nkCurly, r.info, setType) - for i in countup(1, sonsLen(r) - 1): - var it = r.sons[i] + for i in 1..<r.len: + var it = r[i] case it.kind of nkOfBranch: result = lookupInRecordAndBuildCheck(c, n, lastSon(it), field, check) if result == nil: - for j in 0..sonsLen(it)-2: addSon(s, copyTree(it.sons[j])) + for j in 0..<it.len-1: s.add copyTree(it[j]) else: if check == nil: check = newNodeI(nkCheckedFieldExpr, n.info) - addSon(check, c.graph.emptyNode) # make space for access node + check.add c.graph.emptyNode # make space for access node s = newNodeIT(nkCurly, n.info, setType) - for j in countup(0, sonsLen(it) - 2): addSon(s, copyTree(it.sons[j])) + for j in 0..<it.len - 1: s.add copyTree(it[j]) var inExpr = newNodeIT(nkCall, n.info, getSysType(c.graph, n.info, tyBool)) - addSon(inExpr, newSymNode(c.graph.opContains, n.info)) - addSon(inExpr, s) - addSon(inExpr, copyTree(r.sons[0])) - addSon(check, inExpr) - #addSon(check, semExpr(c, inExpr)) + inExpr.add newSymNode(getSysMagic(c.graph, n.info, "contains", mInSet), n.info) + inExpr.add s + inExpr.add copyTree(r[0]) + check.add inExpr + #check.add semExpr(c, inExpr) return of nkElse: result = lookupInRecordAndBuildCheck(c, n, lastSon(it), field, check) if result != nil: if check == nil: check = newNodeI(nkCheckedFieldExpr, n.info) - addSon(check, c.graph.emptyNode) # make space for access node + check.add c.graph.emptyNode # make space for access node var inExpr = newNodeIT(nkCall, n.info, getSysType(c.graph, n.info, tyBool)) - addSon(inExpr, newSymNode(c.graph.opContains, n.info)) - addSon(inExpr, s) - addSon(inExpr, copyTree(r.sons[0])) + inExpr.add newSymNode(getSysMagic(c.graph, n.info, "contains", mInSet), n.info) + inExpr.add s + inExpr.add copyTree(r[0]) var notExpr = newNodeIT(nkCall, n.info, getSysType(c.graph, n.info, tyBool)) - addSon(notExpr, newSymNode(c.graph.opNot, n.info)) - addSon(notExpr, inExpr) - addSon(check, notExpr) + notExpr.add newSymNode(getSysMagic(c.graph, n.info, "not", mNot), n.info) + notExpr.add inExpr + check.add notExpr return else: illFormedAst(it, c.config) of nkSym: @@ -901,7 +1357,7 @@ proc lookupInRecordAndBuildCheck(c: PContext, n, r: PNode, field: PIdent, const tyTypeParamsHolders = {tyGenericInst, tyCompositeTypeClass} - tyDotOpTransparent = {tyVar, tyLent, tyPtr, tyRef, tyAlias, tySink} + tyDotOpTransparent = {tyVar, tyLent, tyPtr, tyRef, tyOwned, tyAlias, tySink} proc readTypeParameter(c: PContext, typ: PType, paramName: PIdent, info: TLineInfo): PNode = @@ -919,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).linkTo(foundType), info) + return newSymNode(copySym(def[0].sym, c.idgen).linkTo(foundType), info) of nkConstSection: for def in statement: @@ -930,13 +1386,13 @@ proc readTypeParameter(c: PContext, typ: PType, discard if typ.kind != tyUserTypeClass: - let ty = if typ.kind == tyCompositeTypeClass: typ.sons[1].skipGenericAlias + let ty = if typ.kind == tyCompositeTypeClass: typ.firstGenericParam.skipGenericAlias else: typ.skipGenericAlias - let tbody = ty.sons[0] - for s in countup(0, tbody.len-2): - let tParam = tbody.sons[s] + let tbody = ty[0] + for s in 0..<tbody.len-1: + let tParam = tbody[s] if tParam.sym.name.id == paramName.id: - let rawTyp = ty.sons[s + 1] + let rawTyp = ty[s + 1] if rawTyp.kind == tyStatic: if rawTyp.n != nil: return rawTyp.n @@ -944,18 +1400,22 @@ proc readTypeParameter(c: PContext, typ: PType, return c.graph.emptyNode else: let foundTyp = makeTypeDesc(c, rawTyp) - return newSymNode(copySym(tParam.sym).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.config, n.info, s, c.graph.usageSym) - styleCheckUse(n.info, s) - case skipTypes(s.typ, abstractInst-{tyTypeDesc}).kind - of tyNil, tyChar, tyInt..tyInt64, tyFloat..tyFloat128, + 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, tyTuple, tySet, tyUInt..tyUInt64: if s.magic == mNone: result = inlineConst(c, n, s) else: result = newSymNode(s, n.info) @@ -970,59 +1430,55 @@ 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.len == 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: + result = typ.n + result.typ = typ.base + else: + 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.config, n.info, s, c.graph.usageSym) - styleCheckUse(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: - markUsed(c.config, n.info, s, c.graph.usageSym) - styleCheckUse(n.info, s) + 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.config, n.info, s, c.graph.usageSym) - styleCheckUse(n.info, s) + markUsed(c, n.info, s) + onUse(n.info, s) if s.typ != nil and s.typ.kind == tyStatic and s.typ.n != nil: # XXX see the hack in sigmatch.nim ... return s.typ.n elif sfGenSym in s.flags: - if c.p.wasForwarded: - # gensym'ed parameters that nevertheless have been forward declared - # need a special fixup: - let realParam = c.p.owner.typ.n[s.position+1] - internalAssert c.config, realParam.kind == nkSym and realParam.sym.kind == skParam - return newSymNode(c.p.owner.typ.n[s.position+1].sym, n.info) - elif c.p.owner.kind == skMacro: - # gensym'ed macro parameters need a similar hack (see bug #1944): - var u = searchInScopes(c, s.name) - internalAssert c.config, u != nil and u.kind == skParam and u.owner == s.owner - return newSymNode(u, n.info) + # the owner should have been set by now by addParamOrResult + internalAssert c.config, s.owner != nil result = newSymNode(s, n.info) of skVar, skLet, skResult, skForVar: if s.magic == mNimvm: localError(c.config, n.info, "illegal context for 'nimvm' magic") - markUsed(c.config, n.info, s, c.graph.usageSym) - styleCheckUse(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: - styleCheckUse(n.info, s) + onUse(n.info, s) if s.typ.kind == tyStatic: result = newSymNode(s, n.info) result.typ = s.typ @@ -1032,56 +1488,101 @@ proc semSym(c: PContext, n: PNode, sym: PSym, flags: TExprFlags): PNode = n.typ = s.typ return n of skType: - markUsed(c.config, n.info, s, c.graph.usageSym) - styleCheckUse(n.info, s) - if s.typ.kind == tyStatic and s.typ.n != nil: + 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}) - 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.config, n.info, f, c.graph.usageSym) - styleCheckUse(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.sons[0] = result - check.typ = result.typ - result = check - return result - if ty.sons[0] == nil: break - ty = skipTypes(ty.sons[0], skipPtrs) # old code, not sure if it's live code: - markUsed(c.config, n.info, s, c.graph.usageSym) - styleCheckUse(n.info, s) + markUsed(c, n.info, s) + onUse(n.info, s) result = newSymNode(s, n.info) - else: - markUsed(c.config, n.info, s, c.graph.usageSym) - styleCheckUse(n.info, s) + 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: + markUsed(c, info, s) + onUse(info, s) + result = newSymNode(s, info) -proc builtinFieldAccess(c: PContext, n: PNode, flags: TExprFlags): PNode = +proc tryReadingGenericParam(c: PContext, n: PNode, i: PIdent, t: PType): PNode = + case t.kind + of tyGenericInst: + result = readTypeParameter(c, t, i, n.info) + if result == c.graph.emptyNode: + 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: + result = nil + of tyGenericBody, tyCompositeTypeClass: + if c.inGenericContext > 0: + result = readTypeParameter(c, t, i, n.info) + if result != nil: + # generic parameter exists, stop here but delay until instantiation + result = semGenericStmt(c, n) + result.typ = makeTypeFromExpr(c, copyTree(result)) + else: + result = nil + elif c.inGenericContext > 0 and t.containsUnresolvedType: + result = semGenericStmt(c, n) + result.typ = makeTypeFromExpr(c, copyTree(result)) + else: + result = nil + +proc tryReadingTypeField(c: PContext, n: PNode, i: PIdent, ty: PType): PNode = + result = nil + var ty = ty.skipTypes(tyDotOpTransparent) + case ty.kind + of tyEnum: + # look up if the identifier belongs to the enum: + var f = PSym(nil) + while ty != nil: + f = getSymFromList(ty.n, i) + if f != nil: break + ty = ty[0] # enum inheritance + if f != nil: + result = newSymNode(f) + result.info = n.info + result.typ = ty + markUsed(c, n.info, f) + onUse(n.info, f) + of tyObject, tyTuple: + if ty.n != nil and ty.n.kind == nkRecList: + let field = lookupInRecord(ty.n, i) + if field != nil: + n.typ = makeTypeDesc(c, field.typ) + result = n + of tyGenericInst: + 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: 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 # work without now. template/tsymchoicefield doesn't like an early exit # here at all! - #if isSymChoice(n.sons[1]): return + #if isSymChoice(n[1]): return when defined(nimsuggest): if c.config.cmd == cmdIdeTools: suggestExpr(c, n) @@ -1093,40 +1594,19 @@ proc builtinFieldAccess(c: PContext, n: PNode, flags: TExprFlags): PNode = result = symChoice(c, n, s, scClosed) if result.kind == nkSym: result = semSym(c, n, s, flags) else: - markUsed(c.config, n.sons[1].info, s, c.graph.usageSym) + markUsed(c, n[1].info, s) result = semSym(c, n, s, flags) - styleCheckUse(n.sons[1].info, s) + onUse(n[1].info, s) return - n.sons[0] = semExprWithType(c, n.sons[0], flags+{efDetermineType}) - #restoreOldStyleType(n.sons[0]) - var i = considerQuotedIdent(c, n.sons[1], n) - var ty = n.sons[0].typ + # 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 var f: PSym = nil result = nil - template tryReadingGenericParam(t: PType) = - case t.kind - of tyTypeParamsHolders: - result = readTypeParameter(c, t, i, n.info) - if result == c.graph.emptyNode: - result = n - n.typ = makeTypeFromExpr(c, n.copyTree) - return - of tyUserTypeClasses: - if t.isResolvedUserTypeClass: - return readTypeParameter(c, t, i, n.info) - else: - n.typ = makeTypeFromExpr(c, copyTree(n)) - return n - of tyGenericParam, tyAnything: - n.typ = makeTypeFromExpr(c, copyTree(n)) - return n - else: - discard - - var argIsType = false - if ty.kind == tyTypeDesc: if ty.base.kind == tyNone: # This is a still unresolved typedesc parameter. @@ -1135,149 +1615,183 @@ 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: - ty = ty.base - argIsType = true - else: - argIsType = isTypeExpr(n.sons[0]) - - if argIsType: - ty = ty.skipTypes(tyDotOpTransparent) - case ty.kind - of tyEnum: - # look up if the identifier belongs to the enum: - while ty != nil: - f = getSymFromList(ty.n, i) - if f != nil: break - ty = ty.sons[0] # enum inheritance - if f != nil: - result = newSymNode(f) - result.info = n.info - result.typ = ty - markUsed(c.config, n.info, f, c.graph.usageSym) - styleCheckUse(n.info, f) - return - of tyObject, tyTuple: - if ty.n != nil and ty.n.kind == nkRecList: - let field = lookupInRecord(ty.n, i) - if field != nil: - n.typ = makeTypeDesc(c, field.typ) - return n - else: - tryReadingGenericParam(ty) - return - # XXX: This is probably not relevant any more - # reset to prevent 'nil' bug: see "tests/reject/tenumitems.nim": - ty = n.sons[0].typ + 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, 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: check = nil f = lookupInRecordAndBuildCheck(c, n, ty.n, i, check) if f != nil: break - if ty.sons[0] == nil: break - ty = skipTypes(ty.sons[0], skipPtrs) + if ty[0] == nil: break + ty = skipTypes(ty[0], skipPtrs) if f != nil: - if fieldVisible(c, f): + let visibilityCheckNeeded = + if n[1].kind == nkSym and n[1].sym == f: + false # field lookup was done already, likely by hygienic template or bindSym + else: true + if not visibilityCheckNeeded or fieldVisible(c, f): # is the access to a public field or in the same module or in a friend? - markUsed(c.config, n.sons[1].info, f, c.graph.usageSym) - styleCheckUse(n.sons[1].info, f) - n.sons[0] = makeDeref(n.sons[0]) - n.sons[1] = newSymNode(f) # we now have the correct field + 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 else: - check.sons[0] = n + check[0] = n check.typ = n.typ result = check elif ty.kind == tyTuple and ty.n != nil: f = getSymFromList(ty.n, i) if f != nil: - markUsed(c.config, n.sons[1].info, f, c.graph.usageSym) - styleCheckUse(n.sons[1].info, f) - n.sons[0] = makeDeref(n.sons[0]) - n.sons[1] = newSymNode(f) + markUsed(c, n[1].info, f) + onUse(n[1].info, f) + n[0] = makeDeref(n[0]) + n[1] = newSymNode(f) n.typ = f.typ result = n # we didn't find any field, let's look for a generic param if result == nil: - let t = n.sons[0].typ.skipTypes(tyDotOpTransparent) - tryReadingGenericParam(t) + 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.sons[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) - addSon(result, n.sons[1]) - addSon(result, copyTree(n[0])) + result.add n[1] + result.add copyTree(n[0]) else: - var i = considerQuotedIdent(c, n.sons[1], n) + var i = considerQuotedIdent(c, n[1], n) result = newNodeI(nkDotCall, n.info) result.flags.incl nfDotField - addSon(result, newIdentNode(i, n[1].info)) - addSon(result, copyTree(n[0])) + result.add newIdentNode(i, n[1].info) + result.add copyTree(n[0]) 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 = result = newNodeI(nkCall, n.info) result.add(newIdentNode(ident, n.info)) - for i in 0 .. n.len-1: result.add(n[i]) + 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.sons[0] = semExprWithType(c, n.sons[0]) + n[0] = semExprWithType(c, n[0]) + let a = getConstExpr(c.module, n[0], c.idgen, c.graph) + if a != nil: + 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.sons[0].typ, {tyGenericInst, tyVar, tyLent, tyAlias, tySink}) + 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.sons[0].info, errCircumNeedsPointer) + #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 - if sonsLen(n) == 1: - let x = semDeref(c, n) + result = nil + if n.len == 1: + 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.sons[0] = semExprWithType(c, n.sons[0], - {efNoEvaluateGeneric}) - let arr = skipTypes(n.sons[0].typ, {tyGenericInst, + # 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: + if arr.base.kind == tyNone: + result = n + result.typ = semStaticType(c, n[1], nil) + return + elif arr.n != nil: + return semSubscript(c, arr.n, flags) + else: + 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.sons[0] = makeDeref(n.sons[0]) - for i in countup(1, sonsLen(n) - 1): - n.sons[i] = semExprWithType(c, n.sons[i], + n[0] = makeDeref(n[0]) + for i in 1..<n.len: + n[i] = semExprWithType(c, n[i], flags*{efInTypeof, efDetermineType}) - var indexType = if arr.kind == tyArray: arr.sons[0] else: getSysType(c.graph, n.info, tyInt) - var arg = indexTypesMatch(c, indexType, n.sons[1].typ, n.sons[1]) - if arg != nil: - n.sons[1] = arg + # Arrays index type is dictated by the range's type + if arr.kind == tyArray: + var indexType = arr[0] + var arg = indexTypesMatch(c, indexType, n[1].typ, n[1]) + if arg != nil: + n[1] = arg + result = n + result.typ = elemType(arr) + # Other types have a bit more of leeway + elif n[1].typ.skipTypes(abstractRange-{tyDistinct}).kind in + {tyInt..tyInt64, tyUInt..tyUInt64}: result = n result.typ = elemType(arr) - #GlobalError(n.info, errIndexTypesDoNotMatch) of tyTypeDesc: # The result so far is a tyTypeDesc bound # a tyGenericBody. The line below will substitute @@ -1287,27 +1801,30 @@ proc semSubscript(c: PContext, n: PNode, flags: TExprFlags): PNode = #result = symNodeFromType(c, semTypeNode(c, n, nil), n.info) of tyTuple: if n.len != 2: return nil - n.sons[0] = makeDeref(n.sons[0]) + n[0] = makeDeref(n[0]) # [] operator for tuples requires constant expression: - n.sons[1] = semConstExpr(c, n.sons[1]) - if skipTypes(n.sons[1].typ, {tyGenericInst, tyRange, tyOrdinal, tyAlias, tySink}).kind in + n[1] = semConstExpr(c, n[1]) + if skipTypes(n[1].typ, {tyGenericInst, tyRange, tyOrdinal, tyAlias, tySink}).kind in {tyInt..tyInt64}: - var idx = getOrdValue(n.sons[1]) - if idx >= 0 and idx < sonsLen(arr): n.typ = arr.sons[int(idx)] - else: localError(c.config, n.info, "invalid index value for tuple subscript") + 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 $1 in subscript for tuple of length $2" % + [$idx, $arr.len]) result = n else: result = nil else: - let s = if n.sons[0].kind == nkSym: n.sons[0].sym - elif n[0].kind in nkSymChoices: n.sons[0][0].sym + let s = if n[0].kind == nkSym: n[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.sons[0] = semSymGenericInstantiation(c, n.sons[0], s) - result = explicitGenericInstantiation(c, n, s) + n[0] = semSymGenericInstantiation(c, n[0], s) + result = maybeInstantiateGeneric(c, n, s) of skMacro, skTemplate: if efInCall in flags: # We are processing macroOrTmpl[] in macroOrTmpl[](...) call. @@ -1317,7 +1834,7 @@ proc semSubscript(c: PContext, n: PNode, flags: TExprFlags): PNode = else: # We are processing macroOrTmpl[] not in call. Transform it to the # macro or template call with generic arguments here. - n.kind = nkCall + n.transitionSonsKind(nkCall) case s.kind of skMacro: result = semMacroExpr(c, n, n, s, flags) of skTemplate: result = semTemplateExpr(c, n, s, flags) @@ -1327,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) @@ -1340,10 +1857,9 @@ 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 = newNode(nkCall, n.info, sons = @[setterId, a[0], - semExprWithType(c, n[1])]) + result = newTreeI(nkCall, n.info, setterId, a[0], n[1]) result.flags.incl nfDotSetter - let orig = newNode(nkCall, n.info, sons = @[setterId, aOrig[0], nOrig[1]]) + let orig = newTreeI(nkCall, n.info, setterId, aOrig[0], nOrig[1]) result = semOverloadedCallAnalyseEffects(c, result, orig, {}) if result != nil: @@ -1356,48 +1872,143 @@ proc takeImplicitAddr(c: PContext, n: PNode; isLent: bool): PNode = # return a view into the first argument (if there is one): let root = exprRoot(n) if root != nil and root.owner == c.p.owner: + template url: string = "var_t_return.html".createDocLink if root.kind in {skLet, skVar, skTemp} and sfGlobal notin root.flags: - localError(c.config, n.info, "'$1' escapes its stack frame; context: '$2'; see $3/var_t_return.html" % [ - root.name.s, renderTree(n, {renderNoComments}), explanationsBaseUrl]) + localError(c.config, n.info, "'$1' escapes its stack frame; context: '$2'; see $3" % [ + root.name.s, renderTree(n, {renderNoComments}), url]) elif root.kind == skParam and root.position != 0: - localError(c.config, n.info, "'$1' is not the first parameter; context: '$2'; see $3/var_t_return.html" % [ - root.name.s, renderTree(n, {renderNoComments}), explanationsBaseUrl]) + localError(c.config, n.info, "'$1' is not the first parameter; context: '$2'; see $3" % [ + root.name.s, renderTree(n, {renderNoComments}), url]) case n.kind of nkHiddenAddr, nkAddr: return n - of nkHiddenDeref, nkDerefExpr: return n.sons[0] + of nkDerefExpr: return n[0] of nkBracketExpr: - if len(n) == 1: return n.sons[0] + if n.len == 1: return n[0] + of nkHiddenDeref: + # issue #13848 + # `proc fun(a: var int): var int = a` + discard else: discard 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})) - elif not isLent: + 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.sons[0] - if x.typ.kind in {tyVar, tyLent} and x.kind == nkSym and x.sym.kind == skResult: - n.sons[0] = x # 'result[]' --> 'result' - n.sons[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 + var x = le[0] + 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 + PathKinds0 = {nkDotExpr, nkCheckedFieldExpr, + nkBracketExpr, nkAddr, nkHiddenAddr, + nkObjDownConv, nkObjUpConv} + PathKinds1 = {nkHiddenStdConv, nkHiddenSubConv} + + proc getRoot(n: PNode; followDeref: bool): PNode = + result = n + while true: + case result.kind + of nkDerefExpr, nkHiddenDeref: + if followDeref: result = result[0] + else: break + of PathKinds0: + result = result[0] + of PathKinds1: + result = result[1] + else: break + + proc scopedLifetime(c: PContext; ri: PNode): bool {.inline.} = + let n = getRoot(ri, followDeref = false) + result = (ri.kind in nkCallKinds+{nkObjConstr}) or + (n.kind == nkSym and n.sym.owner == c.p.owner and n.sym.kind != skResult) + + proc escapes(c: PContext; le: PNode): bool {.inline.} = + # param[].foo[] = self definitely escapes, we don't need to + # care about pointer derefs: + let n = getRoot(le, followDeref = true) + result = n.kind == nkSym and n.sym.kind == skParam + + # Special typing rule: do not allow to pass 'owned T' to 'T' in 'result = x': + const absInst = abstractInst - {tyOwned} + if ri.typ != nil and ri.typ.skipTypes(absInst).kind == tyOwned and + le.typ != nil and le.typ.skipTypes(absInst).kind != tyOwned and + scopedLifetime(c, ri): + if le.kind == nkSym and le.sym.kind == skResult: + localError(c.config, n.info, "cannot return an owned pointer as an unowned pointer; " & + "use 'owned(" & typeToString(le.typ) & ")' as the return type") + elif escapes(c, le): + localError(c.config, n.info, + "assignment produces a dangling ref: the unowned ref lives longer than the owned ref") template resultTypeIsInferrable(typ: PType): untyped = typ.isMetaType and typ.kind != tyTypeDesc +proc goodLineInfo(arg: PNode): TLineInfo = + if arg.kind == nkStmtListExpr and arg.len > 0: + goodLineInfo(arg[^1]) + 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.sons[0] + var a = n[0] case a.kind of nkDotExpr: # 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 @@ -1405,102 +2016,112 @@ proc semAsgn(c: PContext, n: PNode; mode=asgnNormal): PNode = # possible: a = dotTransformation(c, n[0]) if a.kind == nkDotCall: - a.kind = nkCall + a.transitionSonsKind(nkCall) a = semExprWithType(c, a, {efLValue}) of nkBracketExpr: # a[i] = x # --> `[]=`(a, i, x) a = semSubscript(c, a, {efLValue}) if a == nil: - result = buildOverloadedSubscripts(n.sons[0], getIdent(c.cache, "[]=")) - add(result, n[1]) + 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 of nkCurlyExpr: # a{i} = x --> `{}=`(a, i, x) - result = buildOverloadedSubscripts(n.sons[0], getIdent(c.cache, "{}=")) - add(result, n[1]) + result = buildOverloadedSubscripts(n[0], getIdent(c.cache, "{}=")) + 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.p.owner)) + return semStmt(c, makeTupleAssignments(c, n), {}) else: a = semExprWithType(c, a, {efLValue}) else: a = semExprWithType(c, a, {efLValue}) - n.sons[0] = a + n[0] = a # a = b # both are vars, means: a[] = b[] # a = b # b no 'var T' means: a = addr(b) var le = a.typ - if (skipTypes(le, {tyGenericInst, tyAlias, tySink}).kind != tyVar and - isAssignable(c, a) == arNone) or - skipTypes(le, abstractVar).kind in {tyOpenArray, tyVarargs}: + 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 + 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.sons[0] - lhsIsResult = lhs.kind == nkSym and lhs.sym.kind == skResult - var - rhs = semExprWithType(c, n.sons[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.sons[0] = rhsTyp + c.p.owner.typ.setReturnType rhsTyp else: - typeMismatch(c.config, n.info, lhs.typ, rhsTyp) + typeMismatch(c.config, n.info, lhs.typ, rhsTyp, rhs) + borrowCheck(c, n, lhs, rhs) - n.sons[1] = fitNode(c, le, rhs, n.info) - if destructor notin c.features: - if tfHasAsgn in lhs.typ.flags and not lhsIsResult and - mode != noOverloadedAsgn: - return overloadedAsgn(c, lhs, n.sons[1]) - else: - liftTypeBoundOps(c, lhs.typ, lhs.info) + n[1] = fitNode(c, le, rhs, goodLineInfo(n[1])) + when false: liftTypeBoundOps(c, lhs.typ, lhs.info) fixAbstractType(c, n) - asgnToResultVar(c, n, n.sons[0], n.sons[1]) + asgnToResultVar(c, n, n[0], n[1]) result = n proc semReturn(c: PContext, n: PNode): PNode = result = n checkSonsLen(n, 1, c.config) - if c.p.owner.kind in {skConverter, skMethod, skProc, skFunc, skMacro} or ( - c.p.owner.kind == skIterator and c.p.owner.typ.callConv == ccClosure): - if n.sons[0].kind != nkEmpty: - # transform ``return expr`` to ``result = expr; return`` - if c.p.resultSym != nil: - var a = newNodeI(nkAsgn, n.sons[0].info) - addSon(a, newSymNode(c.p.resultSym)) - addSon(a, n.sons[0]) - n.sons[0] = semAsgn(c, a) - # optimize away ``result = result``: - if n[0][1].kind == nkSym and n[0][1].sym == c.p.resultSym: - n.sons[0] = c.graph.emptyNode + if c.p.owner.kind in {skConverter, skMethod, skProc, skFunc, skMacro} or + (not c.p.owner.typ.isNil and isClosureIterator(c.p.owner.typ)): + if n[0].kind != nkEmpty: + if n[0].kind == nkAsgn and n[0][0].kind == nkSym and c.p.resultSym == n[0][0].sym: + discard "return is already transformed" + elif c.p.resultSym != nil: + # transform ``return expr`` to ``result = expr; return`` + var a = newNodeI(nkAsgn, n[0].info) + a.add newSymNode(c.p.resultSym) + a.add n[0] + n[0] = a else: localError(c.config, n.info, errNoReturnTypeDeclared) + return + result[0] = semAsgn(c, n[0]) + # optimize away ``result = result``: + if result[0][1].kind == nkSym and result[0][1].sym == c.p.resultSym: + result[0] = c.graph.emptyNode else: localError(c.config, n.info, "'return' not allowed here") -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): @@ -1514,110 +2135,137 @@ proc semProcBody(c: PContext, n: PNode): PNode = fixNilType(c, result) else: var a = newNodeI(nkAsgn, n.info, 2) - a.sons[0] = newSymNode(c.p.resultSym) - a.sons[1] = result + a[0] = newSymNode(c.p.resultSym) + a[1] = result result = semAsgn(c, a) else: - discardCheck(c, result) + discardCheck(c, result, {}) if c.p.owner.kind notin {skMacro, skTemplate} and c.p.resultSym != nil and c.p.resultSym.typ.isMetaType: if isEmptyType(result.typ): # we inferred a 'void' return type: c.p.resultSym.typ = errorType(c) - c.p.owner.typ.sons[0] = nil + c.p.owner.typ.setReturnType nil else: - localError(c.config, c.p.resultSym.info, errCannotInferReturnType) - + localError(c.config, c.p.resultSym.info, errCannotInferReturnType % + c.p.owner.name.s) + 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) proc semYieldVarResult(c: PContext, n: PNode, restype: PType) = var t = skipTypes(restype, {tyGenericInst, tyAlias, tySink}) case t.kind of tyVar, tyLent: - if t.kind == tyVar: t.flags.incl tfVarIsPtr # bugfix for #4048, #4910, #6892 - if n.sons[0].kind in {nkHiddenStdConv, nkHiddenSubConv}: - n.sons[0] = n.sons[0].sons[1] - n.sons[0] = takeImplicitAddr(c, n.sons[0], t.kind == tyLent) + t.flags.incl tfVarIsPtr # bugfix for #4048, #4910, #6892 + if n[0].kind in {nkHiddenStdConv, nkHiddenSubConv}: + n[0] = n[0][1] + n[0] = takeImplicitAddr(c, n[0], t.kind == tyLent) of tyTuple: - for i in 0..<t.sonsLen: - var e = skipTypes(t.sons[i], {tyGenericInst, tyAlias, tySink}) + for i in 0..<t.len: + let e = skipTypes(t[i], {tyGenericInst, tyAlias, tySink}) if e.kind in {tyVar, tyLent}: - if e.kind == tyVar: e.flags.incl tfVarIsPtr # bugfix for #4048, #4910, #6892 - if n.sons[0].kind in {nkPar, nkTupleConstr}: - n.sons[0].sons[i] = takeImplicitAddr(c, n.sons[0].sons[i], e.kind == tyLent) - elif n.sons[0].kind in {nkHiddenStdConv, nkHiddenSubConv} and - n.sons[0].sons[1].kind in {nkPar, nkTupleConstr}: - var a = n.sons[0].sons[1] - a.sons[i] = takeImplicitAddr(c, a.sons[i], false) + e.flags.incl tfVarIsPtr # bugfix for #4048, #4910, #6892 + let tupleConstr = if n[0].kind in {nkHiddenStdConv, nkHiddenSubConv}: n[0][1] else: n[0] + if tupleConstr.kind in {nkPar, nkTupleConstr}: + if tupleConstr[i].kind == nkExprColonExpr: + tupleConstr[i][1] = takeImplicitAddr(c, tupleConstr[i][1], e.kind == tyLent) + else: + tupleConstr[i] = takeImplicitAddr(c, tupleConstr[i], e.kind == tyLent) else: - localError(c.config, n.sons[0].info, errXExpected, "tuple constructor") - else: discard + 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. + if isViewType(t): + n[0] = takeImplicitAddr(c, n[0], false) proc semYield(c: PContext, n: PNode): PNode = result = n checkSonsLen(n, 1, c.config) if c.p.owner == nil or c.p.owner.kind != skIterator: localError(c.config, n.info, errYieldNotAllowedHere) - elif n.sons[0].kind != nkEmpty: - n.sons[0] = semExprWithType(c, n.sons[0]) # check for type compatibility: + elif n[0].kind != nkEmpty: var iterType = c.p.owner.typ - let restype = iterType.sons[0] + let restype = iterType[0] + n[0] = semExprWithType(c, n[0], {}, restype) # check for type compatibility: if restype != nil: - if restype.kind != tyExpr: - n.sons[0] = fitNode(c, restype, n.sons[0], n.info) - if n.sons[0].typ == nil: internalError(c.config, n.info, "semYield") + if n[0].typ == nil: internalError(c.config, n.info, "semYield") if resultTypeIsInferrable(restype): - let inferred = n.sons[0].typ - iterType.sons[0] = inferred + let inferred = n[0].typ + 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.sons[0] != nil: + elif c.p.owner.typ.returnType != nil: localError(c.config, n.info, errGenerated, "yield statement must yield a value") -proc lookUpForDefined(c: PContext, i: PIdent, onlyCurrentScope: bool): PSym = - if onlyCurrentScope: - result = localSearchInScope(c, i) +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 = searchInScopes(c, i) # no need for stub loading + 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, considerQuotedIdentOrDot(c, n[1], n).s) + result.info = n.info + result.typ = getSysType(c.graph, n.info, tyBool) -proc lookUpForDefined(c: PContext, n: PNode, onlyCurrentScope: bool): PSym = +proc lookUpForDeclared(c: PContext, n: PNode, onlyCurrentScope: bool): PSym = case n.kind - of nkIdent: - result = lookUpForDefined(c, n.ident, onlyCurrentScope) + of nkIdent, nkAccQuoted: + var amb = false + let ident = considerQuotedIdent(c, n) + result = if onlyCurrentScope: + localSearchInScope(c, ident) + else: + searchInScopes(c, ident, amb) of nkDotExpr: result = nil if onlyCurrentScope: return checkSonsLen(n, 2, c.config) - var m = lookUpForDefined(c, n.sons[0], onlyCurrentScope) + var m = lookUpForDeclared(c, n[0], onlyCurrentScope) if m != nil and m.kind == skModule: let ident = considerQuotedIdent(c, n[1], n) if m == c.module: result = strTableGet(c.topLevelScope.symbols, ident) else: - result = strTableGet(m.tab, ident) - of nkAccQuoted: - result = lookUpForDefined(c, considerQuotedIdent(c, n), onlyCurrentScope) + result = someSym(c.graph, m, ident) of nkSym: result = n.sym of nkOpenSymChoice, nkClosedSymChoice: - result = n.sons[0].sym + 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 -proc semDefined(c: PContext, n: PNode, onlyCurrentScope: bool): PNode = +proc semDeclared(c: PContext, n: PNode, onlyCurrentScope: bool): PNode = checkSonsLen(n, 2, c.config) # we replace this node by a 'true' or 'false' node: result = newIntNode(nkIntLit, 0) - if not onlyCurrentScope and considerQuotedIdent(c, n[0], n).s == "defined": - let d = considerQuotedIdent(c, n[1], n) - result.intVal = ord isDefined(c.config, d.s) - elif lookUpForDefined(c, n.sons[1], onlyCurrentScope) != nil: - result.intVal = 1 + result.intVal = ord lookUpForDeclared(c, n[1], onlyCurrentScope) != nil result.info = n.info result.typ = getSysType(c.graph, n.info, tyBool) @@ -1644,11 +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, getCurrOwner(c), info) - result.flags = {sfGenSym} + result = newSym(kind, c.cache.idAnon, c.idgen, getCurrOwner(c), info) proc semExpandToAst(c: PContext, n: PNode): PNode = let macroCall = n[1] @@ -1657,19 +2305,19 @@ proc semExpandToAst(c: PContext, n: PNode): PNode = let expandedSym = expectMacroOrTemplateCall(c, macroCall) if expandedSym.kind == skError: return n - macroCall.sons[0] = newSymNode(expandedSym, macroCall.info) - markUsed(c.config, n.info, expandedSym, c.graph.usageSym) - styleCheckUse(n.info, expandedSym) + macroCall[0] = newSymNode(expandedSym, macroCall.info) + markUsed(c, n.info, expandedSym) + onUse(n.info, expandedSym) if isCallExpr(macroCall): - for i in countup(1, macroCall.len-1): - #if macroCall.sons[0].typ.sons[i].kind != tyExpr: - macroCall.sons[i] = semExprWithType(c, macroCall[i], {}) + for i in 1..<macroCall.len: + #if macroCall[0].typ[i].kind != tyUntyped: + macroCall[i] = semExprWithType(c, macroCall[i], {}) # performing overloading resolution here produces too serious regressions: 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: @@ -1681,17 +2329,17 @@ proc semExpandToAst(c: PContext, n: PNode): PNode = elif cands >= 2: localError(c.config, n.info, "ambiguous symbol in 'getAst' context: " & $macroCall) else: - let info = macroCall.sons[0].info - macroCall.sons[0] = newSymNode(cand, info) - markUsed(c.config, info, cand, c.graph.usageSym) - styleCheckUse(info, cand) + let info = macroCall[0].info + macroCall[0] = newSymNode(cand, info) + markUsed(c, info, cand) + onUse(info, cand) # we just perform overloading resolution here: - #n.sons[1] = semOverloadedCall(c, macroCall, macroCall, {skTemplate, skMacro}) + #n[1] = semOverloadedCall(c, macroCall, macroCall, {skTemplate, skMacro}) else: localError(c.config, n.info, "getAst takes a call, but got " & n.renderTree) # Preserve the magic symbol in order to be handled in evals.nim - internalAssert c.config, n.sons[0].sym.magic == mExpandToAst + internalAssert c.config, n[0].sym.magic == mExpandToAst #n.typ = getSysSym("NimNode").typ # expandedSym.getReturnType if n.kind == nkStmtList and n.len == 1: result = n[0] else: result = n @@ -1699,8 +2347,8 @@ proc semExpandToAst(c: PContext, n: PNode): PNode = proc semExpandToAst(c: PContext, n: PNode, magicSym: PSym, flags: TExprFlags = {}): PNode = - if sonsLen(n) == 2: - n.sons[0] = newSymNode(magicSym, n.info) + if n.len == 2: + n[0] = newSymNode(magicSym, n.info) result = semExpandToAst(c, n) else: result = semDirectOp(c, n, flags) @@ -1714,73 +2362,113 @@ proc processQuotations(c: PContext; n: var PNode, op: string, ids.add n return - if n.kind == nkPrefix: - checkSonsLen(n, 2, c.config) - if n[0].kind == nkIdent: - var examinedOp = n[0].ident.s + template handlePrefixOp(prefixed) = + if prefixed[0].kind == nkIdent: + let examinedOp = prefixed[0].ident.s if examinedOp == op: - returnQuote n[1] + returnQuote prefixed[1] elif examinedOp.startsWith(op): - n.sons[0] = newIdentNode(getIdent(c.cache, examinedOp.substr(op.len)), n.info) - elif n.kind == nkAccQuoted and op == "``": - returnQuote n[0] + prefixed[0] = newIdentNode(getIdent(c.cache, examinedOp.substr(op.len)), prefixed.info) - for i in 0 ..< n.safeLen: - processQuotations(c, n.sons[i], op, quotes, ids) + if n.kind == nkPrefix: + checkSonsLen(n, 2, c.config) + handlePrefixOp(n) + elif n.kind == nkAccQuoted: + if op == "``": + returnQuote n[0] + else: # [bug #7589](https://github.com/nim-lang/Nim/issues/7589) + if n.len == 2 and n[0].ident.s == op: + var tempNode = nkPrefix.newTree() + tempNode.newSons(2) + tempNode[0] = n[0] + tempNode[1] = n[1] + handlePrefixOp(tempNode) + elif n.kind == nkIdent: + if n.ident.s == "result": + n = ids[0] + + for i in 0..<n.safeLen: + processQuotations(c, n[i], op, quotes, ids) proc semQuoteAst(c: PContext, n: PNode): PNode = - internalAssert c.config, n.len == 2 or n.len == 3 + if n.len != 2 and n.len != 3: + localError(c.config, n.info, "'quote' expects 1 or 2 arguments") + return n # We transform the do block into a template with a param for # each interpolation. We'll pass this template to getAst. var quotedBlock = n[^1] op = if n.len == 3: expectString(c, n[1]) else: "``" - quotes = newSeq[PNode](1) + quotes = newSeq[PNode](2) # the quotes will be added to a nkCall statement - # leave some room for the callee symbol - ids = newSeq[PNode]() + # leave some room for the callee symbol and the result symbol + ids = newSeq[PNode](1) # this will store the generated param names + # leave some room for the result symbol if quotedBlock.kind != nkStmtList: localError(c.config, n.info, errXExpected, "block") + # This adds a default first field to pass the result symbol + 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.sons[paramsPos] = newNodeI(nkFormalParams, n.info) - dummyTemplate[paramsPos].add getSysSym(c.graph, n.info, "typed").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 newNode(nkIdentDefs, n.info, ids) - + dummyTemplate[paramsPos] = newNodeI(nkFormalParams, n.info) + dummyTemplate[paramsPos].add getSysSym(c.graph, n.info, "untyped").newSymNode # return type + 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] - result = newNode(nkCall, n.info, @[ - createMagic(c.graph, "getAst", mExpandToAst).newSymNode, - newNode(nkCall, n.info, quotes)]) + # This adds a call to newIdentNode("result") as the first argument to the template call + let identNodeSym = getCompilerProc(c.graph, "newIdentNode") + # so that new Nim compilers can compile old macros.nim versions, we check for 'nil' + # here and provide the old fallback solution: + let identNode = if identNodeSym == nil: + newIdentNode(getIdent(c.cache, "newIdentNode"), n.info) + else: + identNodeSym.newSymNode + quotes[1] = newTreeI(nkCall, n.info, identNode, newStrNode(nkStrLit, "result")) + result = newTreeI(nkCall, n.info, + createMagic(c.graph, c.idgen, "getAst", mExpandToAst).newSymNode, + newTreeI(nkCall, n.info, quotes)) result = semExpandToAst(c, result) proc tryExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = # watch out, hacks ahead: + when defined(nimsuggest): + # Remove the error hook so nimsuggest doesn't report errors there + let tempHook = c.graph.config.structuredErrorHook + c.graph.config.structuredErrorHook = nil let oldErrorCount = c.config.errorCounter let oldErrorMax = c.config.errorMax let oldCompilesId = c.compilesContextId - inc c.compilesContextIdGenerator - c.compilesContextId = c.compilesContextIdGenerator - # do not halt after first error: - c.config.errorMax = high(int) + # if this is a nested 'when compiles', do not increase the ID so that + # generic instantiations can still be cached for this level. + if c.compilesContextId == 0: + inc c.compilesContextIdGenerator + c.compilesContextId = c.compilesContextIdGenerator + c.config.errorMax = high(int) # `setErrorMaxHighMaybe` not appropriate here # open a scope for temporary symbol inclusions: let oldScope = c.currentScope openScope(c) - let oldOwnerLen = len(c.graph.owners) + let oldOwnerLen = c.graph.owners.len let oldGenerics = c.generics let oldErrorOutputs = c.config.m.errorOutputs if efExplain notin flags: c.config.m.errorOutputs = {} @@ -1795,9 +2483,12 @@ proc tryExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = var err: string try: result = semExpr(c, n, flags) - if c.config.errorCounter != oldErrorCount: result = nil + if result != nil and efNoSem2Check notin flags: + trackStmt(c, c.module, result, isTopLevel = false) + 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 @@ -1812,17 +2503,20 @@ proc tryExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = c.config.m.errorOutputs = oldErrorOutputs c.config.errorCounter = oldErrorCount c.config.errorMax = oldErrorMax + when defined(nimsuggest): + # Restore the error hook + c.graph.config.structuredErrorHook = tempHook proc semCompiles(c: PContext, n: PNode, flags: TExprFlags): PNode = # we replace this node by a 'true' or 'false' node: - if sonsLen(n) != 2: return semDirectOp(c, n, flags) + if n.len != 2: return semDirectOp(c, n, flags) result = newIntNode(nkIntLit, ord(tryExpr(c, n[1], flags) != nil)) result.info = n.info result.typ = getSysType(c.graph, n.info, tyBool) proc semShallowCopy(c: PContext, n: PNode, flags: TExprFlags): PNode = - if sonsLen(n) == 3: + if n.len == 3: # XXX ugh this is really a hack: shallowCopy() can be overloaded only # with procs that take not 2 parameters: result = newNodeI(nkFastAsgn, n.info) @@ -1833,9 +2527,9 @@ 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, c.module) - addSonSkipIntLit(result, magicsys.getCompilerProc(c.graph, "FlowVar").typ) - addSonSkipIntLit(result, t) + 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) proc instantiateCreateFlowVarCall(c: PContext; t: PType; @@ -1843,84 +2537,107 @@ 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) - bindings.idTablePut(sym.ast[genericParamsPos].sons[0].typ, t) + 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 = result.flags - {sfCompilerProc, sfExportC, sfImportC} - result.loc.r = nil + result.flags.excl {sfCompilerProc, sfExportc, sfImportc} + result.loc.snippet = "" proc setMs(n: PNode, s: PSym): PNode = result = n - n.sons[0] = newSymNode(s) - n.sons[0].info = n.info + n[0] = newSymNode(s) + n[0].info = n.info -proc extractImports(n: PNode; result: PNode) = - if n.kind in {nkImportStmt, nkImportExceptStmt, nkFromStmt}: - result.add copyTree(n) - n.kind = nkEmpty - return - for i in 0..<n.safeLen: extractImports(n[i], result) +proc semSizeof(c: PContext, n: PNode): PNode = + if n.len != 2: + localError(c.config, n.info, errXExpectsTypeOrValue % "sizeof") + else: + n[1] = semExprWithType(c, n[1], {efDetermineType}) + #restoreOldStyleType(n[1]) + 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! - # DON'T forget to update ast.SpecialSemMagics if you add a magic here! result = n case s.magic # magics that need special treatment of mAddr: + markUsed(c, n.info, s) checkSonsLen(n, 2, c.config) - result = semAddr(c, n.sons[1], s.name.s == "unsafeAddr") + result = semAddr(c, n[1]) of mTypeOf: - checkSonsLen(n, 2, c.config) - result = semTypeOf(c, n.sons[1]) - #of mArrGet: result = semArrGet(c, n, flags) - #of mArrPut: result = semArrPut(c, n, flags) - #of mAsgn: result = semAsgnOpr(c, n) - of mDefined: result = semDefined(c, setMs(n, s), false) - of mDefinedInScope: result = semDefined(c, setMs(n, s), true) - of mCompiles: result = semCompiles(c, setMs(n, s), flags) - #of mLow: result = semLowHigh(c, setMs(n, s), mLow) - #of mHigh: result = semLowHigh(c, setMs(n, s), mHigh) - of mSizeOf: result = semSizeof(c, setMs(n, s)) - of mIs: result = semIs(c, setMs(n, s), flags) - #of mOf: result = semOf(c, setMs(n, s)) - of mShallowCopy: result = semShallowCopy(c, n, flags) - of mExpandToAst: result = semExpandToAst(c, n, s, flags) - of mQuoteAst: result = semQuoteAst(c, n) + markUsed(c, n.info, s) + result = semTypeOf(c, n) + of mDefined: + markUsed(c, n.info, s) + result = semDefined(c, setMs(n, s)) + of mDeclared: + markUsed(c, n.info, s) + result = semDeclared(c, setMs(n, s), false) + of mDeclaredInScope: + markUsed(c, n.info, s) + result = semDeclared(c, setMs(n, s), true) + of mCompiles: + markUsed(c, n.info, s) + result = semCompiles(c, setMs(n, s), flags) + of mIs: + markUsed(c, n.info, s) + result = semIs(c, setMs(n, s), flags) + of mShallowCopy: + markUsed(c, n.info, s) + result = semShallowCopy(c, n, flags) + of mExpandToAst: + markUsed(c, n.info, s) + result = semExpandToAst(c, n, s, flags) + of mQuoteAst: + markUsed(c, n.info, s) + result = semQuoteAst(c, n) of mAstToStr: + markUsed(c, n.info, s) checkSonsLen(n, 2, c.config) result = newStrNodeT(renderTree(n[1], {renderNoComments}), n, c.graph) result.typ = getSysType(c.graph, n.info, tyString) of mParallel: + markUsed(c, n.info, s) if parallel notin c.features: localError(c.config, n.info, "use the {.experimental.} pragma to enable 'parallel'") result = setMs(n, s) var x = n.lastSon - if x.kind == nkDo: x = x.sons[bodyPos] + if x.kind == nkDo: x = x[bodyPos] inc c.inParallelStmt - result.sons[1] = semStmt(c, x) + result[1] = semStmt(c, x, {}) dec c.inParallelStmt of mSpawn: - result = setMs(n, s) - for i in 1 ..< n.len: - result.sons[i] = semExpr(c, n.sons[i]) - let typ = result[^1].typ - if not typ.isEmptyType: - if spawnResult(typ, c.inParallelStmt > 0) == srFlowVar: - result.typ = createFlowVar(c, typ, n.info) - else: - result.typ = typ - result.add instantiateCreateFlowVarCall(c, typ, n.info).newSymNode + markUsed(c, n.info, s) + when defined(leanCompiler): + result = localErrorNode(c, n, "compiler was built without 'spawn' support") else: - result.add c.graph.emptyNode + 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: + result.typ = createFlowVar(c, typ, n.info) + else: + result.typ = typ + result.add instantiateCreateFlowVarCall(c, typ, n.info).newSymNode + else: + result.add c.graph.emptyNode of mProcCall: + markUsed(c, n.info, s) result = setMs(n, s) - result.sons[1] = semExpr(c, n.sons[1]) + result[1] = semExpr(c, n[1]) result.typ = n[1].typ of mPlugin: + markUsed(c, n.info, s) # semDirectOp with conditional 'afterCallActions': let nOrig = n.copyTree #semLazyOpAux(c, n) @@ -1928,7 +2645,7 @@ proc semMagic(c: PContext, n: PNode, s: PSym, flags: TExprFlags): PNode = if result == nil: result = errorNode(c, n) else: - let callee = result.sons[0].sym + let callee = result[0].sym if callee.magic == mNone: semFinishOperands(c, result) activate(c, result) @@ -1937,29 +2654,50 @@ proc semMagic(c: PContext, n: PNode, s: PSym, flags: TExprFlags): PNode = if callee.magic != mNone: result = magicsAfterOverloadResolution(c, result, flags) of mRunnableExamples: - if c.config.cmd == cmdDoc and n.len >= 2 and n.lastSon.kind == nkStmtList: - if sfMainModule in c.module.flags: - let inp = toFullPath(c.config, c.module.info) - if c.runnableExamples == nil: - c.runnableExamples = newTree(nkStmtList, - newTree(nkImportStmt, newStrNode(nkStrLit, expandFilename(inp)))) - let imports = newTree(nkStmtList) - extractImports(n.lastSon, imports) - for imp in imports: c.runnableExamples.add imp - c.runnableExamples.add newTree(nkBlockStmt, c.graph.emptyNode, copyTree n.lastSon) + markUsed(c, n.info, s) + if c.config.cmd in cmdDocLike and n.len >= 2 and n.lastSon.kind == nkStmtList: + when false: + # some of this dead code was moved to `prepareExamples` + if sfMainModule in c.module.flags: + let inp = toFullPath(c.config, c.module.info) + if c.runnableExamples == nil: + c.runnableExamples = newTree(nkStmtList, + newTree(nkImportStmt, newStrNode(nkStrLit, expandFilename(inp)))) + let imports = newTree(nkStmtList) + var savedLastSon = copyTree n.lastSon + extractImports(savedLastSon, imports) + for imp in imports: c.runnableExamples.add imp + c.runnableExamples.add newTree(nkBlockStmt, c.graph.emptyNode, copyTree savedLastSon) result = setMs(n, s) else: result = c.graph.emptyNode + 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" @@ -1969,105 +2707,151 @@ proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = # ... var whenNimvm = false var typ = commonTypeBegin - if n.sons.len == 2 and n.sons[0].kind == nkElifBranch and - n.sons[1].kind == nkElse: - let exprNode = n.sons[0].sons[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 - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] + var cannotResolve = false + for i in 0..<n.len: + var it = n[i] case it.kind of nkElifBranch, nkElifExpr: checkSonsLen(it, 2, c.config) if whenNimvm: if semCheck: - it.sons[1] = semExpr(c, it.sons[1]) - typ = commonType(typ, it.sons[1].typ) + 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: - var e = semConstExpr(c, it.sons[0]) + let e = forceBool(c, semConstExpr(c, it[0])) if e.kind != nkIntLit: # can happen for cascading errors, assume false # InternalError(n.info, "semWhen") discard elif e.intVal != 0 and result == nil: - setResult(it.sons[1]) + setResult(it[1]) + 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.sons[0] = semExpr(c, it.sons[0]) - typ = commonType(typ, it.sons[0].typ) + 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.sons[0] + 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 - # The ``when`` statement implements the mechanism for platform dependent - # code. Thus we try to ensure here consistent ID allocation after the - # ``when`` statement. - idSynchronizationPoint(200) + 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) - if sonsLen(n) == 0: - rawAddSon(result.typ, newTypeS(tyEmpty, 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, + 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 countup(0, sonsLen(n) - 1): - if isRange(n.sons[i]): - checkSonsLen(n.sons[i], 3, c.config) - n.sons[i].sons[1] = semExprWithType(c, n.sons[i].sons[1]) - n.sons[i].sons[2] = semExprWithType(c, n.sons[i].sons[2]) - if typ == nil: - typ = skipTypes(n.sons[i].sons[1].typ, + 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], {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.sons[i].typ = n.sons[i].sons[2].typ # range node needs type too - elif n.sons[i].kind == nkRange: + n[i].typ = n[i][2].typ # range node needs type too + elif n[i].kind == nkRange: # already semchecked - if typ == nil: - typ = skipTypes(n.sons[i].sons[0].typ, + if doSetType: + typ = skipTypes(n[i][0].typ, {tyGenericInst, tyVar, tyLent, tyOrdinal, tyAlias, tySink}) else: - n.sons[i] = semExprWithType(c, n.sons[i]) - if typ == nil: - typ = skipTypes(n.sons[i].typ, {tyGenericInst, tyVar, tyLent, tyOrdinal, tyAlias, tySink}) - if not isOrdinalType(typ): - 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) - addSonSkipIntLit(result.typ, typ) - for i in countup(0, sonsLen(n) - 1): + n[i] = semExprWithType(c, n[i], {efTypeAllowed}, expectedElementType) + if doSetType: + typ = skipTypes(n[i].typ, {tyGenericInst, tyVar, tyLent, tyOrdinal, tyAlias, tySink}) + 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 - let info = n.sons[i].info - if isRange(n.sons[i]): + let info = n[i].info + if isRange(n[i]): m = newNodeI(nkRange, info) - addSon(m, fitNode(c, typ, n.sons[i].sons[1], info)) - addSon(m, fitNode(c, typ, n.sons[i].sons[2], info)) - elif n.sons[i].kind == nkRange: m = n.sons[i] # already semchecked + m.add fitNode(c, typ, n[i][1], info) + m.add fitNode(c, typ, n[i][2], info) + elif n[i].kind == nkRange: m = n[i] # already semchecked else: - m = fitNode(c, typ, n.sons[i], info) - addSon(result, m) + 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) var lastKey = 0 - for i in 0..n.len-1: - var x = n.sons[i] - if x.kind == nkExprColonExpr and sonsLen(x) == 2: - for j in countup(lastKey, i-1): + for i in 0..<n.len: + var x = n[i] + if x.kind == nkExprColonExpr and x.len == 2: + for j in lastKey..<i: var pair = newNodeI(nkTupleConstr, x.info) - pair.add(n.sons[j]) + pair.add(n[j]) pair.add(x[1]) result.add(pair) @@ -2079,94 +2863,118 @@ 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 paNone, paSingle, paTupleFields, paTuplePositions proc checkPar(c: PContext; n: PNode): TParKind = - var length = sonsLen(n) - if length == 0: + if n.len == 0: result = paTuplePositions # () - elif length == 1: - if n.sons[0].kind == nkExprColonExpr: result = paTupleFields + elif n.len == 1: + if n[0].kind == nkExprColonExpr: result = paTupleFields elif n.kind == nkTupleConstr: result = paTuplePositions else: result = paSingle # (expr) else: - if n.sons[0].kind == nkExprColonExpr: result = paTupleFields + if n[0].kind == nkExprColonExpr: result = paTupleFields else: result = paTuplePositions - for i in countup(0, length - 1): + for i in 0..<n.len: if result == paTupleFields: - if (n.sons[i].kind != nkExprColonExpr) or - not (n.sons[i].sons[0].kind in {nkSym, nkIdent}): - localError(c.config, n.sons[i].info, errNamedExprExpected) + if (n[i].kind != nkExprColonExpr) or + n[i][0].kind notin {nkSym, nkIdent, nkAccQuoted}: + localError(c.config, n[i].info, errNamedExprExpected) return paNone else: - if n.sons[i].kind == nkExprColonExpr: - localError(c.config, n.sons[i].info, errNamedExprNotAllowed) + if n[i].kind == nkExprColonExpr: + 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() - for i in countup(0, sonsLen(n) - 1): - if n[i].kind != nkExprColonExpr or n[i][0].kind notin {nkSym, nkIdent}: - illFormedAst(n.sons[i], c.config) - var id: PIdent - if n.sons[i].sons[0].kind == nkIdent: id = n.sons[i].sons[0].ident - else: id = n.sons[i].sons[0].sym.name + for i in 0..<n.len: + if n[i].kind != nkExprColonExpr: + illFormedAst(n[i], c.config) + let id = considerQuotedIdent(c, n[i][0]) if containsOrIncl(ids, id.id): - localError(c.config, n.sons[i].info, errFieldInitTwice % id.s) - n.sons[i].sons[1] = semExprWithType(c, n.sons[i].sons[1], - flags*{efAllowDestructor}) - var f = newSymS(skField, n.sons[i].sons[0], c) - f.typ = skipIntLit(n.sons[i].sons[1].typ) + localError(c.config, n[i].info, errFieldInitTwice % id.s) + # 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.skipTypes({tySink}), c.idgen) f.position = i rawAddSon(typ, f.typ) - addSon(typ.n, newSymNode(f)) - n.sons[i].sons[0] = newSymNode(f) - addSon(result, n.sons[i]) + typ.n.add newSymNode(f) + n[i][0] = newSymNode(f) + 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.kind = nkTupleConstr + 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 countup(0, sonsLen(n) - 1): - n.sons[i] = semExprWithType(c, n.sons[i], flags*{efAllowDestructor}) - addSonSkipIntLit(typ, n.sons[i].typ) + for i in 0..<n.len: + 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 -proc isTupleType(n: PNode): bool = - if n.len == 0: - return false # don't interpret () as type - for i in countup(0, n.len - 1): - if n[i].typ == nil or n[i].typ.kind != tyTypeDesc: - return false - return true - include semobjconstr -proc semBlock(c: PContext, n: PNode): 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.sons[0].kind != nkEmpty: - var labl = newSymG(skLabel, n.sons[0], c) + if n[0].kind != nkEmpty: + var labl = newSymG(skLabel, n[0], c) if sfGenSym notin labl.flags: addDecl(c, labl) - n.sons[0] = newSymNode(labl, n.sons[0].info) - suggestSym(c.config, n.sons[0].info, labl, c.graph.usageSym) - styleCheckDef(c.config, labl) - n.sons[1] = semExpr(c, n.sons[1]) - n.typ = n.sons[1].typ - if isEmptyType(n.typ): n.kind = nkBlockStmt - else: n.kind = nkBlockExpr + elif labl.owner == nil: + labl.owner = c.p.owner + n[0] = newSymNode(labl, n[0].info) + suggestSym(c.graph, n[0].info, labl, c.graph.usageSym) + styleCheckDef(c, labl) + onDef(n[0].info, labl) + 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 = @@ -2176,181 +2984,478 @@ proc semExportExcept(c: PContext, n: PNode): PNode = return n let exceptSet = readExceptSet(c, n) let exported = moduleName.sym - strTableAdd(c.module.tab, exported) - var i: TTabIter - var s = initTabIter(i, exported.tab) - while s != nil: + result = newNodeI(nkExportStmt, n.info) + reexportSym(c, exported) + for s in allSyms(c.graph, exported): if s.kind in ExportableSymKinds+{skModule} and - s.name.id notin exceptSet: - strTableAdd(c.module.tab, s) - s = nextIter(i, exported.tab) - result = n + s.name.id notin exceptSet and sfError notin s.flags: + reexportSym(c, s) + result.add newSymNode(s, n.info) + markUsed(c, n.info, exported) proc semExport(c: PContext, n: PNode): PNode = - var x = newNodeI(n.kind, n.info) + proc specialSyms(c: PContext; s: PSym) {.inline.} = + if s.kind == skConverter: addConverter(c, LazySym(sym: s)) + elif s.kind == skType and s.typ != nil and s.typ.kind == tyEnum and sfPure in s.flags: + addPureEnum(c, LazySym(sym: s)) + + result = newNodeI(nkExportStmt, n.info) for i in 0..<n.len: - let a = n.sons[i] - var o: TOverloadIter + let a = n[i] + var o: TOverloadIter = default(TOverloadIter) var s = initOverloadIter(o, c, a) if s == nil: localError(c.config, a.info, errGenerated, "cannot export: " & renderTree(a)) elif s.kind == skModule: # forward everything from that module: - strTableAdd(c.module.tab, s) - x.add(newSymNode(s, a.info)) - var ti: TTabIter - var it = initTabIter(ti, s.tab) - while it != nil: + reexportSym(c, s) + for it in allSyms(c.graph, s): if it.kind in ExportableSymKinds+{skModule}: - strTableAdd(c.module.tab, it) - it = nextIter(ti, s.tab) + reexportSym(c, it) + result.add newSymNode(it, a.info) + specialSyms(c, it) + markUsed(c, n.info, s) else: while s != nil: - if s.kind in ExportableSymKinds+{skModule}: - x.add(newSymNode(s, a.info)) - strTableAdd(c.module.tab, s) + if s.kind == skEnumField: + localError(c.config, a.info, errGenerated, "cannot export: " & renderTree(a) & + "; enum field cannot be exported individually") + if s.kind in ExportableSymKinds+{skModule} and sfError notin s.flags: + result.add(newSymNode(s, a.info)) + reexportSym(c, s) + markUsed(c, n.info, s) + specialSyms(c, s) + if s.kind == skType and sfPure notin s.flags: + var etyp = s.typ + if etyp.kind in {tyBool, tyEnum}: + for j in 0..<etyp.n.len: + var e = etyp.n[j].sym + if e.kind != skEnumField: + internalError(c.config, s.info, "rawImportSymbol") + reexportSym(c, e) + s = nextOverloadIter(o, c, a) - result = n -proc shouldBeBracketExpr(n: PNode): 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): + 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}) + result.typ = makeTypeDesc(c, typ) + else: + result = tupexp + +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 - let a = n.sons[0] - if a.kind in nkCallKinds: + result = false + let a = n[0] + case a.kind + of nkBracketExpr: + checkCallee(a[0]) + of nkCallKinds: let b = a[0] if b.kind in nkSymChoices: + 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 + 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: - let be = newNodeI(nkBracketExpr, n.info) - for i in 1..<a.len: be.add(a[i]) - n.sons[0] = be - return true + 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: + # proc foo(a: int, b = a) + # proc bar(a: int, b: int, c = a + b) + # + # The recursion may confuse you. It performs two duties: + # + # 1) extracting all referenced params from default expressions + # into a let section preceding the call + # + # 2) replacing the "references" within the default expression + # with these extracted skLet symbols. + # + # The first duty is carried out directly in the code here, while the second + # 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 or + # symbol was resolved before proc was instantiated: + (sfFromGeneric in call[0].sym.flags and + defExpr.sym.owner == call[0].sym.instantiatedFrom)): + let paramPos = defExpr.sym.position + 1 + + if call[paramPos].skipAddr.kind != nkSym 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 + + letSection.add newTreeI(nkIdentDefs, letSection.info, + newSymNode(hoistedVarSym), + newNodeI(nkEmpty, letSection.info), + call[paramPos]) + + call[paramPos] = newSymNode(hoistedVarSym) # Refer the original arg to its hoisted sym + + # 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: + hoistParamsUsedInDefault(c, call, letSection, defExpr[i]) + +proc getNilType(c: PContext): PType = + result = c.nilTypeCache + if result == nil: + result = newTypeS(tyNil, c) + result.size = c.config.target.ptrSize + result.align = c.config.target.ptrSize.int16 + c.nilTypeCache = result + +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) -proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = 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) - result = semSym(c, n, s, flags) - 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: markIndirect(c, result.sym) # if isGenericRoutine(result.sym): # localError(c.config, n.info, errInstantiateXExplicitly, s.name.s) + # "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 = getSysType(c.graph, n.info, tyNil) + 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.graph, 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.kind = nkCall - result = semExpr(c, result, flags) + result.transitionSonsKind(nkCall) + result = semExpr(c, result, flags, expectedType) of nkBind: - message(c.config, n.info, warnDeprecated, "bind") - result = semExpr(c, n.sons[0], flags) - of nkTypeOfExpr, nkTupleTy, nkTupleClassTy, nkRefTy..nkEnumTy, nkStaticTy: + message(c.config, n.info, warnDeprecated, "bind is deprecated") + 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) + of nkStmtListType: + let typ = semTypeNode(c, n, nil) + result.typ = makeTypeDesc(c, typ) of nkCall, nkInfix, nkPrefix, nkPostfix, nkCommand, nkCallStrLit: # check if it is an expression macro: checkMinSonsLen(n, 1, c.config) #when defined(nimsuggest): # if gIdeCmd == ideCon and c.config.m.trackPos == n.info: suggestExprNoCheck(c, n) let mode = if nfDotField in n.flags: {} else: {checkUndeclared} - var s = qualifiedLookUp(c, n.sons[0], mode) + c.isAmbiguous = false + var s = qualifiedLookUp(c, n[0], mode) if s != nil: - #if c.config.cmd == cmdPretty and n.sons[0].kind == nkDotExpr: - # pretty.checkUse(n.sons[0].sons[1].info, s) case s.kind - of skMacro: - if sfImmediate notin s.flags: - result = semDirectOp(c, n, flags) - else: - result = semMacroExpr(c, n, n, s, flags) - of skTemplate: - if sfImmediate notin s.flags: - result = semDirectOp(c, n, flags) - else: - result = semTemplateExpr(c, n, s, flags) + of skMacro, skTemplate: + result = semDirectOp(c, n, flags, expectedType) of skType: # XXX think about this more (``set`` procs) - if n.len == 2: - result = semConv(c, n) - elif contains(c.ambiguousSymbols, s.id) and n.len == 1: - errorUseQualifier(c, n.info, s) + let ambig = c.isAmbiguous + 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.sons[0]) - result = semDirectOp(c, n, flags) - elif isSymChoice(n.sons[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?) + # We've found a default value that references another param. + # See the notes in `hoistParamsUsedInDefault` for more details. + var hoistedParams = newNodeI(nkLetSection, result.info) + for i in 1..<result.len: + hoistParamsUsedInDefault(c, result, hoistedParams, result[i]) + result = newTreeIT(nkStmtListExpr, result.info, result.typ, hoistedParams, result) of nkWhen: if efWantStmt in flags: result = semWhen(c, n, true) @@ -2360,54 +3465,51 @@ 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 - expr = n[0] pragma = n[1] pragmaName = considerQuotedIdent(c, pragma[0]) flags = flags + finalNodeFlags: TNodeFlags = {} case whichKeyword(pragmaName) of wExplain: flags.incl efExplain + of wExecuteOnReload: + finalNodeFlags.incl nfExecuteOnReload else: # what other pragmas are allowed for expressions? `likely`, `unlikely` invalidPragma(c, n) result = semExpr(c, n[0], flags) + result.flags.incl finalNodeFlags of nkPar, nkTupleConstr: case checkPar(c, n) of paNone: result = errorNode(c, n) - of paTuplePositions: - var tupexp = semTuplePositionsConstr(c, n, flags) - if isTupleType(tupexp): - # reinterpret as type - var typ = semTypeNode(c, n, nil).skipTypes({tyTypeDesc}) - result.typ = makeTypeDesc(c, typ) - else: - result = tupexp - of paTupleFields: result = semTupleFieldsConstr(c, n, flags) - of paSingle: result = semExpr(c, n.sons[0], flags) - of nkCurly: result = semSetConstr(c, n) - of nkBracket: result = semArrayConstr(c, n, flags) - of nkObjConstr: result = semObjConstr(c, n, flags) - of nkLambdaKinds: result = semLambda(c, n, flags) - of nkDerefExpr: result = semDeref(c, n) + 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, flags) of nkAddr: result = n checkSonsLen(n, 1, c.config) - result = semAddr(c, n.sons[0]) + result = semAddr(c, n[0]) of nkHiddenAddr, nkHiddenDeref: checkSonsLen(n, 1, c.config) - n.sons[0] = semExpr(c, n.sons[0], flags) + n[0] = semExpr(c, n[0], flags, expectedType) of nkCast: result = semCast(c, n) - of nkIfExpr, nkIfStmt: result = semIf(c, n) + of nkIfExpr, nkIfStmt: result = semIf(c, n, flags, expectedType) of nkHiddenStdConv, nkHiddenSubConv, nkConv, nkHiddenCallConv: checkSonsLen(n, 2, c.config) considerGenSyms(c, n) @@ -2421,32 +3523,27 @@ 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) - of nkAsgn: result = semAsgn(c, n) - of nkBlockStmt, nkBlockExpr: result = semBlock(c, n) - 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) of nkConstSection: result = semConst(c, n) of nkTypeSection: result = semTypeSection(c, n) of nkDiscardStmt: result = semDiscard(c, n) - of nkWhileStmt: result = semWhile(c, n) - of nkTryStmt: result = semTry(c, n) + of nkWhileStmt: result = semWhile(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) - of nkCaseStmt: result = semCase(c, n) + of nkForStmt, nkParForStmt: result = semFor(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) + of nkPragma: semPragmaStmt(c, n) of nkIteratorDef: result = semIterator(c, n) of nkProcDef: result = semProc(c, n) of nkFuncDef: result = semFunc(c, n) @@ -2480,20 +3577,37 @@ 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: - n.sons[0] = semExpr(c, n.sons[0]) - if not n.sons[0].typ.isEmptyType and not implicitlyDiscardable(n.sons[0]): + 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") of nkGotoState, nkState: if n.len != 1 and n.len != 2: illFormedAst(n, c.config) - for i in 0 ..< n.len: - n.sons[i] = semExpr(c, n.sons[i]) + for i in 0..<n.len: + n[i] = semExpr(c, n[i]) of nkComesFrom: discard "ignore the comes from information for now" + of nkMixinStmt: discard + of nkBindStmt: + if c.p != nil: + 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})) else: 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 869f5ae74..874055cdc 100644 --- a/compiler/semfields.nim +++ b/compiler/semfields.nim @@ -19,24 +19,26 @@ type c: PContext proc instFieldLoopBody(c: TFieldInstCtx, n: PNode, forLoop: PNode): PNode = + if c.field != nil and isEmptyType(c.field.typ): + result = newNode(nkEmpty) + return case n.kind - of nkEmpty..pred(nkIdent), succ(nkSym)..nkNilLit: result = n + of nkEmpty..pred(nkIdent), succ(nkSym)..nkNilLit: result = copyNode(n) of nkIdent, nkSym: result = n let ident = considerQuotedIdent(c.c, n) - var L = sonsLen(forLoop) if c.replaceByFieldName: if ident.id == considerQuotedIdent(c.c, forLoop[0]).id: let fieldName = if c.tupleType.isNil: c.field.name.s elif c.tupleType.n.isNil: "Field" & $c.tupleIndex - else: c.tupleType.n.sons[c.tupleIndex].sym.name.s + else: c.tupleType.n[c.tupleIndex].sym.name.s result = newStrNode(nkStrLit, fieldName) return # other fields: - for i in ord(c.replaceByFieldName)..L-3: + for i in ord(c.replaceByFieldName)..<forLoop.len-2: if ident.id == considerQuotedIdent(c.c, forLoop[i]).id: - var call = forLoop.sons[L-2] - var tupl = call.sons[i+1-ord(c.replaceByFieldName)] + var call = forLoop[^2] + var tupl = call[i+1-ord(c.replaceByFieldName)] if c.field.isNil: result = newNodeI(nkBracketExpr, n.info) result.add(tupl) @@ -50,10 +52,9 @@ proc instFieldLoopBody(c: TFieldInstCtx, n: PNode, forLoop: PNode): PNode = if n.kind == nkContinueStmt: localError(c.c.config, n.info, "'continue' not supported in a 'fields' loop") - result = copyNode(n) - newSons(result, sonsLen(n)) - for i in countup(0, sonsLen(n)-1): - result.sons[i] = instFieldLoopBody(c, n.sons[i], forLoop) + result = shallowCopy(n) + for i in 0..<n.len: + result[i] = instFieldLoopBody(c, n[i], forLoop) type TFieldsCtx = object @@ -63,20 +64,21 @@ 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) - father.add(semStmt(c.c, body)) + father.add(semStmt(c.c, body, {})) dec c.c.inUnrolledContext closeScope(c.c) of nkNilLit: discard of nkRecCase: - let L = forLoop.len - let call = forLoop.sons[L-2] + let call = forLoop[^2] if call.len > 2: localError(c.c.config, forLoop.info, "parallel 'fields' iterator does not work for 'case' objects") @@ -87,15 +89,14 @@ proc semForObjectFields(c: TFieldsCtx, typ, forLoop, father: PNode) = var caseStmt = newNodeI(nkCaseStmt, forLoop.info) # generate selector: var access = newNodeI(nkDotExpr, forLoop.info, 2) - access.sons[0] = call.sons[1] - access.sons[1] = newSymNode(typ.sons[0].sym, forLoop.info) + access[0] = call[1] + access[1] = newSymNode(typ[0].sym, forLoop.info) caseStmt.add(semExprWithType(c.c, access)) # copy the branches over, but replace the fields with the for loop body: - for i in 1 ..< typ.len: + for i in 1..<typ.len: var branch = copyTree(typ[i]) - let L = branch.len - branch.sons[L-1] = newNodeI(nkStmtList, forLoop.info) - semForObjectFields(c, typ[i].lastSon, forLoop, branch[L-1]) + branch[^1] = newNodeI(nkStmtList, forLoop.info) + semForObjectFields(c, typ[i].lastSon, forLoop, branch[^1]) caseStmt.add(branch) father.add(caseStmt) of nkRecList: @@ -107,56 +108,58 @@ proc semForFields(c: PContext, n: PNode, m: TMagic): PNode = # so that 'break' etc. work as expected, we produce # a 'while true: stmt; break' loop ... result = newNodeI(nkWhileStmt, n.info, 2) - var trueSymbol = strTableGet(c.graph.systemModule.tab, getIdent(c.cache, "true")) + 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"), 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.sons[0] = newSymNode(trueSymbol, n.info) + result[0] = newSymNode(trueSymbol, n.info) var stmts = newNodeI(nkStmtList, n.info) - result.sons[1] = stmts + result[1] = stmts - var length = sonsLen(n) - var call = n.sons[length-2] - if length-2 != sonsLen(call)-1 + ord(m==mFieldPairs): + var call = n[^2] + if n.len-2 != call.len-1 + ord(m==mFieldPairs): localError(c.config, n.info, errWrongNumberOfVariables) return result const skippedTypesForFields = abstractVar - {tyTypeDesc} + tyUserTypeClasses - var tupleTypeA = skipTypes(call.sons[1].typ, skippedTypesForFields) + var tupleTypeA = skipTypes(call[1].typ, skippedTypesForFields) if tupleTypeA.kind notin {tyTuple, tyObject}: localError(c.config, n.info, errGenerated, "no object or tuple type") return result - for i in 1..call.len-1: - var tupleTypeB = skipTypes(call.sons[i].typ, skippedTypesForFields) + for i in 1..<call.len: + let calli = call[i] + var tupleTypeB = skipTypes(calli.typ, skippedTypesForFields) if not sameType(tupleTypeA, tupleTypeB): - typeMismatch(c.config, call.sons[i].info, tupleTypeA, tupleTypeB) + 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.sons[length-1] - for i in 0..sonsLen(tupleTypeA)-1: + 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)) + 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.sons[0] == nil: break - t = skipTypes(t.sons[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 eceb10470..80144ccc0 100644 --- a/compiler/semfold.nim +++ b/compiler/semfold.nim @@ -11,36 +11,42 @@ # and evaluation phase import - strutils, options, ast, astalgo, trees, treetab, nimsets, times, - nversion, platform, math, msgs, os, condsyms, idents, renderer, types, - commands, magicsys, modulegraphs, strtabs, lineinfos - -proc newIntNodeT*(intVal: BiggestInt, n: PNode; g: ModuleGraph): PNode = - case skipTypes(n.typ, abstractVarRange).kind - of tyInt: - result = newIntNode(nkIntLit, intVal) - # See bug #6989. 'pred' et al only produce an int literal type if the - # original type was 'int', not a distinct int etc. - if n.typ.kind == tyInt: - result.typ = getIntLitType(g, result) - else: - result.typ = n.typ - # hrm, this is not correct: 1 + high(int) shouldn't produce tyInt64 ... - #setIntLitType(result) - of tyChar: - result = newIntNode(nkCharLit, intVal) - result.typ = n.typ - else: - result = newIntNode(nkIntLit, intVal) - result.typ = n.typ + 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, 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, idgen, ti.owner) + result.n = literal + +proc newIntNodeT*(intVal: Int128, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = + result = newIntTypeNode(intVal, n.typ) + # See bug #6989. 'pred' et al only produce an int literal type if the + # original type was 'int', not a distinct int etc. + if n.typ.kind == tyInt: + # access cache for the int lit type + result.typ = getIntLitTypeG(g, result, idgen) result.info = n.info proc newFloatNodeT*(floatVal: BiggestFloat, n: PNode; g: ModuleGraph): PNode = - result = newFloatNode(nkFloatLit, floatVal) - if skipTypes(n.typ, abstractVarRange).kind == tyFloat: - result.typ = getFloatLitType(g, result) + if n.typ.skipTypes(abstractInst).kind == tyFloat32: + result = newFloatNode(nkFloat32Lit, floatVal) else: - result.typ = n.typ + result = newFloatNode(nkFloatLit, floatVal) + result.typ = n.typ result.info = n.info proc newStrNodeT*(strVal: string, n: PNode; g: ModuleGraph): PNode = @@ -48,67 +54,46 @@ proc newStrNodeT*(strVal: string, n: PNode; g: ModuleGraph): PNode = result.typ = n.typ result.info = n.info -proc getConstExpr*(m: PSym, n: PNode; g: ModuleGraph): PNode +proc getConstExpr*(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode # evaluates the constant expression or returns nil if it is no constant # expression -proc evalOp*(m: TMagic, n, a, b, c: PNode; g: ModuleGraph): PNode +proc evalOp*(m: TMagic, n, a, b, c: PNode; idgen: IdGenerator; g: ModuleGraph): PNode -proc checkInRange(conf: ConfigRef; n: PNode, res: BiggestInt): bool = - if res in firstOrd(conf, n.typ)..lastOrd(conf, n.typ): - result = true +proc checkInRange(conf: ConfigRef; n: PNode, res: Int128): bool = + res in firstOrd(conf, n.typ)..lastOrd(conf, n.typ) -proc foldAdd(a, b: BiggestInt, n: PNode; g: ModuleGraph): PNode = - let res = a +% b - if ((res xor a) >= 0'i64 or (res xor b) >= 0'i64) and - checkInRange(g.config, n, res): - result = newIntNodeT(res, n, g) +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: BiggestInt, n: PNode; g: ModuleGraph): PNode = - let res = a -% b - if ((res xor a) >= 0'i64 or (res xor not b) >= 0'i64) and - checkInRange(g.config, n, res): - result = newIntNodeT(res, n, g) +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 foldAbs*(a: BiggestInt, n: PNode; g: ModuleGraph): PNode = +proc foldUnarySub(a: Int128, n: PNode; idgen: IdGenerator, g: ModuleGraph): PNode = if a != firstOrd(g.config, n.typ): - result = newIntNodeT(a, n, g) - -proc foldMod*(a, b: BiggestInt, n: PNode; g: ModuleGraph): PNode = - if b != 0'i64: - result = newIntNodeT(a mod b, n, g) - -proc foldModU*(a, b: BiggestInt, n: PNode; g: ModuleGraph): PNode = - if b != 0'i64: - result = newIntNodeT(a %% b, n, g) - -proc foldDiv*(a, b: BiggestInt, n: PNode; g: ModuleGraph): PNode = - if b != 0'i64 and (a != firstOrd(g.config, n.typ) or b != -1'i64): - result = newIntNodeT(a div b, n, g) - -proc foldDivU*(a, b: BiggestInt, n: PNode; g: ModuleGraph): PNode = - if b != 0'i64: - result = newIntNodeT(a /% b, n, g) - -proc foldMul*(a, b: BiggestInt, n: PNode; g: ModuleGraph): PNode = - let res = a *% b - let floatProd = toBiggestFloat(a) * toBiggestFloat(b) - let resAsFloat = toBiggestFloat(res) - - # Fast path for normal case: small multiplicands, and no info - # is lost in either method. - if resAsFloat == floatProd and checkInRange(g.config, n, res): - return newIntNodeT(res, n, g) + result = newIntNodeT(-a, n, idgen, g) + else: + result = nil - # Somebody somewhere lost info. Close enough, or way off? Note - # that a != 0 and b != 0 (else resAsFloat == floatProd == 0). - # The difference either is or isn't significant compared to the - # true value (of which floatProd is a good approximation). +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 - # abs(diff)/abs(prod) <= 1/32 iff - # 32 * abs(diff) <= abs(prod) -- 5 good bits is "close enough" - if 32.0 * abs(resAsFloat - floatProd) <= abs(floatProd) and - checkInRange(g.config, n, res): - return newIntNodeT(res, n, g) +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 @@ -118,26 +103,29 @@ proc ordinalValToString*(a: PNode; g: ModuleGraph): string = var t = skipTypes(a.typ, abstractRange) case t.kind of tyChar: - result = $chr(int(x) and 0xff) + result = $chr(toInt64(x) and 0xff) of tyEnum: + result = "" var n = t.n - for i in countup(0, sonsLen(n) - 1): - if n.sons[i].kind != nkSym: internalError(g.config, a.info, "ordinalValToString") - var field = n.sons[i].sym + for i in 0..<n.len: + if n[i].kind != nkSym: internalError(g.config, a.info, "ordinalValToString") + var field = n[i].sym if field.position == x: if field.ast == nil: return field.name.s else: return field.ast.strVal - internalError(g.config, a.info, "no symbol for ordinal value: " & $x) + localError(g.config, a.info, + "Cannot convert int literal to $1. The value is invalid." % + [typeToString(t)]) else: result = $x proc isFloatRange(t: PType): bool {.inline.} = - result = t.kind == tyRange and t.sons[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.sons[0].kind in { + result = t.kind == tyRange and t.elementType.kind in { tyInt..tyInt64, tyUInt8..tyUInt32} proc pickIntRange(a, b: PType): PType = @@ -148,173 +136,163 @@ proc pickIntRange(a, b: PType): PType = proc isIntRangeOrLit(t: PType): bool = result = isIntRange(t) or isIntLit(t) -proc makeRange(typ: PType, first, last: BiggestInt; g: ModuleGraph): PType = - let minA = min(first, last) - let maxA = max(first, last) - let lowerNode = newIntNode(nkIntLit, minA) - if typ.kind == tyInt and minA == maxA: - result = getIntLitType(g, lowerNode) - elif typ.kind in {tyUint, tyUInt64}: - # these are not ordinal types, so you get no subrange type for these: - result = typ - else: - var n = newNode(nkRange) - addSon(n, lowerNode) - addSon(n, newIntNode(nkIntLit, maxA)) - result = newType(tyRange, typ.owner) - result.n = n - addSonSkipIntLit(result, skipTypes(typ, {tyRange})) - -proc makeRangeF(typ: PType, first, last: BiggestFloat; g: ModuleGraph): PType = - var n = newNode(nkRange) - addSon(n, newFloatNode(nkFloatLit, min(first.float, last.float))) - addSon(n, newFloatNode(nkFloatLit, max(first.float, last.float))) - result = newType(tyRange, typ.owner) - result.n = n - addSonSkipIntLit(result, skipTypes(typ, {tyRange})) - -proc evalIs(n, a: PNode): PNode = - # XXX: This should use the standard isOpImpl - #internalAssert a.kind == nkSym and a.sym.kind == skType - #internalAssert n.sonsLen == 3 and - # n[2].kind in {nkStrLit..nkTripleStrLit, nkType} - - let t1 = a.sym.typ - - if n[2].kind in {nkStrLit..nkTripleStrLit}: - case n[2].strVal.normalize - of "closure": - let t = skipTypes(t1, abstractRange) - result = newIntNode(nkIntLit, ord(t.kind == tyProc and - t.callConv == ccClosure and - tfIterator notin t.flags)) - of "iterator": - let t = skipTypes(t1, abstractRange) - result = newIntNode(nkIntLit, ord(t.kind == tyProc and - t.callConv == ccClosure and - tfIterator in t.flags)) - else: discard - else: - # XXX semexprs.isOpImpl is slightly different and requires a context. yay. - let t2 = n[2].typ - var match = sameType(t1, t2) - result = newIntNode(nkIntLit, ord(match)) - result.typ = n.typ - -proc evalOp(m: TMagic, n, a, b, c: PNode; g: ModuleGraph): PNode = +proc evalOp(m: TMagic, n, a, b, c: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = # b and c may be nil result = nil case m - of mOrd: result = newIntNodeT(getOrdValue(a), n, g) - of mChr: result = newIntNodeT(getInt(a), n, g) - of mUnaryMinusI, mUnaryMinusI64: result = newIntNodeT(- getInt(a), n, g) - of mUnaryMinusF64: result = newFloatNodeT(- getFloat(a), n, g) - of mNot: result = newIntNodeT(1 - getInt(a), n, g) - of mCard: result = newIntNodeT(nimsets.cardSet(g.config, a), n, g) + of mOrd: result = newIntNodeT(getOrdValue(a), n, idgen, g) + of mChr: result = newIntNodeT(getInt(a), n, idgen, g) + of mUnaryMinusI, mUnaryMinusI64: result = foldUnarySub(getInt(a), n, idgen, g) + of mUnaryMinusF64: result = newFloatNodeT(-getFloat(a), n, g) + of mNot: result = newIntNodeT(One - getInt(a), n, idgen, g) + of mCard: result = newIntNodeT(toInt128(nimsets.cardSet(g.config, a)), n, idgen, g) of mBitnotI: - case skipTypes(n.typ, abstractRange).kind - of tyUInt..tyUInt64: - result = newIntNodeT((not getInt(a)) and lastOrd(g.config, a.typ, fixedUnsigned=true), n, g) + if n.typ.isUnsigned: + result = newIntNodeT(bitnot(getInt(a)).maskBytes(int(getSize(g.config, n.typ))), n, idgen, g) else: - result = newIntNodeT(not getInt(a), n, g) - of mLengthArray: result = newIntNodeT(lengthOrd(g.config, a.typ), n, g) - of mLengthSeq, mLengthOpenArray, mXLenSeq, mLengthStr, mXLenStr: + result = newIntNodeT(bitnot(getInt(a)), n, idgen, g) + of mLengthArray: result = newIntNodeT(lengthOrd(g.config, a.typ), n, idgen, g) + of mLengthSeq, mLengthOpenArray, mLengthStr: if a.kind == nkNilLit: - result = newIntNodeT(0, n, g) + result = newIntNodeT(Zero, n, idgen, g) elif a.kind in {nkStrLit..nkTripleStrLit}: - result = newIntNodeT(len a.strVal, n, g) + 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.cstring)), n, idgen, g) else: - result = newIntNodeT(sonsLen(a), n, g) + result = newIntNodeT(toInt128(a.len), n, idgen, g) of mUnaryPlusI, mUnaryPlusF64: result = a # throw `+` away - of mToFloat, mToBiggestFloat: - result = newFloatNodeT(toFloat(int(getInt(a))), n, g) # XXX: Hides overflow/underflow - of mToInt, mToBiggestInt: result = newIntNodeT(system.toInt(getFloat(a)), n, g) - of mAbsF64: result = newFloatNodeT(abs(getFloat(a)), n, g) - of mAbsI: result = foldAbs(getInt(a), n, g) - of mZe8ToI, mZe8ToI64, mZe16ToI, mZe16ToI64, mZe32ToI64, mZeIToI64: - # byte(-128) = 1...1..1000_0000'64 --> 0...0..1000_0000'64 - result = newIntNodeT(getInt(a) and (`shl`(1, getSize(g.config, a.typ) * 8) - 1), n, g) - of mToU8: result = newIntNodeT(getInt(a) and 0x000000FF, n, g) - of mToU16: result = newIntNodeT(getInt(a) and 0x0000FFFF, n, g) - of mToU32: result = newIntNodeT(getInt(a) and 0x00000000FFFFFFFF'i64, n, g) - of mUnaryLt: result = foldSub(getOrdValue(a), 1, n, g) - of mSucc: result = foldAdd(getOrdValue(a), getInt(b), n, g) - of mPred: result = foldSub(getOrdValue(a), getInt(b), n, g) - of mAddI: result = foldAdd(getInt(a), getInt(b), n, g) - of mSubI: result = foldSub(getInt(a), getInt(b), n, g) - of mMulI: result = foldMul(getInt(a), getInt(b), n, g) + of mAbsI: result = foldAbs(getInt(a), n, idgen, g) + of mSucc: result = foldAdd(getOrdValue(a), getInt(b), n, idgen, g) + of mPred: result = foldSub(getOrdValue(a), getInt(b), n, idgen, g) + of mAddI: result = foldAdd(getInt(a), getInt(b), n, idgen, g) + of mSubI: result = foldSub(getInt(a), getInt(b), n, idgen, g) + of mMulI: result = foldMul(getInt(a), getInt(b), n, idgen, g) of mMinI: - if getInt(a) > getInt(b): result = newIntNodeT(getInt(b), n, g) - else: result = newIntNodeT(getInt(a), n, g) + let argA = getInt(a) + let argB = getInt(b) + result = newIntNodeT(if argA < argB: argA else: argB, n, idgen, g) of mMaxI: - if getInt(a) > getInt(b): result = newIntNodeT(getInt(a), n, g) - else: result = newIntNodeT(getInt(b), n, g) + let argA = getInt(a) + let argB = getInt(b) + result = newIntNodeT(if argA > argB: argA else: argB, n, idgen, g) of mShlI: case skipTypes(n.typ, abstractRange).kind - of tyInt8: result = newIntNodeT(int8(getInt(a)) shl int8(getInt(b)), n, g) - of tyInt16: result = newIntNodeT(int16(getInt(a)) shl int16(getInt(b)), n, g) - of tyInt32: result = newIntNodeT(int32(getInt(a)) shl int32(getInt(b)), n, g) - of tyInt64, tyInt: - result = newIntNodeT(`shl`(getInt(a), getInt(b)), n, g) - of tyUInt..tyUInt64: - result = newIntNodeT(`shl`(getInt(a), getInt(b)) and lastOrd(g.config, a.typ, fixedUnsigned=true), n, g) + of tyInt8: result = newIntNodeT(toInt128(toInt8(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) + of tyInt16: result = newIntNodeT(toInt128(toInt16(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) + of tyInt32: result = newIntNodeT(toInt128(toInt32(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) + of tyInt64: result = newIntNodeT(toInt128(toInt64(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) + of tyInt: + if g.config.target.intSize == 4: + result = newIntNodeT(toInt128(toInt32(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) + else: + result = newIntNodeT(toInt128(toInt64(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) + of tyUInt8: result = newIntNodeT(toInt128(toUInt8(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) + of tyUInt16: result = newIntNodeT(toInt128(toUInt16(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) + of tyUInt32: result = newIntNodeT(toInt128(toUInt32(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) + of tyUInt64: result = newIntNodeT(toInt128(toUInt64(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) + of tyUInt: + if g.config.target.intSize == 4: + result = newIntNodeT(toInt128(toUInt32(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) + else: + result = newIntNodeT(toInt128(toUInt64(getInt(a)) shl toInt64(getInt(b))), n, idgen, g) else: internalError(g.config, n.info, "constant folding for shl") of mShrI: + var a = cast[uint64](getInt(a)) + let b = cast[uint64](getInt(b)) + # To support the ``-d:nimOldShiftRight`` flag, we need to mask the + # signed integers to cut off the extended sign bit in the internal + # representation. + if 0'u64 < b: # do not cut off the sign extension, when there is + # no bit shifting happening. + case skipTypes(n.typ, abstractRange).kind + of tyInt8: a = a and 0xff'u64 + of tyInt16: a = a and 0xffff'u64 + of tyInt32: a = a and 0xffffffff'u64 + of tyInt: + if g.config.target.intSize == 4: + a = a and 0xffffffff'u64 + else: + # unsigned and 64 bit integers don't need masking + discard + let c = cast[BiggestInt](a shr b) + result = newIntNodeT(toInt128(c), n, idgen, g) + of mAshrI: case skipTypes(n.typ, abstractRange).kind - of tyInt8: result = newIntNodeT(int8(getInt(a)) shr int8(getInt(b)), n, g) - of tyInt16: result = newIntNodeT(int16(getInt(a)) shr int16(getInt(b)), n, g) - of tyInt32: result = newIntNodeT(int32(getInt(a)) shr int32(getInt(b)), n, g) - of tyInt64, tyInt, tyUInt..tyUInt64: - result = newIntNodeT(`shr`(getInt(a), getInt(b)), n, g) - else: internalError(g.config, n.info, "constant folding for shr") - of mDivI: result = foldDiv(getInt(a), getInt(b), n, g) - of mModI: result = foldMod(getInt(a), getInt(b), n, g) + of tyInt8: result = newIntNodeT(toInt128(ashr(toInt8(getInt(a)), toInt8(getInt(b)))), n, idgen, g) + of tyInt16: result = newIntNodeT(toInt128(ashr(toInt16(getInt(a)), toInt16(getInt(b)))), n, idgen, g) + of tyInt32: result = newIntNodeT(toInt128(ashr(toInt32(getInt(a)), toInt32(getInt(b)))), n, idgen, g) + of tyInt64, tyInt: + result = newIntNodeT(toInt128(ashr(toInt64(getInt(a)), toInt64(getInt(b)))), n, idgen, g) + else: internalError(g.config, n.info, "constant folding for ashr") + of mDivI: + let argA = getInt(a) + let argB = getInt(b) + if argB != Zero and (argA != firstOrd(g.config, n.typ) or argB != NegOne): + result = newIntNodeT(argA div argB, n, idgen, g) + of mModI: + let argA = getInt(a) + let argB = getInt(b) + if argB != Zero and (argA != firstOrd(g.config, n.typ) or argB != NegOne): + result = newIntNodeT(argA mod argB, n, idgen, g) of mAddF64: result = newFloatNodeT(getFloat(a) + getFloat(b), n, g) of mSubF64: result = newFloatNodeT(getFloat(a) - getFloat(b), n, g) of mMulF64: result = newFloatNodeT(getFloat(a) * getFloat(b), n, g) of mDivF64: - if getFloat(b) == 0.0: - if getFloat(a) == 0.0: result = newFloatNodeT(NaN, n, g) - elif getFloat(b).classify == fcNegZero: result = newFloatNodeT(-Inf, n, g) - else: result = newFloatNodeT(Inf, n, g) - else: - result = newFloatNodeT(getFloat(a) / getFloat(b), n, g) - of mMaxF64: - if getFloat(a) > getFloat(b): result = newFloatNodeT(getFloat(a), n, g) - else: result = newFloatNodeT(getFloat(b), n, g) - of mMinF64: - if getFloat(a) > getFloat(b): result = newFloatNodeT(getFloat(b), n, g) - else: result = newFloatNodeT(getFloat(a), n, g) - of mIsNil: result = newIntNodeT(ord(a.kind == nkNilLit), n, g) + result = newFloatNodeT(getFloat(a) / getFloat(b), n, 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(ord(getOrdValue(a) < getOrdValue(b)), n, g) + result = newIntNodeT(toInt128(ord(getOrdValue(a) < getOrdValue(b))), n, idgen, g) of mLeI, mLeB, mLeEnum, mLeCh: - result = newIntNodeT(ord(getOrdValue(a) <= getOrdValue(b)), n, g) + result = newIntNodeT(toInt128(ord(getOrdValue(a) <= getOrdValue(b))), n, idgen, g) of mEqI, mEqB, mEqEnum, mEqCh: - result = newIntNodeT(ord(getOrdValue(a) == getOrdValue(b)), n, g) - of mLtF64: result = newIntNodeT(ord(getFloat(a) < getFloat(b)), n, g) - of mLeF64: result = newIntNodeT(ord(getFloat(a) <= getFloat(b)), n, g) - of mEqF64: result = newIntNodeT(ord(getFloat(a) == getFloat(b)), n, g) - of mLtStr: result = newIntNodeT(ord(getStr(a) < getStr(b)), n, g) - of mLeStr: result = newIntNodeT(ord(getStr(a) <= getStr(b)), n, g) - of mEqStr: result = newIntNodeT(ord(getStr(a) == getStr(b)), n, g) - of mLtU, mLtU64: - result = newIntNodeT(ord(`<%`(getOrdValue(a), getOrdValue(b))), n, g) - of mLeU, mLeU64: - result = newIntNodeT(ord(`<=%`(getOrdValue(a), getOrdValue(b))), n, g) - of mBitandI, mAnd: result = newIntNodeT(a.getInt and b.getInt, n, g) - of mBitorI, mOr: result = newIntNodeT(getInt(a) or getInt(b), n, g) - of mBitxorI, mXor: result = newIntNodeT(a.getInt xor b.getInt, n, g) - of mAddU: result = newIntNodeT(`+%`(getInt(a), getInt(b)), n, g) - of mSubU: result = newIntNodeT(`-%`(getInt(a), getInt(b)), n, g) - of mMulU: result = newIntNodeT(`*%`(getInt(a), getInt(b)), n, g) - of mModU: result = foldModU(getInt(a), getInt(b), n, g) - of mDivU: result = foldDivU(getInt(a), getInt(b), n, g) - of mLeSet: result = newIntNodeT(ord(containsSets(g.config, a, b)), n, g) - of mEqSet: result = newIntNodeT(ord(equalSets(g.config, a, b)), n, g) + result = newIntNodeT(toInt128(ord(getOrdValue(a) == getOrdValue(b))), n, idgen, g) + of mLtF64: result = newIntNodeT(toInt128(ord(getFloat(a) < getFloat(b))), n, idgen, g) + of mLeF64: result = newIntNodeT(toInt128(ord(getFloat(a) <= getFloat(b))), n, idgen, g) + of mEqF64: result = newIntNodeT(toInt128(ord(getFloat(a) == getFloat(b))), n, idgen, g) + of mLtStr: result = newIntNodeT(toInt128(ord(getStr(a) < getStr(b))), n, idgen, g) + of mLeStr: result = newIntNodeT(toInt128(ord(getStr(a) <= getStr(b))), n, idgen, g) + of mEqStr: result = newIntNodeT(toInt128(ord(getStr(a) == getStr(b))), n, idgen, g) + of mLtU: + result = newIntNodeT(toInt128(ord(`<%`(toInt64(getOrdValue(a)), toInt64(getOrdValue(b))))), n, idgen, g) + of mLeU: + result = newIntNodeT(toInt128(ord(`<=%`(toInt64(getOrdValue(a)), toInt64(getOrdValue(b))))), n, idgen, g) + of mBitandI, mAnd: result = newIntNodeT(bitand(a.getInt, b.getInt), n, idgen, g) + 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(getSize(g.config, n.typ))) + result = newIntNodeT(val, n, idgen, g) + of mSubU: + 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(getSize(g.config, n.typ))) + result = newIntNodeT(val, n, idgen, g) + of mModU: + 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(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) + of mEqSet: result = newIntNodeT(toInt128(ord(equalSets(g.config, a, b))), n, idgen, g) of mLtSet: - result = newIntNodeT(ord(containsSets(g.config, a, b) and not equalSets(g.config, a, b)), n, g) + result = newIntNodeT(toInt128(ord( + containsSets(g.config, a, b) and not equalSets(g.config, a, b))), n, idgen, g) of mMulSet: result = nimsets.intersectSets(g.config, a, b) result.info = n.info @@ -324,59 +302,44 @@ proc evalOp(m: TMagic, n, a, b, c: PNode; g: ModuleGraph): PNode = of mMinusSet: result = nimsets.diffSets(g.config, a, b) result.info = n.info - of mSymDiffSet: - result = nimsets.symdiffSets(g.config, a, b) - result.info = n.info of mConStrStr: result = newStrNodeT(getStrOrChar(a) & getStrOrChar(b), n, g) - of mInSet: result = newIntNodeT(ord(inSet(a, b)), n, g) + of mInSet: result = newIntNodeT(toInt128(ord(inSet(a, b))), n, idgen, g) 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 mCopyStr: result = newStrNodeT(substr(getStr(a), int(getOrdValue(b))), n, g) - of mCopyStrLast: - result = newStrNodeT(substr(getStr(a), int(getOrdValue(b)), - int(getOrdValue(c))), 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) - of mStrToStr: result = a + 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: result = copyTree(a) result.typ = n.typ of mCompileOption: - result = newIntNodeT(ord(commands.testCompileOption(g.config, a.getStr, n.info)), n, g) + result = newIntNodeT(toInt128(ord(commands.testCompileOption(g.config, a.getStr, n.info))), n, idgen, g) of mCompileOptionArg: - result = newIntNodeT(ord( - testCompileOptionArg(g.config, getStr(a), getStr(b), n.info)), n, g) + result = newIntNodeT(toInt128(ord( + testCompileOptionArg(g.config, getStr(a), getStr(b), n.info))), n, idgen, g) of mEqProc: - result = newIntNodeT(ord( - exprStructuralEquivalent(a, b, strictSymEquality=true)), n, g) + result = newIntNodeT(toInt128(ord( + exprStructuralEquivalent(a, b, strictSymEquality=true))), n, idgen, g) else: discard -proc getConstIfExpr(c: PSym, n: PNode; g: ModuleGraph): PNode = +proc getConstIfExpr(c: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = result = nil - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] + for i in 0..<n.len: + var it = n[i] if it.len == 2: - var e = getConstExpr(c, it.sons[0], g) + var e = getConstExpr(c, it[0], idgen, g) if e == nil: return nil if getOrdValue(e) != 0: if result == nil: - result = getConstExpr(c, it.sons[1], g) + result = getConstExpr(c, it[1], idgen, g) if result == nil: return elif it.len == 1: - if result == nil: result = getConstExpr(c, it.sons[0], g) + if result == nil: result = getConstExpr(c, it[0], idgen, g) else: internalError(g.config, it.info, "getConstIfExpr()") proc leValueConv*(a, b: PNode): bool = @@ -384,30 +347,30 @@ proc leValueConv*(a, b: PNode): bool = case a.kind of nkCharLit..nkUInt64Lit: case b.kind - of nkCharLit..nkUInt64Lit: result = a.intVal <= b.intVal + of nkCharLit..nkUInt64Lit: result = a.getInt <= b.getInt of nkFloatLit..nkFloat128Lit: result = a.intVal <= round(b.floatVal).int else: result = false #internalError(a.info, "leValueConv") of nkFloatLit..nkFloat128Lit: case b.kind of nkFloatLit..nkFloat128Lit: result = a.floatVal <= b.floatVal - of nkCharLit..nkUInt64Lit: result = a.floatVal <= toFloat(int(b.intVal)) + of nkCharLit..nkUInt64Lit: result = a.floatVal <= toFloat64(b.getInt) else: result = false # internalError(a.info, "leValueConv") else: result = false # internalError(a.info, "leValueConv") -proc magicCall(m: PSym, n: PNode; g: ModuleGraph): PNode = - if sonsLen(n) <= 1: return +proc magicCall(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = + if n.len <= 1: return - var s = n.sons[0].sym - var a = getConstExpr(m, n.sons[1], g) - var b, c: PNode + var s = n[0].sym + var a = getConstExpr(m, n[1], idgen, g) + var b, c: PNode = nil if a == nil: return - if sonsLen(n) > 2: - b = getConstExpr(m, n.sons[2], g) + if n.len > 2: + b = getConstExpr(m, n[2], idgen, g) if b == nil: return - if sonsLen(n) > 3: - c = getConstExpr(m, n.sons[3], g) + if n.len > 3: + c = getConstExpr(m, n[3], idgen, g) if c == nil: return - result = evalOp(s.magic, n, a, b, c, g) + result = evalOp(s.magic, n, a, b, c, idgen, g) proc getAppType(n: PNode; g: ModuleGraph): PNode = if g.config.globalOptions.contains(optGenDynLib): @@ -419,168 +382,256 @@ proc getAppType(n: PNode; g: ModuleGraph): PNode = else: result = newStrNodeT("console", n, g) -proc rangeCheck(n: PNode, value: BiggestInt; g: ModuleGraph) = - var err = false - if n.typ.skipTypes({tyRange}).kind in {tyUInt..tyUInt64}: - err = value <% firstOrd(g.config, n.typ) or value >% lastOrd(g.config, n.typ, fixedUnsigned=true) - else: - err = value < firstOrd(g.config, n.typ) or value > lastOrd(g.config, n.typ) - if err: +proc rangeCheck(n: PNode, value: Int128; g: ModuleGraph) = + if value < firstOrd(g.config, n.typ) or value > lastOrd(g.config, n.typ): localError(g.config, n.info, "cannot convert " & $value & - " to " & typeToString(n.typ)) + " to " & typeToString(n.typ)) -proc foldConv*(n, a: PNode; g: ModuleGraph; check = false): PNode = - # XXX range checks? - case skipTypes(n.typ, abstractRange).kind +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}) + + # if srcTyp.kind == tyUInt64 and "FFFFFF" in $n: + # echo "n: ", n, " a: ", a + # echo "from: ", srcTyp, " to: ", dstTyp, " check: ", check + # echo getInt(a) + # echo high(int64) + # writeStackTrace() + case dstTyp.kind + of tyBool: + case srcTyp.kind + of tyFloat..tyFloat64: + result = newIntNodeT(toInt128(getFloat(a) != 0.0), n, idgen, g) + of tyChar, tyUInt..tyUInt64, tyInt..tyInt64: + result = newIntNodeT(toInt128(a.getOrdValue != 0), n, idgen, g) + of tyBool, tyEnum: # xxx shouldn't we disallow `tyEnum`? + result = a + result.typ = n.typ + else: + raiseAssert $srcTyp.kind of tyInt..tyInt64, tyUInt..tyUInt64: - case skipTypes(a.typ, abstractRange).kind + case srcTyp.kind of tyFloat..tyFloat64: - result = newIntNodeT(int(getFloat(a)), n, g) - of tyChar: result = newIntNodeT(getOrdValue(a), n, g) + result = newIntNodeT(toInt128(getFloat(a)), n, idgen, g) + of tyChar, tyUInt..tyUInt64, tyInt..tyInt64: + var val = a.getOrdValue + 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}: - rangeCheck(n, result.intVal, g) + if check and result.kind in {nkCharLit..nkUInt64Lit} and + dstTyp.kind notin {tyUInt..tyUInt64}: + rangeCheck(n, getInt(result), g) of tyFloat..tyFloat64: - case skipTypes(a.typ, abstractRange).kind - of tyInt..tyInt64, tyEnum, tyBool, tyChar: - result = newFloatNodeT(toBiggestFloat(getOrdValue(a)), n, g) + case srcTyp.kind + 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: - discard + of tyOpenArray, tyVarargs, tyProc, tyPointer: + result = nil else: result = a result.typ = n.typ -proc getArrayConstr(m: PSym, n: PNode; g: ModuleGraph): PNode = +proc getArrayConstr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = if n.kind == nkBracket: result = n else: - result = getConstExpr(m, n, g) + result = getConstExpr(m, n, idgen, g) if result == nil: result = n -proc foldArrayAccess(m: PSym, n: PNode; g: ModuleGraph): PNode = - var x = getConstExpr(m, n.sons[0], g) +proc foldArrayAccess(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = + var x = getConstExpr(m, n[0], idgen, g) if x == nil or x.typ.skipTypes({tyGenericInst, tyAlias, tySink}).kind == tyTypeDesc: return - var y = getConstExpr(m, n.sons[1], g) + var y = getConstExpr(m, n[1], idgen, g) if y == nil: return - var idx = getOrdValue(y) + var idx = toInt64(getOrdValue(y)) case x.kind of nkPar, nkTupleConstr: - if idx >= 0 and idx < sonsLen(x): - result = x.sons[int(idx)] - if result.kind == nkExprColonExpr: result = result.sons[1] + if idx >= 0 and idx < x.len: + result = x.sons[idx] + if result.kind == nkExprColonExpr: result = result[1] else: - localError(g.config, n.info, "index out of bounds: " & $n) + result = nil + localError(g.config, n.info, formatErrorIndexBound(idx, x.len-1) & $n) of nkBracket: - idx = idx - firstOrd(g.config, x.typ) - if idx >= 0 and idx < x.len: result = x.sons[int(idx)] - else: localError(g.config, n.info, "index out of bounds: " & $n) + idx -= toInt64(firstOrd(g.config, x.typ)) + if idx >= 0 and idx < x.len: result = x[int(idx)] + 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 < len(x.strVal): + if idx >= 0 and idx < x.strVal.len: result.intVal = ord(x.strVal[int(idx)]) - elif idx == len(x.strVal) and optLaxStrings in g.config.options: - discard else: - localError(g.config, n.info, "index out of bounds: " & $n) - else: discard + localError(g.config, n.info, formatErrorIndexBound(idx, x.strVal.len-1) & $n) + else: result = nil -proc foldFieldAccess(m: PSym, n: PNode; g: ModuleGraph): PNode = +proc foldFieldAccess(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = # a real field access; proc calls have already been transformed - var x = getConstExpr(m, n.sons[0], g) + 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 - var field = n.sons[1].sym - for i in countup(ord(x.kind == nkObjConstr), sonsLen(x) - 1): - var it = x.sons[i] + var field = n[1].sym + for i in ord(x.kind == nkObjConstr)..<x.len: + var it = x[i] if it.kind != nkExprColonExpr: # lookup per index: - result = x.sons[field.position] - if result.kind == nkExprColonExpr: result = result.sons[1] + result = x[field.position] + if result.kind == nkExprColonExpr: result = result[1] return - if it.sons[0].sym.name.id == field.name.id: - result = x.sons[i].sons[1] + if it[0].sym.name.id == field.name.id: + result = x[i][1] return localError(g.config, n.info, "field not found: " & field.name.s) -proc foldConStrStr(m: PSym, n: PNode; g: ModuleGraph): PNode = +proc foldConStrStr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = result = newNodeIT(nkStrLit, n.info, n.typ) result.strVal = "" - for i in countup(1, sonsLen(n) - 1): - let a = getConstExpr(m, n.sons[i], g) + for i in 1..<n.len: + let a = getConstExpr(m, n[i], idgen, g) if a == nil: return nil result.strVal.add(getStrOrChar(a)) -proc newSymNodeTypeDesc*(s: PSym; info: TLineInfo): PNode = +proc newSymNodeTypeDesc*(s: PSym; idgen: IdGenerator; info: TLineInfo): PNode = result = newSymNode(s, info) if s.typ.kind != tyTypeDesc: - result.typ = newType(tyTypeDesc, s.owner) - result.typ.addSonSkipIntLit(s.typ) + result.typ = newType(tyTypeDesc, idgen, s.owner) + result.typ.addSonSkipIntLit(s.typ, idgen) else: result.typ = s.typ -proc getConstExpr(m: PSym, n: PNode; g: ModuleGraph): PNode = +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 getSrcTimestamp(): DateTime = - try: - result = utc(fromUnix(parseInt(getEnv("SOURCE_DATE_EPOCH", - "not a number")))) - except ValueError: - # Environment variable malformed. - # https://reproducible-builds.org/specs/source-date-epoch/: "If the - # value is malformed, the build process SHOULD exit with a non-zero - # error code", which this doesn't do. This uses local time, because - # that maintains compatibility with existing usage. - result = local(getTime()) - +proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = + result = nil case n.kind of nkSym: var s = n.sym case s.kind of skEnumField: - result = newIntNodeT(s.position, n, g) + result = newIntNodeT(toInt128(s.position), n, idgen, g) of skConst: case s.magic - of mIsMainModule: result = newIntNodeT(ord(sfMainModule in m.flags), n, g) - of mCompileDate: result = newStrNodeT(format(getSrcTimestamp(), - "yyyy-MM-dd"), n, g) - of mCompileTime: result = newStrNodeT(format(getSrcTimestamp(), - "HH:mm:ss"), n, g) - of mCpuEndian: result = newIntNodeT(ord(CPU[g.config.target.targetCPU].endian), n, g) + of mIsMainModule: result = newIntNodeT(toInt128(ord(sfMainModule in m.flags)), n, idgen, g) + of mCompileDate: result = newStrNodeT(getDateStr(), n, g) + of mCompileTime: result = newStrNodeT(getClockStr(), n, g) + of mCpuEndian: result = newIntNodeT(toInt128(ord(CPU[g.config.target.targetCPU].endian)), n, idgen, g) of mHostOS: result = newStrNodeT(toLowerAscii(platform.OS[g.config.target.targetOS].name), n, g) of mHostCPU: result = newStrNodeT(platform.CPU[g.config.target.targetCPU].name.toLowerAscii, n, g) 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 mNaN: result = newFloatNodeT(NaN, n, g) - of mInf: result = newFloatNodeT(Inf, n, g) - of mNegInf: result = newFloatNodeT(NegInf, n, g) - of mIntDefine: - if isDefined(g.config, s.name.s): - try: - result = newIntNodeT(g.config.symbols[s.name.s].parseInt, n, g) - except ValueError: - localError(g.config, n.info, "expression is not an integer literal") - of mStrDefine: - if isDefined(g.config, s.name.s): - result = newStrNodeT(g.config.symbols[s.name.s], n, g) + 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: + if s.typ != nil and s.typ.kind == tyTypeDesc: + result = newSymNodeTypeDesc(s, idgen, n.info) of skType: # XXX gensym'ed symbols can come here and cannot be resolved. This is # dirty, but correct. if s.typ != nil: - result = newSymNodeTypeDesc(s, n.info) + result = newSymNodeTypeDesc(s, idgen, n.info) of skGenericParam: if s.typ.kind == tyStatic: if s.typ.n != nil and tfUnresolved notin s.typ.flags: @@ -589,147 +640,155 @@ proc getConstExpr(m: PSym, n: PNode; g: ModuleGraph): PNode = elif s.typ.isIntLit: result = s.typ.n else: - result = newSymNodeTypeDesc(s, n.info) + result = newSymNodeTypeDesc(s, idgen, n.info) else: discard of nkCharLit..nkNilLit: result = copyNode(n) of nkIfExpr: - result = getConstIfExpr(m, n, g) + result = getConstIfExpr(m, n, idgen, g) of nkCallKinds: - if n.sons[0].kind != nkSym: return - var s = n.sons[0].sym + if n[0].kind != nkSym: return + var s = n[0].sym if s.kind != skProc and s.kind != skFunc: return try: case s.magic of mNone: # If it has no sideEffect, it should be evaluated. But not here. return - of mSizeOf: - var a = n.sons[1] - if computeSize(g.config, a.typ) < 0: - localError(g.config, a.info, "cannot evaluate 'sizeof' because its type is not defined completely") - result = nil - elif skipTypes(a.typ, typedescInst+{tyRange}).kind in - IntegralTypes+NilableTypes+{tySet}: - #{tyArray,tyObject,tyTuple}: - result = newIntNodeT(getSize(g.config, a.typ), n, g) - else: - result = nil - # XXX: size computation for complex types is still wrong of mLow: - result = newIntNodeT(firstOrd(g.config, n.sons[1].typ), n, g) + if skipTypes(n[1].typ, abstractVarRange).kind in tyFloat..tyFloat64: + result = newFloatNodeT(firstFloat(n[1].typ), n, g) + else: + result = newIntNodeT(firstOrd(g.config, n[1].typ), n, idgen, g) of mHigh: - if skipTypes(n.sons[1].typ, abstractVar).kind notin - {tySequence, tyString, tyCString, tyOpenArray, tyVarargs}: - result = newIntNodeT(lastOrd(g.config, skipTypes(n[1].typ, abstractVar)), n, g) + if skipTypes(n[1].typ, abstractVar+{tyUserTypeClassInst}).kind notin + {tySequence, tyString, tyCstring, tyOpenArray, tyVarargs}: + if skipTypes(n[1].typ, abstractVarRange).kind in tyFloat..tyFloat64: + result = newFloatNodeT(lastFloat(n[1].typ), n, g) + else: + result = newIntNodeT(lastOrd(g.config, skipTypes(n[1].typ, abstractVar)), n, idgen, g) else: - var a = getArrayConstr(m, n.sons[1], g) + var a = getArrayConstr(m, n[1], idgen, g) if a.kind == nkBracket: # we can optimize it away: - result = newIntNodeT(sonsLen(a)-1, n, g) + result = newIntNodeT(toInt128(a.len-1), n, idgen, g) of mLengthOpenArray: - var a = getArrayConstr(m, n.sons[1], g) + var a = getArrayConstr(m, n[1], idgen, g) if a.kind == nkBracket: # we can optimize it away! This fixes the bug ``len(134)``. - result = newIntNodeT(sonsLen(a), n, g) + result = newIntNodeT(toInt128(a.len), n, idgen, g) else: - result = magicCall(m, n, g) + result = magicCall(m, n, idgen, g) of mLengthArray: # It doesn't matter if the argument is const or not for mLengthArray. # This fixes bug #544. - result = newIntNodeT(lengthOrd(g.config, n.sons[1].typ), n, g) + result = newIntNodeT(lengthOrd(g.config, n[1].typ), n, idgen, g) + of mSizeOf: + result = foldSizeOf(g.config, n, nil) + of mAlignOf: + result = foldAlignOf(g.config, n, nil) + of mOffsetOf: + result = foldOffsetOf(g.config, n, nil) of mAstToStr: result = newStrNodeT(renderTree(n[1], {renderNoComments}), n, g) of mConStrStr: - result = foldConStrStr(m, n, g) + result = foldConStrStr(m, n, idgen, g) of mIs: - let a = getConstExpr(m, n[1], g) - if a != nil and a.kind == nkSym and a.sym.kind == skType: - result = evalIs(n, a) + # The only kind of mIs node that comes here is one depending on some + # generic parameter and that's (hopefully) handled at instantiation time + discard else: - result = magicCall(m, n, g) - except OverflowError: + result = magicCall(m, n, idgen, g) + except OverflowDefect: localError(g.config, n.info, "over- or underflow") - except DivByZeroError: + except DivByZeroDefect: localError(g.config, n.info, "division by zero") of nkAddr: - var a = getConstExpr(m, n.sons[0], g) - if a != nil: - result = n - n.sons[0] = a - of nkBracket: - result = copyTree(n) - for i in countup(0, sonsLen(n) - 1): - var a = getConstExpr(m, n.sons[i], g) + result = nil # don't fold paths containing nkAddr + of nkBracket, nkCurly: + result = copyNode(n) + for son in n.items: + var a = getConstExpr(m, son, idgen, g) if a == nil: return nil - result.sons[i] = a + result.add a incl(result.flags, nfAllConst) of nkRange: - var a = getConstExpr(m, n.sons[0], g) + var a = getConstExpr(m, n[0], idgen, g) if a == nil: return - var b = getConstExpr(m, n.sons[1], g) + var b = getConstExpr(m, n[1], idgen, g) if b == nil: return result = copyNode(n) - addSon(result, a) - addSon(result, b) - of nkCurly: - result = copyTree(n) - for i in countup(0, sonsLen(n) - 1): - var a = getConstExpr(m, n.sons[i], g) - if a == nil: return nil - result.sons[i] = a - incl(result.flags, nfAllConst) + result.add a + result.add b #of nkObjConstr: # result = copyTree(n) - # for i in countup(1, sonsLen(n) - 1): - # var a = getConstExpr(m, n.sons[i].sons[1]) + # for i in 1..<n.len: + # var a = getConstExpr(m, n[i][1]) # if a == nil: return nil - # result.sons[i].sons[1] = a + # result[i][1] = a # incl(result.flags, nfAllConst) of nkPar, nkTupleConstr: # tuple constructor - result = copyTree(n) - if (sonsLen(n) > 0) and (n.sons[0].kind == nkExprColonExpr): - for i in countup(0, sonsLen(n) - 1): - var a = getConstExpr(m, n.sons[i].sons[1], g) + result = copyNode(n) + if (n.len > 0) and (n[0].kind == nkExprColonExpr): + for expr in n.items: + let exprNew = copyNode(expr) # nkExprColonExpr + exprNew.add expr[0] + let a = getConstExpr(m, expr[1], idgen, g) if a == nil: return nil - result.sons[i].sons[1] = a + exprNew.add a + result.add exprNew else: - for i in countup(0, sonsLen(n) - 1): - var a = getConstExpr(m, n.sons[i], g) + for expr in n.items: + let a = getConstExpr(m, expr, idgen, g) if a == nil: return nil - result.sons[i] = a + result.add a incl(result.flags, nfAllConst) of nkChckRangeF, nkChckRange64, nkChckRange: - var a = getConstExpr(m, n.sons[0], g) + var a = getConstExpr(m, n[0], idgen, g) if a == nil: return - if leValueConv(n.sons[1], a) and leValueConv(a, n.sons[2]): + 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" % - [typeToString(n.sons[0].typ), typeToString(n.typ)]) + [typeToString(n[0].typ), typeToString(n.typ)]) of nkStringToCString, nkCStringToString: - var a = getConstExpr(m, n.sons[0], g) + var a = getConstExpr(m, n[0], idgen, g) if a == nil: return result = a result.typ = n.typ of nkHiddenStdConv, nkHiddenSubConv, nkConv: - var a = getConstExpr(m, n.sons[1], g) + var a = getConstExpr(m, n[1], idgen, g) if a == nil: return - result = foldConv(n, a, g, check=n.kind == nkHiddenStdConv) + result = foldConv(n, a, idgen, g, check=true) + of nkDerefExpr, nkHiddenDeref: + let a = getConstExpr(m, n[0], idgen, g) + if a != nil and a.kind == nkNilLit: + result = nil + #localError(g.config, n.info, "nil dereference is not allowed") of nkCast: - var a = getConstExpr(m, n.sons[1], g) + 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 - of nkBracketExpr: result = foldArrayAccess(m, n, g) - of nkDotExpr: result = foldFieldAccess(m, n, g) + of nkBracketExpr: result = foldArrayAccess(m, n, idgen, g) + of nkDotExpr: result = foldFieldAccess(m, n, idgen, g) + of nkCheckedFieldExpr: + assert n[0].kind == nkDotExpr + result = foldFieldAccess(m, n[0], idgen, g) of nkStmtListExpr: - if n.len == 2 and n[0].kind == nkComesFrom: - result = getConstExpr(m, n[1], g) + var i = 0 + while i <= n.len - 2: + if n[i].kind in {nkComesFrom, nkCommentStmt, nkEmpty}: i.inc + else: break + if i == n.len - 1: + result = getConstExpr(m, n[i], idgen, g) else: discard diff --git a/compiler/semgnrc.nim b/compiler/semgnrc.nim index cc03db1c2..2639aba6c 100644 --- a/compiler/semgnrc.nim +++ b/compiler/semgnrc.nim @@ -19,8 +19,8 @@ proc getIdentNode(c: PContext; n: PNode): PNode = case n.kind - of nkPostfix: result = getIdentNode(c, n.sons[1]) - of nkPragmaExpr: result = getIdentNode(c, n.sons[0]) + of nkPostfix: result = getIdentNode(c, n[1]) + of nkPragmaExpr: result = getIdentNode(c, n[0]) of nkIdent, nkAccQuoted, nkSym: result = n else: illFormedAst(n, c.config) @@ -28,13 +28,16 @@ proc getIdentNode(c: PContext; n: PNode): PNode = type GenericCtx = object - toMixin: IntSet + toMixin, toBind: IntSet cursorInBody: bool # only for nimsuggest bracketExpr: PNode -type TSemGenericFlag = enum - withinBind, withinTypeDesc, withinMixin, withinConcept + withinBind, + withinTypeDesc, + withinMixin, + withinConcept + TSemGenericFlags = set[TSemGenericFlag] proc semGenericStmt(c: PContext, n: PNode, @@ -47,120 +50,214 @@ 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 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 macroToExpandSym(s): untyped = - s.kind in {skMacro, skTemplate} and (s.typ.len == 1) and not fromDotExpr +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; fromDotExpr=false): PNode = + 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): - styleCheckUse(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): - styleCheckUse(n.info, s) - result = semMacroExpr(c, n, n, s, {efNoSemCheck}) + 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) + 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, n.info) - styleCheckUse(n.info, s) + 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 - styleCheckUse(n.info, s) + onUse(n.info, s) of skType: if (s.typ != nil) and (s.typ.flags * {tfGenericTypeParam, tfImplicitTypeParam} == {}): - result = newSymNodeTypeDesc(s, n.info) + 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 - styleCheckUse(n.info, s) + onUse(n.info, s) else: result = newSymNode(s, n.info) - styleCheckUse(n.info, s) + 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, ctx: var GenericCtx): PNode = result = n let ident = considerQuotedIdent(c, n) - var s = searchInScopes(c, ident).skipAlias(n, c.config) + var amb = false + var s = searchInScopes(c, ident, amb) if s == nil: s = strTableGet(c.pureEnumFields, ident) - if s != nil and contains(c.ambiguousSymbols, s.id): - s = nil + #if s != nil and contains(c.ambiguousSymbols, s.id): + # s = nil if s == nil: if ident.id notin ctx.toMixin and withinMixin notin flags: errorUndeclaredIdentifier(c, n.info, ident.s) else: - if withinBind in flags: + if withinBind in flags or s.id in ctx.toBind: result = symChoice(c, n, s, scClosed) - elif s.name.id in ctx.toMixin: + elif s.isMixedIn: result = symChoice(c, n, s, scForceOpen) else: - result = semGenericStmtSymbol(c, n, s, ctx) + result = semGenericStmtSymbol(c, n, s, ctx, flags, amb) # else: leave as nkIdent proc newDot(n, b: PNode): PNode = result = newNodeI(nkDotExpr, n.info) - result.add(n.sons[0]) + result.add(n[0]) 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) + isMacro = s.kind in {skTemplate, skMacro} + result = semGenericStmtSymbol(c, n, s, ctx, flags, c.isAmbiguous) else: - n.sons[0] = semGenericStmt(c, n.sons[0], flags, ctx) + n[0] = semGenericStmt(c, n[0], flags, ctx) result = n let n = n[1] let ident = considerQuotedIdent(c, n) - var s = searchInScopes(c, ident).skipAlias(n, c.config) - if s != nil and s.kind in routineKinds: + # 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: - result = newDot(result, symChoice(c, n, s, scClosed)) - elif s.name.id in ctx.toMixin: + if withinBind in flags or s.id in ctx.toBind: + 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, fromDotExpr=true) - if syms.kind == nkSym: - let choice = symChoice(c, n, s, scForceOpen) - choice.kind = 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 = @@ -175,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 @@ -196,15 +296,19 @@ proc semGenericStmt(c: PContext, n: PNode, # in the generic instantiation process... discard of nkBind: - result = semGenericStmt(c, n.sons[0], flags+{withinBind}, ctx) + result = semGenericStmt(c, n[0], flags+{withinBind}, ctx) of nkMixinStmt: result = semMixinStmt(c, n, ctx.toMixin) + of nkBindStmt: + result = semBindStmt(c, n, ctx.toBind) of nkCall, nkHiddenCallConv, nkInfix, nkPrefix, nkCommand, nkCallStrLit: # check if it is an expression macro: checkMinSonsLen(n, 1, c.config) - let fn = n.sons[0] + let fn = n[0] + c.isAmbiguous = false var s = qualifiedLookUp(c, fn, {}) - if s == nil and + let ambig = c.isAmbiguous + if s == nil and {withinMixin, withinConcept}*flags == {} and fn.kind in {nkIdent, nkAccQuoted} and considerQuotedIdent(c, fn).id notin ctx.toMixin: @@ -214,26 +318,25 @@ proc semGenericStmt(c: PContext, n: PNode, var mixinContext = false if s != nil: incl(s.flags, sfUsed) - mixinContext = s.magic in {mDefined, mDefinedInScope, mCompiles} - let sc = symChoice(c, fn, s, - if s.name.id in ctx.toMixin: scForceOpen else: scOpen) + mixinContext = s.magic in {mDefined, mDeclared, mDeclaredInScope, mCompiles, mAstToStr} + let whichChoice = if s.id in ctx.toBind: scClosed + elif s.isMixedIn: scForceOpen + else: scOpen + let sc = symChoice(c, fn, s, whichChoice) case s.kind - of skMacro: - if macroToExpand(s) and sc.safeLen <= 1: - styleCheckUse(fn.info, s) - result = semMacroExpr(c, n, n, s, {efNoSemCheck}) + 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) + 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.sons[0] = sc - result = n - mixinContext = true - of skTemplate: - if macroToExpand(s) and sc.safeLen <= 1: - styleCheckUse(fn.info, s) - result = semTemplateExpr(c, n, s, {efNoSemCheck}) - result = semGenericStmt(c, result, flags, ctx) - else: - n.sons[0] = sc + n[0] = sc result = n # BUGFIX: we must not return here, we need to do first phase of # symbol lookup. Also since templates and macros can do scope injections @@ -244,243 +347,313 @@ proc semGenericStmt(c: PContext, n: PNode, # Leave it as an identifier. discard of skProc, skFunc, skMethod, skIterator, skConverter, skModule: - result.sons[0] = sc - # do not check of 's.magic==mRoof' here because it might be some - # other '^' but after overload resolution the proper one: - if ctx.bracketExpr != nil and n.len == 2 and s.name.s == "^": - result.add ctx.bracketExpr + result[0] = sc first = 1 + # We're not interested in the example code during this pass so let's + # skip it + if s.magic == mRunnableExamples: + first = result.safeLen # see trunnableexamples.fun3 of skGenericParam: - result.sons[0] = newSymNodeTypeDesc(s, fn.info) - styleCheckUse(fn.info, s) + result[0] = newSymNodeTypeDesc(s, c.idgen, fn.info) + onUse(fn.info, s) first = 1 of skType: # bad hack for generics: if (s.typ != nil) and (s.typ.kind != tyGenericParam): - result.sons[0] = newSymNodeTypeDesc(s, fn.info) - styleCheckUse(fn.info, s) + 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: - result.sons[0] = newSymNode(s, fn.info) - styleCheckUse(fn.info, s) + result[0] = newSymNode(s, fn.info) + onUse(fn.info, s) first = 1 elif fn.kind == nkDotExpr: - result.sons[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 # is not exported and yet the generic 'threadProcWrapper' works correctly. let flags = if mixinContext: flags+{withinMixin} else: flags - for i in countup(first, sonsLen(result) - 1): - result.sons[i] = semGenericStmt(c, result.sons[i], flags, ctx) + for i in first..<result.safeLen: + result[i] = semGenericStmt(c, result[i], flags, ctx) of nkCurlyExpr: result = newNodeI(nkCall, n.info) result.add newIdentNode(getIdent(c.cache, "{}"), n.info) - for i in 0 ..< n.len: result.add(n[i]) + for i in 0..<n.len: result.add(n[i]) result = semGenericStmt(c, result, flags, ctx) of nkBracketExpr: 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.sons[0]: - result = semGenericStmt(c, result, flags, ctx) - of nkAsgn, nkFastAsgn: + for i in 0..<n.len: result.add(n[i]) + result = semGenericStmt(c, result, flags, ctx) + of nkAsgn, nkFastAsgn, nkSinkAsgn: checkSonsLen(n, 2, c.config) - let a = n.sons[0] - let b = n.sons[1] + let a = n[0] + let b = n[1] let k = a.kind case k of nkCurlyExpr: result = newNodeI(nkCall, n.info) result.add newIdentNode(getIdent(c.cache, "{}="), n.info) - for i in 0 ..< a.len: result.add(a[i]) + for i in 0..<a.len: result.add(a[i]) result.add(b) result = semGenericStmt(c, result, flags, ctx) of nkBracketExpr: result = newNodeI(nkCall, n.info) result.add newIdentNode(getIdent(c.cache, "[]="), n.info) - for i in 0 ..< a.len: result.add(a[i]) + for i in 0..<a.len: result.add(a[i]) result.add(b) - withBracketExpr ctx, a.sons[0]: - result = semGenericStmt(c, result, flags, ctx) + result = semGenericStmt(c, result, flags, ctx) else: - for i in countup(0, sonsLen(n) - 1): - result.sons[i] = semGenericStmt(c, n.sons[i], flags, ctx) + for i in 0..<n.len: + result[i] = semGenericStmt(c, n[i], flags, ctx) of nkIfStmt: - for i in countup(0, sonsLen(n)-1): - n.sons[i] = semGenericStmtScope(c, n.sons[i], flags, ctx) + for i in 0..<n.len: + n[i] = semGenericStmtScope(c, n[i], flags, ctx) of nkWhenStmt: - for i in countup(0, sonsLen(n)-1): - n.sons[i] = semGenericStmt(c, n.sons[i], flags+{withinMixin}, ctx) + for i in 0..<n.len: + # bug #8603: conditions of 'when' statements are not + # in a 'mixin' context: + let it = n[i] + if it.kind in {nkElifExpr, nkElifBranch}: + n[i][0] = semGenericStmt(c, it[0], flags, ctx) + n[i][1] = semGenericStmt(c, it[1], flags+{withinMixin}, ctx) + else: + n[i] = semGenericStmt(c, it, flags+{withinMixin}, ctx) of nkWhileStmt: openScope(c) - for i in countup(0, sonsLen(n)-1): - n.sons[i] = semGenericStmt(c, n.sons[i], flags, ctx) + for i in 0..<n.len: + n[i] = semGenericStmt(c, n[i], flags, ctx) closeScope(c) of nkCaseStmt: openScope(c) - n.sons[0] = semGenericStmt(c, n.sons[0], flags, ctx) - for i in countup(1, sonsLen(n)-1): - var a = n.sons[i] + n[0] = semGenericStmt(c, n[0], flags, ctx) + for i in 1..<n.len: + var a = n[i] checkMinSonsLen(a, 1, c.config) - var L = sonsLen(a) - for j in countup(0, L-2): - a.sons[j] = semGenericStmt(c, a.sons[j], flags, ctx) - a.sons[L - 1] = semGenericStmtScope(c, a.sons[L-1], flags, ctx) + for j in 0..<a.len-1: + 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: - var L = sonsLen(n) openScope(c) - n.sons[L - 2] = semGenericStmt(c, n.sons[L-2], flags, ctx) - for i in countup(0, L - 3): - addTempDecl(c, n.sons[i], skForVar) + n[^2] = semGenericStmt(c, n[^2], flags, ctx) + for i in 0..<n.len - 2: + if (n[i].kind == nkVarTuple): + for s in n[i]: + if (s.kind == nkIdent): + addTempDecl(c,s,skForVar) + else: + addTempDecl(c, n[i], skForVar) openScope(c) - n.sons[L - 1] = semGenericStmt(c, n.sons[L-1], flags, ctx) + n[^1] = semGenericStmt(c, n[^1], flags, ctx) closeScope(c) closeScope(c) of nkBlockStmt, nkBlockExpr, nkBlockType: checkSonsLen(n, 2, c.config) openScope(c) - if n.sons[0].kind != nkEmpty: - addTempDecl(c, n.sons[0], skLabel) - n.sons[1] = semGenericStmt(c, n.sons[1], flags, ctx) + if n[0].kind != nkEmpty: + addTempDecl(c, n[0], skLabel) + n[1] = semGenericStmt(c, n[1], flags, ctx) closeScope(c) - of nkTryStmt: + of nkTryStmt, nkHiddenTryStmt: checkMinSonsLen(n, 2, c.config) - n.sons[0] = semGenericStmtScope(c, n.sons[0], flags, ctx) - for i in countup(1, sonsLen(n)-1): - var a = n.sons[i] + n[0] = semGenericStmtScope(c, n[0], flags, ctx) + for i in 1..<n.len: + var a = n[i] checkMinSonsLen(a, 1, c.config) - var L = sonsLen(a) openScope(c) - for j in countup(0, L-2): - if a.sons[j].isInfixAs(): - addTempDecl(c, getIdentNode(c, a.sons[j][2]), skLet) - a.sons[j].sons[1] = semGenericStmt(c, a.sons[j][1], flags+{withinTypeDesc}, ctx) + for j in 0..<a.len-1: + if a[j].isInfixAs(): + addTempDecl(c, getIdentNode(c, a[j][2]), skLet) + a[j][1] = semGenericStmt(c, a[j][1], flags+{withinTypeDesc}, ctx) else: - a.sons[j] = semGenericStmt(c, a.sons[j], flags+{withinTypeDesc}, ctx) - a.sons[L-1] = semGenericStmtScope(c, a.sons[L-1], flags, ctx) + a[j] = semGenericStmt(c, a[j], flags+{withinTypeDesc}, ctx) + a[^1] = semGenericStmtScope(c, a[^1], flags, ctx) closeScope(c) - of nkVarSection, nkLetSection: - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if (a.kind != nkIdentDefs) and (a.kind != nkVarTuple): illFormedAst(a, c.config) - checkMinSonsLen(a, 3, c.config) - var L = sonsLen(a) - a.sons[L-2] = semGenericStmt(c, a.sons[L-2], flags+{withinTypeDesc}, ctx) - a.sons[L-1] = semGenericStmt(c, a.sons[L-1], flags, ctx) - for j in countup(0, L-3): - addTempDecl(c, getIdentNode(c, a.sons[j]), skVar) + 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] + 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 countup(0, sonsLen(n) - 1): - var a = n.sons[i] + for i in 0..<n.len: + var a = n[i] if (a.kind != nkIdentDefs): illFormedAst(a, c.config) checkMinSonsLen(a, 3, c.config) - var L = sonsLen(a) - a.sons[L-2] = semGenericStmt(c, a.sons[L-2], flags+{withinTypeDesc}, ctx) + a[^2] = semGenericStmt(c, a[^2], flags+{withinTypeDesc}, ctx) # do not perform symbol lookup for default expressions - for j in countup(0, L-3): - addTempDecl(c, getIdentNode(c, a.sons[j]), skType) - of nkConstSection: - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if (a.kind != nkConstDef): illFormedAst(a, c.config) - checkSonsLen(a, 3, c.config) - addTempDecl(c, getIdentNode(c, a.sons[0]), skConst) - a.sons[1] = semGenericStmt(c, a.sons[1], flags+{withinTypeDesc}, ctx) - a.sons[2] = semGenericStmt(c, a.sons[2], flags, ctx) + for j in 0..<a.len-2: + addTempDecl(c, getIdentNode(c, a[j]), skType) of nkTypeSection: - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] + for i in 0..<n.len: + var a = n[i] if a.kind == nkCommentStmt: continue if (a.kind != nkTypeDef): illFormedAst(a, c.config) checkSonsLen(a, 3, c.config) - addTempDecl(c, getIdentNode(c, a.sons[0]), skType) - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] + addTempDecl(c, getIdentNode(c, a[0]), skType) + for i in 0..<n.len: + var a = n[i] if a.kind == nkCommentStmt: continue if (a.kind != nkTypeDef): illFormedAst(a, c.config) checkSonsLen(a, 3, c.config) - if a.sons[1].kind != nkEmpty: + if a[1].kind != nkEmpty: openScope(c) - a.sons[1] = semGenericStmt(c, a.sons[1], flags, ctx) - a.sons[2] = semGenericStmt(c, a.sons[2], flags+{withinTypeDesc}, ctx) + a[1] = semGenericStmt(c, a[1], flags, ctx) + a[2] = semGenericStmt(c, a[2], flags+{withinTypeDesc}, ctx) closeScope(c) else: - a.sons[2] = semGenericStmt(c, a.sons[2], flags+{withinTypeDesc}, ctx) + a[2] = semGenericStmt(c, a[2], flags+{withinTypeDesc}, ctx) of nkEnumTy: - if n.sonsLen > 0: - if n.sons[0].kind != nkEmpty: - n.sons[0] = semGenericStmt(c, n.sons[0], flags+{withinTypeDesc}, ctx) - for i in countup(1, sonsLen(n) - 1): - var a: PNode - case n.sons[i].kind - of nkEnumFieldDef: a = n.sons[i].sons[0] - of nkIdent: a = n.sons[i] + if n.len > 0: + if n[0].kind != nkEmpty: + n[0] = semGenericStmt(c, n[0], flags+{withinTypeDesc}, ctx) + for i in 1..<n.len: + 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.sons[0].kind != nkEmpty: - n.sons[0] = semGenericStmt(c, n.sons[0], flags+{withinTypeDesc}, ctx) - for i in countup(1, sonsLen(n) - 1): - var a = n.sons[i] + for i in 1..<n.len: + var a = n[i] if (a.kind != nkIdentDefs): illFormedAst(a, c.config) checkMinSonsLen(a, 3, c.config) - var L = sonsLen(a) - a.sons[L-2] = semGenericStmt(c, a.sons[L-2], flags+{withinTypeDesc}, ctx) - a.sons[L-1] = semGenericStmt(c, a.sons[L-1], flags, ctx) - for j in countup(0, L-3): - addTempDecl(c, getIdentNode(c, a.sons[j]), skParam) + 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]), 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) - if n.sons[namePos].kind != nkEmpty: - addTempDecl(c, getIdentNode(c, n.sons[0]), skProc) + if n[namePos].kind != nkEmpty: + addTempDecl(c, getIdentNode(c, n[0]), skProc) openScope(c) - n.sons[genericParamsPos] = semGenericStmt(c, n.sons[genericParamsPos], + n[genericParamsPos] = semGenericStmt(c, n[genericParamsPos], flags, ctx) - if n.sons[paramsPos].kind != nkEmpty: - if n.sons[paramsPos].sons[0].kind != nkEmpty: - addPrelimDecl(c, newSym(skUnknown, getIdent(c.cache, "result"), nil, n.info)) - n.sons[paramsPos] = semGenericStmt(c, n.sons[paramsPos], flags, ctx) - n.sons[pragmasPos] = semGenericStmt(c, n.sons[pragmasPos], flags, ctx) + if n[paramsPos].kind != nkEmpty: + if n[paramsPos][0].kind != nkEmpty: + 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 - if n.sons[namePos].kind == nkSym: - let s = n.sons[namePos].sym + if n[namePos].kind == nkSym: + let s = n[namePos].sym if sfGenSym in s.flags and s.ast == nil: - body = n.sons[bodyPos] + body = n[bodyPos] else: - body = s.getBody - else: body = n.sons[bodyPos] - n.sons[bodyPos] = semGenericStmtScope(c, body, flags, ctx) + body = getBody(c.graph, s) + else: body = n[bodyPos] + 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.sons[1] = semGenericStmt(c, n.sons[1], flags, ctx) + 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 countup(0, sonsLen(n) - 1): - result.sons[i] = semGenericStmt(c, n.sons[i], flags, ctx) + for i in 0..<n.len: + result[i] = semGenericStmt(c, n[i], flags, ctx) when defined(nimsuggest): if withinTypeDesc in flags: dec c.inTypeContext - proc semGenericStmt(c: PContext, n: PNode): PNode = - var ctx: GenericCtx - ctx.toMixin = 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() + 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 95b631850..1bc6d31a2 100644 --- a/compiler/seminst.nim +++ b/compiler/seminst.nim @@ -14,11 +14,11 @@ proc addObjFieldsToLocalScope(c: PContext; n: PNode) = template rec(n) = addObjFieldsToLocalScope(c, n) case n.kind of nkRecList: - for i in countup(0, len(n)-1): + for i in 0..<n.len: rec n[i] of nkRecCase: - if n.len > 0: rec n.sons[0] - for i in countup(1, len(n)-1): + if n.len > 0: rec n[0] + for i in 1..<n.len: if n[i].kind in {nkOfBranch, nkElse}: rec lastSon(n[i]) of nkSym: let f = n.sym @@ -28,85 +28,74 @@ 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.sons[0] == nil: break - t = t.sons[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 notin {tyTypeDesc, tyGenericParam, tyStatic}+tyTypeClasses: - continue - let symKind = if q.typ.kind == tyStatic: skConst else: skType - var s = newSym(symKind, q.name, getCurrOwner(c), q.info) - s.flags = s.flags + {sfUsed, sfFromGeneric} - var t = PType(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 in {tyTypeDesc, tyGenericParam, tyStatic, tyConcept}+tyTypeClasses: + let symKind = if q.typ.kind == tyStatic: skConst else: skType + var s = newSym(symKind, q.name, c.idgen, getCurrOwner(c), q.info) + s.flags.incl {sfUsed, sfFromGeneric} + 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: + if q.typ.kind != tyCompositeTypeClass: + localError(c.config, a.info, errCannotInstantiateX % s.name.s) + t = errorType(c) + elif t.kind in {tyGenericParam, tyConcept, tyFromExpr}: + localError(c.config, a.info, errCannotInstantiateX % q.name.s) t = errorType(c) - elif t.kind == tyGenericParam: - localError(c.config, a.info, errCannotInstantiateX % q.name.s) - t = errorType(c) - elif t.kind == tyGenericInvocation: - #t = instGenericContainer(c, a, t) - t = generateTypeInstance(c, pt, a, t) - #t = ReplaceTypeVarsT(cl, t) - s.typ = t - if t.kind == tyStatic: s.ast = t.n - yield s + 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: + #t = instGenericContainer(c, a, t) + t = generateTypeInstance(c, pt, a, t) + #t = ReplaceTypeVarsT(cl, t) + s.typ = t + if t.kind == tyStatic: s.ast = t.n + yield s proc sameInstantiation(a, b: TInstantiation): bool = if a.concreteTypes.len == b.concreteTypes.len: 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(genericSym: PSym, entry: TInstantiation; +proc genericCacheGet(g: ModuleGraph; genericSym: PSym, entry: TInstantiation; id: CompilesId): PSym = - if genericSym.procInstCache != nil: - for inst in genericSym.procInstCache: - if inst.compilesId == id and sameInstantiation(entry, inst[]): - return inst.sym + result = nil + for inst in procInstCacheItems(g, genericSym): + if (inst.compilesId == 0 or inst.compilesId == id) and sameInstantiation(entry, inst[]): + return inst.sym when false: proc `$`(x: PSym): string = result = x.name.s & " " & " id " & $x.id -proc freshGenSyms(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: @@ -114,47 +103,56 @@ proc freshGenSyms(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.kind == skPackage: + elif s.owner == nil or s.owner.kind == skPackage: #echo "copied this ", s.name.s - x = copySym(s, false) + x = copySym(s, c.idgen) x.owner = owner idTablePut(symMap, s, x) n.sym = x else: - for i in 0 ..< safeLen(n): freshGenSyms(n.sons[i], owner, orig, symMap) + for i in 0..<n.safeLen: freshGenSyms(c, n[i], owner, orig, symMap) proc addParamOrResult(c: PContext, param: PSym, kind: TSymKind) proc instantiateBody(c: PContext, n, params: PNode, result, orig: PSym) = - if n.sons[bodyPos].kind != nkEmpty: + if n[bodyPos].kind != nkEmpty: let procParams = result.typ.n - for i in 1 ..< procParams.len: + for i in 1..<procParams.len: addDecl(c, procParams[i].sym) maybeAddResult(c, result, result.ast) inc c.inGenericInst # add it here, so that recursive generic procs are possible: - var b = n.sons[bodyPos] - var symMap: TIdTable - initIdTable symMap + var b = n[bodyPos] + var symMap = initSymMapping() if params != nil: - for i in 1 ..< params.len: + 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(b, result, orig, symMap) - b = semProcBody(c, b) - b = hloBody(c, b) - n.sons[bodyPos] = transformBody(c.graph, c.module, b, result) - #echo "code instantiated ", result.name.s + freshGenSyms(c, b, result, orig, symMap) + + 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) excl(result.flags, sfForward) + trackProc(c, result, result.ast[bodyPos]) dec c.inGenericInst proc fixupInstantiatedSymbols(c: PContext, s: PSym) = - for i in countup(0, c.generics.len - 1): + for i in 0..<c.generics.len: if c.generics[i].genericSym.id == s.id: var oldPrc = c.generics[i].inst.sym pushProcCon(c, oldPrc) @@ -162,7 +160,7 @@ proc fixupInstantiatedSymbols(c: PContext, s: PSym) = pushInfoContext(c.config, oldPrc.info) openScope(c) var n = oldPrc.ast - n.sons[bodyPos] = copyTree(s.getBody) + n[bodyPos] = copyTree(getBody(c.graph, s)) instantiateBody(c, n, oldPrc.typ.n, oldPrc, s) closeScope(c) popInfoContext(c.config) @@ -179,17 +177,12 @@ proc instGenericContainer(c: PContext, info: TLineInfo, header: PType, allowMetaTypes = false): PType = internalAssert c.config, header.kind == tyGenericInvocation - var - typeMap: LayeredIdTable - cl: TReplTypeVars + var cl: TReplTypeVars = TReplTypeVars(symMap: initSymMapping(), + localCache: initTypeMapping(), typeMap: LayeredIdTable(), + info: info, c: c, allowMetaTypes: allowMetaTypes + ) - initIdTable(cl.symMap) - initIdTable(cl.localCache) - initIdTable(typeMap.topLayer) - cl.typeMap = addr(typeMap) - 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. @@ -197,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 - 2): - let genParam = genericTyp[i] + for i, genParam in genericBodyParams(genericTyp): var param: PSym template paramSym(kind): untyped = - newSym(kind, genParam.sym.name, genericTyp.sym, genParam.sym.info) + newSym(kind, genParam.sym.name, c.idgen, genericTyp.sym, genParam.sym.info) if genParam.kind == tyStatic: param = paramSym skConst @@ -213,24 +205,32 @@ proc instGenericContainer(c: PContext, info: TLineInfo, header: PType, param.typ = makeTypeDesc(c, header[i+1]) # this scope was not created by the user, - # unused params shoudn't be reported. + # unused params shouldn't be reported. param.flags.incl sfUsed addDecl(c, param) result = replaceTypeVarsT(cl, header) closeScope(c) -proc instantiateProcType(c: PContext, pt: TIdTable, +proc referencesAnotherParam(n: PNode, p: PSym): bool = + if n.kind == nkSym: + return n.sym.kind == skParam and n.sym.owner == p + else: + for i in 0..<n.safeLen: + if referencesAnotherParam(n[i], p): return true + return false + +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. # This is necessary, because the instantiation process may refer to # these params in situations like this: - # proc foo[Container](a: Container, b: a.type.Item): type(b.x) + # proc foo[Container](a: Container, b: a.type.Item): typeof(b.x) # # Alas, doing this here is probably not enough, because another # proc signature could appear in the params: - # proc foo[T](a: proc (x: T, b: type(x.y)) + # proc foo[T](a: proc (x: T, b: typeof(x.y)) # # The solution would be to move this logic into semtypinst, but # at this point semtypinst have to become part of sem, because it @@ -238,49 +238,129 @@ proc instantiateProcType(c: PContext, pt: TIdTable, #addDecl(c, prc) pushInfoContext(c.config, info) var typeMap = initLayeredTypeMap(pt) - var cl = initTypeVars(c, addr(typeMap), info, nil) + var cl = initTypeVars(c, typeMap, info, nil) 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) - result.sons[i] = replaceTypeVarsT(cl, result.sons[i]) - propagateToOwner(result, result.sons[i]) + + # 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 = resulti + + 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 + (typeToFit.kind != tyStatic): + typeToFit = result[i] + internalAssert c.config, originalParams[i].kind == nkSym - when true: - let oldParam = originalParams[i].sym - let param = copySym(oldParam) - param.owner = prc - param.typ = result.sons[i] - if oldParam.ast != nil: - param.ast = fitNode(c, param.typ, oldParam.ast, oldParam.ast.info) - - # don't be lazy here and call replaceTypeVarsN(cl, originalParams[i])! - result.n.sons[i] = newSymNode(param) - addDecl(c, param) - else: - let param = replaceTypeVarsN(cl, originalParams[i]) - result.n.sons[i] = param - param.sym.owner = prc - addDecl(c, result.n.sons[i].sym) + let oldParam = originalParams[i].sym + let param = copySym(oldParam, c.idgen) + param.owner = prc + param.typ = result[i] + + # The default value is instantiated and fitted against the final + # concrete param type. We avoid calling `replaceTypeVarsN` on the + # call head symbol, because this leads to infinite recursion. + if oldParam.ast != nil: + var def = oldParam.ast.copyTree + 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 + + var converted = indexTypesMatch(c, typeToFit, def.typ, def) + if converted == nil: + # The default value doesn't match the final instantiated type. + # As an example of this, see: + # https://github.com/nim-lang/Nim/issues/1201 + # We are replacing the default value with an error node in case + # 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] + + result.n[i] = newSymNode(param) + propagateToOwner(result, result[i]) + addDecl(c, param) resetIdTable(cl.symMap) resetIdTable(cl.localCache) - result.sons[0] = replaceTypeVarsT(cl, result.sons[0]) - result.n.sons[0] = originalParams[0].copyTree - if result.sons[0] != nil: - propagateToOwner(result, result.sons[0]) + cl.isReturnType = true + result.setReturnType replaceTypeVarsT(cl, result.returnType) + cl.isReturnType = false + result.n[0] = originalParams[0].copyTree + if result[0] != nil: + propagateToOwner(result, result[0]) eraseVoidParams(result) - skipIntLiteralParams(result) + skipIntLiteralParams(result, c.idgen) prc.typ = result popInfoContext(c.config) -proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, +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: + for bnd in p.localBindStmts: + for n in bnd: + addSym(c.currentScope, n.sym) + p = p.next + +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 @@ -288,76 +368,105 @@ proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, # no need to instantiate generic templates/macros: internalAssert c.config, fn.kind notin {skMacro, skTemplate} # generates an instantiated proc - if c.instCounter > 1000: internalError(c.config, fn.ast.info, "nesting too deep") - inc(c.instCounter) + if c.instCounter > 50: + globalError(c.config, info, "generic instantiation too nested") + 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, false) + 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) + # mixin scope: openScope(c) - let gp = n.sons[genericParamsPos] - internalAssert c.config, gp.kind != nkEmpty - n.sons[namePos] = newSymNode(result) - pushInfoContext(c.config, info) + fillMixinScope(c) + + openScope(c) + let gp = n[genericParamsPos] + 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 entry.sym = result # we need to compare both the generic types and the concrete types: # 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-1: - entry.concreteTypes[i] = result.typ.sons[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.sons[genericParamsPos] = c.graph.emptyNode - var oldPrc = genericCacheGet(fn, entry[], c.compilesContextId) + n[genericParamsPos] = c.graph.emptyNode + var oldPrc = genericCacheGet(c.graph, fn, entry[], c.compilesContextId) if oldPrc == nil: # we MUST not add potentially wrong instantiations to the caching mechanism. # This means recursive instantiations behave differently when in # a ``compiles`` context but this is the lesser evil. See # bug #1055 (tevilcompiles). #if c.compilesContextId == 0: - rawHandleSelf(c, result) entry.compilesId = c.compilesContextId - fn.procInstCache.safeAdd(entry) + addToGenericProcCache(c, fn, entry) c.generics.add(makeInstPair(fn, entry)) - if n.sons[pragmasPos].kind != nkEmpty: - pragma(c, result, n.sons[pragmasPos], allRoutinePragmas) - if isNil(n.sons[bodyPos]): - n.sons[bodyPos] = copyTree(fn.getBody) - if c.inGenericContext == 0: - instantiateBody(c, n, fn.typ.n, result, fn) + # 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)) + instantiateBody(c, n, fn.typ.n, result, fn) + c.optionStack[^1].otherPragmas = otherPragmas sideEffectsCheck(c, result) - if result.magic != mSlice: + 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) closeScope(c) # close scope for parameters + closeScope(c) # close scope for 'mixin' declarations popOwner(c) c.currentScope = oldScope discard c.friendModules.pop() - dec(c.instCounter) c.matchedConcept = oldMatchedConcept if result.kind == skMethod: finishMethod(c, result) + + # inform IC of the generic + #addGeneric(c.ic, result, entry.concreteTypes) diff --git a/compiler/semmacrosanity.nim b/compiler/semmacrosanity.nim index 02c56c035..727f36470 100644 --- a/compiler/semmacrosanity.nim +++ b/compiler/semmacrosanity.nim @@ -10,23 +10,23 @@ ## Implements type sanity checking for ASTs resulting from macros. Lots of ## room for improvement here. -import ast, astalgo, msgs, types, options +import ast, msgs, types, options proc ithField(n: PNode, field: var int): PSym = result = nil case n.kind of nkRecList: - for i in countup(0, sonsLen(n) - 1): - result = ithField(n.sons[i], field) + for i in 0..<n.len: + result = ithField(n[i], field) if result != nil: return of nkRecCase: - if n.sons[0].kind != nkSym: return - result = ithField(n.sons[0], field) + if n[0].kind != nkSym: return + result = ithField(n[0], field) if result != nil: return - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind + for i in 1..<n.len: + case n[i].kind of nkOfBranch, nkElse: - result = ithField(lastSon(n.sons[i]), field) + result = ithField(lastSon(n[i]), field) if result != nil: return else: discard of nkSym: @@ -34,6 +34,15 @@ proc ithField(n: PNode, field: var int): PSym = else: dec(field) else: discard +proc ithField(t: PType, field: var int): PSym = + var base = t.baseClass + while base != nil: + let b = skipTypes(base, skipPtrs) + result = ithField(b.n, field) + if result != nil: return result + base = b.baseClass + result = ithField(t.n, field) + proc annotateType*(n: PNode, t: PType; conf: ConfigRef) = let x = t.skipTypes(abstractInst+{tyRange}) # Note: x can be unequal to t and we need to be careful to use 't' @@ -42,22 +51,44 @@ proc annotateType*(n: PNode, t: PType; conf: ConfigRef) = of nkObjConstr: let x = t.skipTypes(abstractPtrs) n.typ = t - for i in 1 ..< n.len: + n[0].typ = t + for i in 1..<n.len: var j = i-1 - let field = x.n.ithField(j) + let field = x.ithField(j) if field.isNil: globalError conf, n.info, "invalid field at index " & $i else: - internalAssert(conf, n.sons[i].kind == nkExprColonExpr) - annotateType(n.sons[i].sons[1], field.typ, conf) + internalAssert(conf, n[i].kind == nkExprColonExpr) + annotateType(n[i][1], field.typ, conf) of nkPar, nkTupleConstr: 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 - else: annotateType(n.sons[i], x.sons[i], conf) + for i in 0..<n.len: + 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: @@ -83,12 +114,12 @@ 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") of nkNilLit: - if x.kind in NilableTypes: + if x.kind in NilableTypes+{tyString, tySequence}: n.typ = t else: globalError(conf, n.info, "nil literal must be of some pointer type") diff --git a/compiler/semmagic.nim b/compiler/semmagic.nim index 1975fb77b..a12e933e7 100644 --- a/compiler/semmagic.nim +++ b/compiler/semmagic.nim @@ -10,20 +10,51 @@ # This include file implements the semantic checking for magics. # included from sem.nim -proc semAddr(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}: + 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 + if n.len == 3: + let mode = semConstExpr(c, n[2]) + if mode.kind != nkIntLit: + localError(c.config, n.info, "typeof: cannot evaluate 'mode' parameter at compile-time") + else: + m = mode.intVal result = newNodeI(nkTypeOfExpr, n.info) - let typExpr = semExprWithType(c, n, {efInTypeof}) + 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 @@ -32,50 +63,58 @@ type proc semAsgn(c: PContext, n: PNode; mode=asgnNormal): PNode proc semSubscript(c: PContext, n: PNode, flags: TExprFlags): PNode -proc skipAddr(n: PNode): PNode {.inline.} = - (if n.kind == nkHiddenAddr: n.sons[0] else: n) - proc semArrGet(c: PContext; n: PNode; flags: TExprFlags): PNode = result = newNodeI(nkBracketExpr, n.info) for i in 1..<n.len: result.add(n[i]) result = semSubscript(c, result, flags) if result.isNil: let x = copyTree(n) - x.sons[0] = newIdentNode(getIdent(c.cache, "[]"), n.info) - bracketNotFoundError(c, x) + x[0] = newIdentNode(getIdent(c.cache, "[]"), n.info) + 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) - for i in 2..n.len-2: b.add(n[i]) + b.add(n[1].skipHiddenAddr) + for i in 2..<n.len-1: b.add(n[i]) result = newNodeI(nkAsgn, n.info, 2) - result.sons[0] = b - result.sons[1] = n.lastSon + 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) - result.sons[0] = n[1] - result.sons[1] = n[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) proc semIsPartOf(c: PContext, n: PNode, flags: TExprFlags): PNode = var r = isPartOf(n[1], n[2]) - result = newIntNodeT(ord(r), n, c.graph) + result = newIntNodeT(toInt128(ord(r)), n, c.idgen, c.graph) 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) - let idx = expectIntLit(c, n.sons[1]) - let useFullPaths = expectIntLit(c, n.sons[2]) + let idx = expectIntLit(c, n[1]) + let useFullPaths = expectIntLit(c, n[2]) let info = getInfoContext(c.config, idx) var filename = newNodeIT(nkStrLit, n.info, getSysType(c.graph, n.info, tyString)) filename.strVal = if useFullPaths != 0: toFullPath(c.config, info) else: toFilename(c.config, info) @@ -83,9 +122,10 @@ proc semInstantiationInfo(c: PContext, n: PNode): PNode = line.intVal = toLinenumber(info) var column = newNodeIT(nkIntLit, n.info, getSysType(c.graph, n.info, tyInt)) column.intVal = toColumn(info) - result.add(filename) - result.add(line) - result.add(column) + # filename: string, line: int, column: int + result.add(newTree(nkExprColonExpr, n.typ.n[0], filename)) + result.add(newTree(nkExprColonExpr, n.typ.n[1], line)) + result.add(newTree(nkExprColonExpr, n.typ.n[2], column)) proc toNode(t: PType, i: TLineInfo): PNode = result = newNodeIT(nkType, i, t) @@ -107,9 +147,22 @@ proc uninstantiate(t: PType): PType = result = case t.kind of tyMagicGenerics: t of tyUserDefinedGenerics: t.base - of tyCompositeTypeClass: uninstantiate t.sons[1] + of tyCompositeTypeClass: uninstantiate t.firstGenericParam else: t +proc getTypeDescNode(c: PContext; typ: PType, sym: PSym, info: TLineInfo): PNode = + 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] @@ -117,50 +170,89 @@ proc evalTypeTrait(c: PContext; traitCall: PNode, operand: PType, context: PSym) var operand = operand.skipTypes(skippedTypes) template operand2: PType = - traitCall.sons[2].typ.skipTypes({tyTypeDesc}) + traitCall[2].typ.skipTypes({tyTypeDesc}) - template typeWithSonsResult(kind, sons): PNode = - newTypeWithSons(context, kind, sons).toNode(traitCall.info) + if operand.kind == tyGenericParam or (traitCall.len > 2 and operand2.kind == tyGenericParam): + return traitCall ## too early to evaluate - case trait.sym.name.s + 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]) - of "name": + return buildNotPredicate(c, context, operand).toNode(traitCall.info) + of "typeToString": + var prefer = preferTypeName + if traitCall.len >= 2: + let preferStr = traitCall[2].strVal + prefer = parseEnum[TPreferedDesc](preferStr) + result = newStrNode(nkStrLit, operand.typeToString(prefer)) + result.typ = getSysType(c.graph, traitCall[1].info, tyString) + result.info = traitCall.info + of "name", "$": result = newStrNode(nkStrLit, operand.typeToString(preferTypeName)) - result.typ = newType(tyString, context) + result.typ = getSysType(c.graph, traitCall[1].info, tyString) result.info = traitCall.info of "arity": result = newIntNode(nkIntLit, operand.len - ord(operand.kind==tyProc)) - result.typ = newType(tyInt, context) + result.typ = newType(tyInt, c.idgen, context) result.info = traitCall.info of "genericHead": - var res = uninstantiate(operand) - if res == operand and res.kind notin tyMagicGenerics: - localError(c.config, traitCall.info, - "genericHead expects a generic type. The given type was " & - typeToString(operand)) - return newType(tyError, context).toNode(traitCall.info) - result = res.base.toNode(traitCall.info) + var arg = operand + case arg.kind + of tyGenericInst: + result = getTypeDescNode(c, arg.base, operand.owner, traitCall.info) + # of tySequence: # this doesn't work + # var resType = newType(tySequence, operand.owner) + # result = toNode(resType, traitCall.info) # doesn't work yet + else: + localError(c.config, traitCall.info, "expected generic type, got: type $2 of kind $1" % [arg.kind.toHumanStr, typeToString(operand)]) + result = newType(tyError, c.idgen, context).toNode(traitCall.info) of "stripGenericParams": result = uninstantiate(operand).toNode(traitCall.info) of "supportsCopyMem": let t = operand.skipTypes({tyVar, tyLent, tyGenericInst, tyAlias, tySink, tyInferred}) let complexObj = containsGarbageCollectedRef(t) or hasDestructor(t) - result = newIntNodeT(ord(not complexObj), traitCall, c.graph) + 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 + result = newIntNodeT(toInt128(ord(cond)), traitCall, c.idgen, c.graph) + of "tupleLen": + var operand = operand.skipTypes({tyGenericInst}) + assert operand.kind == tyTuple, $operand.kind + 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 + 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") + localError(c.config, traitCall.info, "unknown trait: " & s) result = newNodeI(nkEmpty, traitCall.info) proc semTypeTraits(c: PContext, n: PNode): PNode = checkMinSonsLen(n, 2, c.config) - let t = n.sons[1].typ - internalAssert c.config, t != nil and t.kind == tyTypeDesc - if t.sonsLen > 0: + let t = n[1].typ + 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) result = evalTypeTrait(c, n, t, getCurrOwner(c)) @@ -170,29 +262,25 @@ proc semTypeTraits(c: PContext, n: PNode): PNode = proc semOrd(c: PContext, n: PNode): PNode = result = n - let parType = n.sons[1].typ - if isOrdinalType(parType): + let parType = n[1].typ + if isOrdinalType(parType, allowEnumWithHoles=true): discard - elif parType.kind == tySet: - result.typ = makeRangeType(c, firstOrd(c.config, parType), lastOrd(c.config, parType), 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 = result = copyNode(n) - result.add(n.sons[0]) + result.add(n[0]) - let sl = semConstExpr(c, n.sons[1]) + let sl = semConstExpr(c, n[1]) if sl.kind notin {nkStrLit, nkRStrLit, nkTripleStrLit}: - localError(c.config, n.sons[1].info, errStringLiteralExpected) - return errorNode(c, n) + return localErrorNode(c, n, n[1].info, errStringLiteralExpected) - let isMixin = semConstExpr(c, n.sons[2]) + let isMixin = semConstExpr(c, n[2]) if isMixin.kind != nkIntLit or isMixin.intVal < 0 or isMixin.intVal > high(TSymChoiceRule).int: - localError(c.config, n.sons[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}) @@ -205,20 +293,80 @@ proc semBindSym(c: PContext, n: PNode): PNode = return sc result.add(sc) else: - errorUndeclaredIdentifier(c, n.sons[1].info, sl.strVal) + errorUndeclaredIdentifier(c, n[1].info, sl.strVal) + +proc opBindSym(c: PContext, scope: PScope, n: PNode, isMixin: int, info: PNode): PNode = + if n.kind notin {nkStrLit, nkRStrLit, nkTripleStrLit, nkIdent}: + return localErrorNode(c, n, info.info, errStringOrIdentNodeExpected) + + if isMixin < 0 or isMixin > high(TSymChoiceRule).int: + return localErrorNode(c, n, info.info, errConstExprExpected) + + let id = if n.kind == nkIdent: n + else: newIdentNode(getIdent(c.cache, n.strVal), info.info) + + let tmpScope = c.currentScope + c.currentScope = scope + let s = qualifiedLookUp(c, id, {checkUndeclared}) + if s != nil: + # 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 + +proc semDynamicBindSym(c: PContext, n: PNode): PNode = + # inside regular code, bindSym resolves to the sym-choice + # nodes (see tinspectsymbol) + if not (c.inStaticContext > 0 or getCurrOwner(c).isCompileTimeProc): + return semBindSym(c, n) + + if c.graph.vm.isNil: + setupGlobalCtx(c.module, c.graph, c.idgen) + + let + vm = PCtx c.graph.vm + # cache the current scope to + # prevent it lost into oblivion + scope = c.currentScope + + # cannot use this + # vm.config.features.incl dynamicBindSym + + proc bindSymWrapper(a: VmArgs) = + # capture PContext and currentScope + # param description: + # 0. ident, a string literal / computed string / or ident node + # 1. bindSym rule + # 2. info node + a.setResult opBindSym(c, scope, a.getNode(0), a.getInt(1).int, a.getNode(2)) + + let + # although we use VM callback here, it is not + # executed like 'normal' VM callback + idx = vm.registerCallback("bindSymImpl", bindSymWrapper) + # dummy node to carry idx information to VM + idxNode = newIntTypeNode(idx, c.graph.getSysType(TLineInfo(), tyInt)) + + result = copyNode(n) + for x in n: result.add x + result.add n # info node + result.add idxNode proc semShallowCopy(c: PContext, n: PNode, flags: TExprFlags): PNode proc semOf(c: PContext, n: PNode): PNode = - if sonsLen(n) == 3: - n.sons[1] = semExprWithType(c, n.sons[1]) - n.sons[2] = semExprWithType(c, n.sons[2], {efDetermineType}) - #restoreOldStyleType(n.sons[1]) - #restoreOldStyleType(n.sons[2]) - let a = skipTypes(n.sons[1].typ, abstractPtrs) - let b = skipTypes(n.sons[2].typ, abstractPtrs) - let x = skipTypes(n.sons[1].typ, abstractPtrs-{tyTypeDesc}) - let y = skipTypes(n.sons[2].typ, abstractPtrs-{tyTypeDesc}) + if n.len == 3: + n[1] = semExprWithType(c, n[1]) + n[2] = semExprWithType(c, n[2], {efDetermineType}) + #restoreOldStyleType(n[1]) + #restoreOldStyleType(n[2]) + let a = skipTypes(n[1].typ, abstractPtrs) + let b = skipTypes(n[2].typ, abstractPtrs) + let x = skipTypes(n[1].typ, abstractPtrs-{tyTypeDesc}) + let y = skipTypes(n[2].typ, abstractPtrs-{tyTypeDesc}) if x.kind == tyTypeDesc or y.kind != tyTypeDesc: localError(c.config, n.info, "'of' takes object types") @@ -238,28 +386,217 @@ proc semOf(c: PContext, n: PNode): PNode = result.typ = getSysType(c.graph, n.info, tyBool) return result elif diff == high(int): - localError(c.config, n.info, "'$1' cannot be of this subtype" % typeToString(a)) + if commonSuperclass(a, b) == nil: + localError(c.config, n.info, "'$1' cannot be of this subtype" % typeToString(a)) + else: + message(c.config, n.info, hintConditionAlwaysFalse, renderTree(n)) + result = newIntNode(nkIntLit, 0) + result.info = n.info + result.typ = getSysType(c.graph, n.info, tyBool) else: localError(c.config, n.info, "'of' takes 2 arguments") n.typ = getSysType(c.graph, n.info, tyBool) result = n +proc semUnown(c: PContext; n: PNode): PNode = + proc unownedType(c: PContext; t: PType): PType = + case t.kind + of tyTuple: + var elems = newSeq[PType](t.len) + var someChange = false + for i in 0..<t.len: + elems[i] = unownedType(c, t[i]) + if elems[i] != t[i]: someChange = true + if someChange: + 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.elementType + of tySequence, tyOpenArray, tyArray, tyVarargs, tyVar, tyLent, + tyGenericInst, tyAlias: + let b = unownedType(c, t[^1]) + if b != t[^1]: + result = copyType(t, c.idgen, t.owner) + copyTypeProps(c.graph, c.idgen.module, result, t) + + result[^1] = b + result.flags.excl tfHasOwned + else: + result = t + else: + result = t + + result = copyTree(n[1]) + result.typ = unownedType(c, result.typ) + # little hack for injectdestructors.nim (see bug #11350): + #result[0].typ = nil + +proc turnFinalizerIntoDestructor(c: PContext; orig: PSym; info: TLineInfo): PSym = + # We need to do 2 things: Replace n.typ which is a 'ref T' by a 'var T' type. + # 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; n: PNode; old, fresh: PType; oldParam, newParam: PSym): PNode = + result = shallowCopy(n) + if sameTypeOrNil(n.typ, old): + result.typ = fresh + if n.kind == nkSym and n.sym == oldParam: + result.sym = newParam + for i in 0 ..< safeLen(n): + result[i] = transform(c, n[i], old, fresh, oldParam, newParam) + #if n.kind == nkDerefExpr and sameType(n[0].typ, old): + # result = + + result = copySym(orig, c.idgen) + result.info = info + result.flags.incl sfFromGeneric + result.owner = orig + let origParamType = orig.typ.firstParamType + let newParamType = makeVarType(result, origParamType.skipTypes(abstractPtrs), c.idgen) + let oldParam = orig.typ.n[1].sym + let newParam = newSym(skParam, oldParam.name, c.idgen, result, result.info) + newParam.typ = newParamType + # proc body: + result.ast = transform(c, orig.ast, origParamType, newParamType, oldParam, newParam) + # proc signature: + result.typ = newProcType(result.info, c.idgen, result) + result.typ.addParam newParam + +proc semQuantifier(c: PContext; n: PNode): PNode = + checkSonsLen(n, 2, c.config) + openScope(c) + result = newNodeIT(n.kind, n.info, n.typ) + result.add n[0] + let args = n[1] + assert args.kind == nkArgList + for i in 0..args.len-2: + let it = args[i] + var valid = false + if it.kind == nkInfix: + let op = considerQuotedIdent(c, it[0]) + if op.id == ord(wIn): + let v = newSymS(skForVar, it[1], c) + styleCheckDef(c, v) + onDef(it[1].info, v) + let domain = semExprWithType(c, it[2], {efWantIterator}) + v.typ = domain.typ + valid = true + addDecl(c, v) + result.add newTree(nkInfix, it[0], newSymNode(v), domain) + if not valid: + localError(c.config, n.info, "<quantifier> 'in' <range> expected") + result.add forceBool(c, semExprWithType(c, args[^1])) + closeScope(c) + +proc semOld(c: PContext; n: PNode): PNode = + if n[1].kind == nkHiddenDeref: + n[1] = n[1][0] + if n[1].kind != nkSym or n[1].sym.kind != skParam: + localError(c.config, n[1].info, "'old' takes a parameter name") + elif n[1].sym.owner != getCurrOwner(c): + localError(c.config, n[1].info, n[1].sym.name.s & " does not belong to " & getCurrOwner(c).name.s) + 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 + ## ``flags`` Some flags for more contextual information on how the + ## "macro" is calld. + case n[0].sym.magic of mAddr: checkSonsLen(n, 2, c.config) - result = semAddr(c, n.sons[1], n[0].sym.name.s == "unsafeAddr") + result = semAddr(c, n[1]) of mTypeOf: - checkSonsLen(n, 2, c.config) - result = semTypeOf(c, n.sons[1]) - of mArrGet: result = semArrGet(c, n, flags) - of mArrPut: result = semArrPut(c, n, flags) + result = semTypeOf(c, n) + of mSizeOf: + result = foldSizeOf(c.config, n, n) + of mAlignOf: + result = foldAlignOf(c.config, n, n) + of mOffsetOf: + result = foldOffsetOf(c.config, n, n) + of mArrGet: + result = semArrGet(c, n, flags) + of mArrPut: + 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 = n + result = semShallowCopy(c, n, flags) of mIsPartOf: result = semIsPartOf(c, n, flags) of mTypeTrait: result = semTypeTraits(c, n) of mAstToStr: @@ -270,14 +607,16 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, of mOf: result = semOf(c, n) of mHigh, mLow: result = semLowHigh(c, n, n[0].sym.magic) of mShallowCopy: result = semShallowCopy(c, n, flags) - of mNBindSym: result = semBindSym(c, n) + of mNBindSym: + if dynamicBindSym notin c.features: + result = semBindSym(c, n) + else: + result = semDynamicBindSym(c, n) of mProcCall: result = n result.typ = n[1].typ of mDotDot: result = n - of mRoof: - localError(c.config, n.info, "builtin roof operator is not supported anymore") of mPlugin: let plugin = getPlugin(c.cache, n[0].sym) if plugin.isNil: @@ -285,4 +624,86 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, result = n else: result = plugin(c, n) - else: result = n + of mNew: + if n[0].sym.name.s == "unsafeNew": # special case for unsafeNew + result = n + else: + result = addDefaultFieldForNew(c, n) + of mNewFinalize: + 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: + result = semQuantifier(c, n) + of mOld: + result = semOld(c, n) + of mSetLengthSeq: + result = n + let seqType = result[1].typ.skipTypes({tyPtr, tyRef, # in case we had auto-dereferencing + tyVar, tyGenericInst, tyOwned, tySink, + tyAlias, tyUserTypeClassInst}) + if seqType.kind == tySequence and seqType.base.requiresInit: + message(c.config, n.info, warnUnsafeSetLen, typeToString(seqType.base)) + of mDefault: + 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 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 8b639806d..048053115 100644 --- a/compiler/semobjconstr.nim +++ b/compiler/semobjconstr.nim @@ -11,14 +11,29 @@ # included from sem.nim +from std/sugar import dup + type - InitStatus = enum + ObjConstrContext = object + typ: PType # The constructed type + initExpr: PNode # The init expression (nkObjConstr) + needsFullInit: bool # A `requiresInit` derived type will + # 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 initFull # All of the fields have been initialized initPartial # Some of the fields have been initialized 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: @@ -47,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: + 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, @@ -62,37 +76,56 @@ 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) - assignment.sons[0] = newSymNode(field) - assignment.sons[1] = initValue + 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-2: - 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 = + if caseNode[caseIdx].kind == nkOfBranch: + result = initIntSet() + for val in processBranchVals(caseNode[caseIdx]): + result.incl(val) + else: + result = c.getIntSetOfType(caseNode[0].typ) + for i in 1..<caseNode.len-1: + for val in processBranchVals(caseNode[i]): + 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] + skipped = caseNode[0].skipHidden + if skipped.kind == nkSym and skipped.sym == discrimator.sym: + return (caseNode, index) proc pickCaseBranch(caseExpr, matched: PNode): PNode = # XXX: Perhaps this proc already exists somewhere let endsWithElse = caseExpr[^1].kind == nkElse - for i in 1 .. caseExpr.len - 1 - int(endsWithElse): + for i in 1..<caseExpr.len - int(endsWithElse): if caseExpr[i].caseBranchMatchesExpr(matched): 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 @@ -103,188 +136,371 @@ 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 & "'" proc fieldsPresentInInitExpr(c: PContext, fieldsRecList, initExpr: PNode): string = result = "" for field in directFieldsInRecList(fieldsRecList): - let assignment = locateFieldInInitExpr(c, field.sym, initExpr) - if assignment != nil: + if locateFieldInInitExpr(c, field.sym, initExpr) != nil: if result.len != 0: result.add ", " result.add field.sym.name.s.quoteStr -proc missingMandatoryFields(c: PContext, fieldsRecList, initExpr: PNode): string = - for r in directFieldsInRecList(fieldsRecList): - if {tfNotNil, tfNeedsInit} * r.sym.typ.flags != {}: - let assignment = locateFieldInInitExpr(c, r.sym, initExpr) - if assignment == nil: - if result == nil: - result = r.sym.name.s - else: - result.add ", " - result.add r.sym.name.s - -proc checkForMissingFields(c: PContext, recList, initExpr: PNode) = - let missing = missingMandatoryFields(c, recList, initExpr) - if missing != nil: - localError(c.config, initExpr.info, "fields not initialized: $1.", [missing]) +proc locateFieldInDefaults(sym: PSym, defaults: seq[PNode]): bool = + result = false + for d in defaults: + if sym.id == d[0].sym.id: + return true -proc semConstructFields(c: PContext, recNode: PNode, - initExpr: PNode, flags: TExprFlags): InitStatus = - result = initUnknown +proc collectMissingFields(c: PContext, fieldsRecList: PNode, + constrCtx: var ObjConstrContext, defaults: seq[PNode] + ): seq[PSym] = + result = @[] + for r in directFieldsInRecList(fieldsRecList): + 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 - case recNode.kind +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 recNode: - let status = semConstructFields(c, field, initExpr, flags) - mergeInitStatus(result, status) - + for field in n: + 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 = recNode[branchIdx] - let fields = branch[branch.len - 1] - fieldsPresentInInitExpr(c, fields, initExpr) + let branch = n[branchIdx] + let fields = branch[^1] + fieldsPresentInInitExpr(c, fields, constrCtx.initExpr) - template checkMissingFields(branchNode: PNode) = - let fields = branchNode[branchNode.len - 1] - checkForMissingFields(c, fields, initExpr) - - let discriminator = recNode.sons[0] + let discriminator = n[0] internalAssert c.config, discriminator.kind == nkSym var selectedBranch = -1 - for i in 1 ..< recNode.len: - let innerRecords = recNode[i][^1] - let status = semConstructFields(c, innerRecords, initExpr, flags) + for i in 1..<n.len: + let innerRecords = n[i][^1] + 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) - localError(c.config, initExpr.info, + localError(c.config, constrCtx.initExpr.info, ("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: - let branchNode = recNode[selectedBranch] - let flags = flags*{efAllowDestructor} + {efNeedStatic, efPreferNilResult} - let discriminatorVal = semConstrField(c, flags, - discriminator.sym, initExpr) - if discriminatorVal == nil: - let fields = fieldsPresentInBranch(selectedBranch) - localError(c.config, initExpr.info, - ("you must provide a compile-time value for the discriminator '$1' " & - "in order to prove that it's safe to initialize $2.") % - [discriminator.sym.name.s, fields]) - mergeInitStatus(result, initNone) - else: - let discriminatorVal = discriminatorVal.skipHidden - - template wrongBranchError(i) = + template badDiscriminatorError = + 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) = + if c.inUncheckedAssignSection == 0: let fields = fieldsPresentInBranch(i) - localError(c.config, initExpr.info, - "a case selecting discriminator '$1' with value '$2' " & + 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.", + "are in conflict with this value.") % [discriminator.sym.name.s, discriminatorVal.renderTree, fields]) + template valuesInConflictError(valsDiff) = + localError(c.config, discriminatorVal.info, ("possible values " & + "$2 are in conflict with discriminator values for " & + "selected object branch $1.") % [$selectedBranch, + valsDiff.renderAsType(n[0].typ)]) + + let branchNode = n[selectedBranch] + let flags = {efPreferStatic, efPreferNilResult} + var discriminatorVal = semConstrField(c, flags, + discriminator.sym, + constrCtx.initExpr) + if discriminatorVal != nil: + discriminatorVal = discriminatorVal.skipHidden + if discriminatorVal.kind notin nkLiterals and ( + not isOrdinalType(discriminatorVal.typ, true) or + lengthOrd(c.config, discriminatorVal.typ) > MaxSetElements or + lengthOrd(c.config, n[0].typ) > MaxSetElements): + localError(c.config, discriminatorVal.info, + "branch initialization with a runtime discriminator only " & + "supports ordinal types with 2^16 elements or less.") + + if discriminatorVal == nil: + badDiscriminatorError() + elif discriminatorVal.kind == nkSym: + let (ctorCase, ctorIdx) = findUsefulCaseContext(c, discriminatorVal) + if ctorCase == nil: + if discriminatorVal.typ.kind == tyRange: + let rangeVals = c.getIntSetOfType(discriminatorVal.typ) + let recBranchVals = branchVals(c, n, selectedBranch, false) + let diff = rangeVals - recBranchVals + if diff.len != 0: + valuesInConflictError(diff) + else: + badDiscriminatorError() + elif discriminatorVal.sym.kind notin {skLet, skParam} or + discriminatorVal.sym.typ.kind in {tyVar}: + if c.inUncheckedAssignSection == 0: + localError(c.config, discriminatorVal.info, + "runtime discriminator must be immutable if branch fields are " & + "initialized, a 'let' binding is required.") + elif ctorCase[ctorIdx].kind == nkElifBranch: + localError(c.config, discriminatorVal.info, "branch initialization " & + "with a runtime discriminator is not supported inside of an " & + "`elif` branch.") + else: + var + ctorBranchVals = branchVals(c, ctorCase, ctorIdx, true) + recBranchVals = branchVals(c, n, selectedBranch, false) + branchValsDiff = ctorBranchVals - recBranchVals + if branchValsDiff.len != 0: + valuesInConflictError(branchValsDiff) + else: + var failedBranch = -1 if branchNode.kind != nkElse: if not branchNode.caseBranchMatchesExpr(discriminatorVal): - wrongBranchError(selectedBranch) + failedBranch = selectedBranch else: # With an else clause, check that all other branches don't match: - for i in 1 .. (recNode.len - 2): - if recNode[i].caseBranchMatchesExpr(discriminatorVal): - wrongBranchError(i) + for i in 1..<n.len - 1: + if n[i].caseBranchMatchesExpr(discriminatorVal): + failedBranch = i break + if failedBranch != -1: + if discriminatorVal.typ.kind == tyRange: + let rangeVals = c.getIntSetOfType(discriminatorVal.typ) + let recBranchVals = branchVals(c, n, selectedBranch, false) + let diff = rangeVals - recBranchVals + if diff.len != 0: + valuesInConflictError(diff) + 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: - checkMissingFields 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, initExpr) + 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 matchedBranch = recNode.pickCaseBranch newIntLit(c.graph, initExpr.info, 0) - checkMissingFields 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 brach will be selected: - let matchedBranch = recNode.pickCaseBranch discriminatorVal - if matchedBranch != nil: checkMissingFields matchedBranch + # which branch will be selected: + let matchedBranch = n.pickCaseBranch discriminatorVal + 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 ..< recNode.len: checkMissingFields recNode[i] + collectBranchFields(c, n, discriminatorVal, constrCtx, flags) of nkSym: - let field = recNode.sym - let e = semConstrField(c, flags, field, initExpr) - result = if e != nil: initFull else: initNone - + let field = n.sym + let e = semConstrField(c, flags, field, constrCtx.initExpr) + 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 semConstructType(c: PContext, initExpr: PNode, - t: PType, flags: TExprFlags): InitStatus = - var t = t - result = initUnknown +proc semConstructTypeAux(c: PContext, + constrCtx: var ObjConstrContext, + flags: TExprFlags): tuple[status: InitStatus, defaults: seq[PNode]] = + result = (initUnknown, @[]) + var t = constrCtx.typ while true: - let status = semConstructFields(c, t.n, initExpr, 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}: - checkForMissingFields c, t.n, initExpr - let base = t.sons[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 + # there are some issues in semtypinst. Luckily, it + # seems to affect only `computeRequiresInit`. + return + constrCtx.needsFullInit = constrCtx.needsFullInit or + tfNeedsFullInit in t.flags + +proc initConstrContext(t: PType, initExpr: PNode): ObjConstrContext = + ObjConstrContext(typ: t, initExpr: initExpr, + needsFullInit: tfNeedsFullInit in t.flags) + +proc computeRequiresInit(c: PContext, t: PType): bool = + assert t.kind == tyObject + var constrCtx = initConstrContext(t, newNode(nkObjConstr)) + 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.last + assert objType != nil + if objType.kind == tyObject: + var constrCtx = initConstrContext(objType, newNodeI(nkObjConstr, info)) + 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)) + else: + assert false, "Must not enter here." -proc semObjConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = - var t = semTypeNode(c, n.sons[0], nil) +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 - - t = skipTypes(t, {tyGenericInst, tyAlias, tySink}) - if t.kind == tyRef: t = skipTypes(t.sons[0], {tyGenericInst, tyAlias, tySink}) + 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.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): - let initResult = semConstructType(c, result, t, flags) + var constrCtx = initConstrContext(t, result) + 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. - # XXX: Turn this into an error in the next release - if tfNeedsInit in t.flags and initResult != initFull: - # XXX: Disable this warning for now, because tfNeedsInit is propagated - # too aggressively from fields to object types (and this is not correct - # in case objects) - when false: message(n.info, warnUser, - "object type uses the 'requiresInit' pragma, but not all fields " & - "have been initialized. future versions of Nim will treat this as " & - "an error") + # 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." % + [t.sym.name.s, listSymbolNames(constrCtx.missingFields)]) # Since we were traversing the object fields, it's possible that # not all of the fields specified in the constructor was visited. @@ -294,15 +510,27 @@ 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: # 1) It was shadowed by a field with the same name on the left - for j in 1 ..< i: + for j in 1..<i: 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 0d780bdee..23a8e6362 100644 --- a/compiler/semparallel.nim +++ b/compiler/semparallel.nim @@ -22,11 +22,11 @@ # - output slices need special logic (+) import - ast, astalgo, idents, lowerings, magicsys, guards, sempass2, msgs, - renderer, types, modulegraphs, options + ast, astalgo, idents, lowerings, magicsys, guards, msgs, + renderer, types, modulegraphs, options, spawn, lineinfos -from trees import getMagic -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.o = initOperators(g) - result.graph = g + result.guards.g = g proc lookupSlot(c: AnalysisCtx; s: PSym): int = for i in 0..<c.locals.len: @@ -92,10 +92,9 @@ proc lookupSlot(c: AnalysisCtx; s: PSym): int = proc getSlot(c: var AnalysisCtx; v: PSym): ptr MonotonicVar = let s = lookupSlot(c, v) if s >= 0: return addr(c.locals[s]) - let L = c.locals.len - c.locals.setLen(L+1) - c.locals[L].v = v - return addr(c.locals[L]) + c.locals.setLen(c.locals.len+1) + c.locals[^1].v = v + return addr(c.locals[^1]) proc gatherArgs(c: var AnalysisCtx; n: PNode) = for i in 0..<n.safeLen: @@ -123,21 +122,23 @@ proc checkLocal(c: AnalysisCtx; n: PNode) = if s >= 0 and c.locals[s].stride != nil: localError(c.graph.config, n.info, "invalid usage of counter after increment") else: - for i in 0 ..< n.safeLen: checkLocal(c, n.sons[i]) + for i in 0..<n.safeLen: checkLocal(c, n[i]) template `?`(x): untyped = x.renderTree proc checkLe(c: AnalysisCtx; a, b: PNode) = case proveLe(c.guards, a, b) of impUnknown: - localError(c.graph.config, a.info, "cannot prove: " & ?a & " <= " & ?b & " (bounds check)") + message(c.graph.config, a.info, warnStaticIndexCheck, + "cannot prove: " & ?a & " <= " & ?b) of impYes: discard of impNo: - localError(c.graph.config, a.info, "can prove: " & ?a & " > " & ?b & " (bounds check)") + message(c.graph.config, a.info, warnStaticIndexCheck, + "can prove: " & ?a & " > " & ?b) proc checkBounds(c: AnalysisCtx; arr, idx: PNode) = checkLe(c, lowBound(c.graph.config, arr), idx) - checkLe(c, idx, highBound(c.graph.config, arr, c.guards.o)) + checkLe(c, idx, highBound(c.graph.config, arr, c.graph.operators)) proc addLowerBoundAsFacts(c: var AnalysisCtx) = for v in c.locals: @@ -146,8 +147,8 @@ proc addLowerBoundAsFacts(c: var AnalysisCtx) = proc addSlice(c: var AnalysisCtx; n: PNode; x, le, ri: PNode) = checkLocal(c, n) - let le = le.canon(c.guards.o) - let ri = ri.canon(c.guards.o) + let le = le.canon(c.graph.operators) + let ri = ri.canon(c.graph.operators) # perform static bounds checking here; and not later! let oldState = c.guards.s.len addLowerBoundAsFacts(c) @@ -163,17 +164,17 @@ proc overlap(m: TModel; conf: ConfigRef; x,y,c,d: PNode) = case proveLe(m, x, d) of impNo: discard of impUnknown, impYes: - localError(conf, x.info, + message(conf, x.info, warnStaticIndexCheck, "cannot prove: $# > $#; required for ($#)..($#) disjoint from ($#)..($#)" % [?c, ?y, ?x, ?y, ?c, ?d]) of impYes: case proveLe(m, x, d) of impUnknown: - localError(conf, x.info, + message(conf, x.info, warnStaticIndexCheck, "cannot prove: $# > $#; required for ($#)..($#) disjoint from ($#)..($#)" % [?x, ?d, ?x, ?y, ?c, ?d]) of impYes: - localError(conf, x.info, "($#)..($#) not disjoint from ($#)..($#)" % + message(conf, x.info, warnStaticIndexCheck, "($#)..($#) not disjoint from ($#)..($#)" % [?c, ?y, ?x, ?y, ?c, ?d]) of impNo: discard of impNo: discard @@ -183,20 +184,23 @@ 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: - for i in 0 ..< n.safeLen: result += stride(c, n.sons[i]) + result = 0 + for i in 0..<n.safeLen: result += stride(c, n[i]) proc subStride(c: AnalysisCtx; n: PNode): PNode = # substitute with stride: if isLocal(n): let s = c.lookupSlot(n.sym) if s >= 0 and c.locals[s].stride != nil: - result = buildAdd(n, c.locals[s].stride.intVal, c.guards.o) + result = buildAdd(n, c.locals[s].stride.intVal, c.graph.operators) else: result = n elif n.safeLen > 0: result = shallowCopy(n) - for i in 0 ..< n.len: result.sons[i] = subStride(c, n.sons[i]) + for i in 0..<n.len: result[i] = subStride(c, n[i]) else: result = n @@ -216,8 +220,8 @@ proc checkSlicesAreDisjoint(c: var AnalysisCtx) = # # Or even worse: # while true: - # spawn f(a[i+1 .. i+3]) - # spawn f(a[i+4 .. i+5]) + # spawn f(a[i+1..i+3]) + # spawn f(a[i+4..i+5]) # inc i, 4 # Prove that i*k*stride + 3 != i*k'*stride + 5 # For the correct example this amounts to @@ -226,15 +230,15 @@ proc checkSlicesAreDisjoint(c: var AnalysisCtx) = # For now, we don't try to prove things like that at all, even though it'd # be feasible for many useful examples. Instead we attach the slice to # a spawn and if the attached spawns differ, we bail out: - for i in 0 .. high(c.slices): - for j in i+1 .. high(c.slices): + for i in 0..high(c.slices): + for j in i+1..high(c.slices): let x = c.slices[i] let y = c.slices[j] if x.spawnId != y.spawnId and guards.sameTree(x.x, y.x): if not x.inLoop or not y.inLoop: # XXX strictly speaking, 'or' is not correct here and it needs to # be 'and'. However this prevents too many obviously correct programs - # like f(a[0..x]); for i in x+1 .. a.high: f(a[i]) + # like f(a[0..x]); for i in x+1..a.high: f(a[i]) overlap(c.guards, c.graph.config, x.a, x.b, y.a, y.b) elif (let k = simpleSlice(x.a, x.b); let m = simpleSlice(y.a, y.b); k >= 0 and m >= 0): @@ -255,15 +259,13 @@ proc checkSlicesAreDisjoint(c: var AnalysisCtx) = proc analyse(c: var AnalysisCtx; n: PNode) proc analyseSons(c: var AnalysisCtx; n: PNode) = - for i in 0 ..< safeLen(n): analyse(c, n[i]) + for i in 0..<n.safeLen: analyse(c, n[i]) proc min(a, b: PNode): PNode = if a.isNil: result = b elif a.intVal < b.intVal: result = a else: result = b -proc fromSystem(op: PSym): bool = sfSystemModule in getModule(op).flags - template pushSpawnId(c, body) {.dirty.} = inc c.spawns let oldSpawnId = c.currentSpawnId @@ -295,36 +297,36 @@ proc analyseCall(c: var AnalysisCtx; n: PNode; op: PSym) = analyseSons(c, n) proc analyseCase(c: var AnalysisCtx; n: PNode) = - analyse(c, n.sons[0]) + analyse(c, n[0]) let oldFacts = c.guards.s.len for i in 1..<n.len: - let branch = n.sons[i] + let branch = n[i] setLen(c.guards.s, oldFacts) addCaseBranchFacts(c.guards, n, i) - for i in 0 ..< branch.len: - analyse(c, branch.sons[i]) + for i in 0..<branch.len: + analyse(c, branch[i]) setLen(c.guards.s, oldFacts) proc analyseIf(c: var AnalysisCtx; n: PNode) = - analyse(c, n.sons[0].sons[0]) + analyse(c, n[0][0]) let oldFacts = c.guards.s.len - addFact(c.guards, canon(n.sons[0].sons[0], c.guards.o)) + addFact(c.guards, canon(n[0][0], c.graph.operators)) - analyse(c, n.sons[0].sons[1]) + analyse(c, n[0][1]) for i in 1..<n.len: - let branch = n.sons[i] + let branch = n[i] setLen(c.guards.s, oldFacts) for j in 0..i-1: - addFactNeg(c.guards, canon(n.sons[j].sons[0], c.guards.o)) + addFactNeg(c.guards, canon(n[j][0], c.graph.operators)) if branch.len > 1: - addFact(c.guards, canon(branch.sons[0], c.guards.o)) - for i in 0 ..< branch.len: - analyse(c, branch.sons[i]) + addFact(c.guards, canon(branch[0], c.graph.operators)) + for i in 0..<branch.len: + analyse(c, branch[i]) setLen(c.guards.s, oldFacts) 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) @@ -352,7 +354,7 @@ proc analyse(c: var AnalysisCtx; n: PNode) = if n[0].typ != nil and skipTypes(n[0].typ, abstractVar).kind != tyTuple: c.addSlice(n, n[0], n[1], n[1]) analyseSons(c, n) - of nkReturnStmt, nkRaiseStmt, nkTryStmt: + of nkReturnStmt, nkRaiseStmt, nkTryStmt, nkHiddenTryStmt: localError(c.graph.config, n.info, "invalid control flow for 'parallel'") # 'break' that leaves the 'parallel' section is not valid either # or maybe we should generate a 'try' XXX @@ -365,7 +367,7 @@ proc analyse(c: var AnalysisCtx; n: PNode) = gatherArgs(c, value[1]) analyseSons(c, value[1]) if value.kind != nkEmpty: - for j in 0 .. it.len-3: + for j in 0..<it.len-2: if it[j].isLocal: let slot = c.getSlot(it[j].sym) if slot.lower.isNil: slot.lower = value @@ -374,35 +376,39 @@ proc analyse(c: var AnalysisCtx; n: PNode) = of nkCaseStmt: analyseCase(c, n) of nkWhen, nkIfStmt, nkIfExpr: analyseIf(c, n) of nkWhileStmt: - analyse(c, n.sons[0]) + analyse(c, n[0]) # 'while true' loop? inc c.inLoop - if isTrue(n.sons[0]): - analyseSons(c, n.sons[1]) + if isTrue(n[0]): + analyseSons(c, n[1]) else: # loop may never execute: let oldState = c.locals.len let oldFacts = c.guards.s.len - addFact(c.guards, canon(n.sons[0], c.guards.o)) - analyse(c, n.sons[1]) + addFact(c.guards, canon(n[0], c.graph.operators)) + analyse(c, n[1]) setLen(c.locals, oldState) setLen(c.guards.s, oldFacts) # we know after the loop the negation holds: - if not hasSubnodeWith(n.sons[1], nkBreakStmt): - addFactNeg(c.guards, canon(n.sons[0], c.guards.o)) + if not hasSubnodeWith(n[1], nkBreakStmt): + addFactNeg(c.guards, canon(n[0], c.graph.operators)) dec c.inLoop of nkTypeSection, nkProcDef, nkConverterDef, nkMethodDef, nkIteratorDef, - nkMacroDef, nkTemplateDef, nkConstSection, nkPragma, nkFuncDef: + nkMacroDef, nkTemplateDef, nkConstSection, nkPragma, nkFuncDef, + nkMixinStmt, nkBindStmt, nkExportStmt: discard else: analyseSons(c, n) -proc transformSlices(g: ModuleGraph; n: PNode): PNode = +proc transformSlices(g: ModuleGraph; idgen: IdGenerator; n: PNode): PNode = if n.kind in nkCallKinds and n[0].kind == nkSym: let op = n[0].sym if op.name.s == "[]" and op.fromSystem: result = copyNode(n) - let opSlice = newSymNode(createMagic(g, "slice", mSlice)) + 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 result.add n[1] @@ -412,18 +418,18 @@ proc transformSlices(g: ModuleGraph; n: PNode): PNode = return result if n.safeLen > 0: result = shallowCopy(n) - for i in 0 ..< n.len: - result.sons[i] = transformSlices(g, n.sons[i]) + for i in 0..<n.len: + result[i] = transformSlices(g, idgen, n[i]) else: result = n -proc transformSpawn(g: ModuleGraph; owner: PSym; n, barrier: PNode): PNode -proc transformSpawnSons(g: ModuleGraph; owner: PSym; n, barrier: PNode): PNode = +proc transformSpawn(g: ModuleGraph; idgen: IdGenerator; owner: PSym; n, barrier: PNode): PNode +proc transformSpawnSons(g: ModuleGraph; idgen: IdGenerator; owner: PSym; n, barrier: PNode): PNode = result = shallowCopy(n) - for i in 0 ..< n.len: - result.sons[i] = transformSpawn(g, owner, n.sons[i], barrier) + for i in 0..<n.len: + result[i] = transformSpawn(g, idgen, owner, n[i], barrier) -proc transformSpawn(g: ModuleGraph; owner: PSym; n, barrier: PNode): PNode = +proc transformSpawn(g: ModuleGraph; idgen: IdGenerator; owner: PSym; n, barrier: PNode): PNode = case n.kind of nkVarSection, nkLetSection: result = nil @@ -431,41 +437,41 @@ proc transformSpawn(g: ModuleGraph; owner: PSym; n, barrier: PNode): PNode = let b = it.lastSon if getMagic(b) == mSpawn: if it.len != 3: localError(g.config, it.info, "invalid context for 'spawn'") - let m = transformSlices(g, b) + let m = transformSlices(g, idgen, b) if result.isNil: result = newNodeI(nkStmtList, n.info) result.add n - let t = b[1][0].typ.sons[0] + let t = b[1][0].typ.returnType if spawnResult(t, true) == srByVar: - result.add wrapProcForSpawn(g, owner, m, b.typ, barrier, it[0]) - it.sons[it.len-1] = newNodeI(nkEmpty, it.info) + result.add wrapProcForSpawn(g, idgen, owner, m, b.typ, barrier, it[0]) + it[^1] = newNodeI(nkEmpty, it.info) else: - it.sons[it.len-1] = wrapProcForSpawn(g, owner, m, b.typ, barrier, nil) + 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.sons[0]; + if getMagic(b) == mSpawn and (let t = b[1][0].typ.returnType; spawnResult(t, true) == srByVar): - let m = transformSlices(g, b) - return wrapProcForSpawn(g, owner, m, b.typ, barrier, n[0]) - result = transformSpawnSons(g, owner, n, barrier) + let m = transformSlices(g, idgen, b) + return wrapProcForSpawn(g, idgen, owner, m, b.typ, barrier, n[0]) + result = transformSpawnSons(g, idgen, owner, n, barrier) of nkCallKinds: if getMagic(n) == mSpawn: - result = transformSlices(g, n) - return wrapProcForSpawn(g, owner, result, n.typ, barrier, nil) - result = transformSpawnSons(g, owner, n, barrier) + result = transformSlices(g, idgen, n) + return wrapProcForSpawn(g, idgen, owner, result, n.typ, barrier, nil) + result = transformSpawnSons(g, idgen, owner, n, barrier) elif n.safeLen > 0: - result = transformSpawnSons(g, owner, n, barrier) + result = transformSpawnSons(g, idgen, owner, n, barrier) else: 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; owner: PSym; n: PNode): PNode = +proc liftParallel*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; n: PNode): PNode = # this needs to be called after the 'for' loop elimination # first pass: @@ -483,16 +489,16 @@ proc liftParallel*(g: ModuleGraph; owner: PSym; n: PNode): PNode = checkArgs(a, body) var varSection = newNodeI(nkVarSection, n.info) - var temp = newSym(skTemp, getIdent(g.cache, "barrier"), 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) varSection.addVar tempNode - let barrier = genAddrOf(tempNode) + let barrier = genAddrOf(tempNode, idgen) result = newNodeI(nkStmtList, n.info) generateAliasChecks(a, result) result.add varSection - result.add callCodegenProc(g, "openBarrier", barrier) - result.add transformSpawn(g, owner, body, barrier) - result.add callCodegenProc(g, "closeBarrier", barrier) + result.add callCodegenProc(g, "openBarrier", barrier.info, barrier) + result.add transformSpawn(g, idgen, owner, body, barrier) + result.add callCodegenProc(g, "closeBarrier", barrier.info, barrier) diff --git a/compiler/sempass2.nim b/compiler/sempass2.nim index 4d3ee0408..0a160897f 100644 --- a/compiler/sempass2.nim +++ b/compiler/sempass2.nim @@ -8,18 +8,41 @@ # import - intsets, ast, astalgo, msgs, renderer, magicsys, types, idents, trees, - wordrecg, strutils, options, guards, writetracking, lineinfos, - modulegraphs + 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 -# Second semantic checking pass over the AST. Necessary because the old -# way had some inherent problems. Performs: -# -# * effect+exception tracking -# * "usage before definition" checking +import liftdestructors +include sinkparameter_inference + +#[ Second semantic checking pass over the AST. Necessary because the old + way had some inherent problems. Performs: + +* effect+exception tracking +* "usage before definition" checking +* also now calls the "lift destructor logic" at strategic positions, this + is about to be put into the spec: + +We treat assignment and sinks and destruction as identical. + +In the construct let/var x = expr() x's type is marked. + +In x = y the type of x is marked. + +For every sink parameter of type T T is marked. + +For every call f() the return type of f() is marked. + +]# # ------------------------ exception and tag tracking ------------------------- @@ -43,56 +66,90 @@ 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: 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 - maxLockLevel, currLockLevel: TLockLevel + gcUnsafe, isRecursive, isTopLevel, hasSideEffect, inEnforcedGcSafe: bool + isInnerProc: bool + inEnforcedNoSideEffects: bool + 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 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 + optSeqDestructors in tracked.config.globalOptions: + createTypeBoundOps(tracked.graph, tracked.c, realType.lastSon, info) -proc isLocalVar(a: PEffects, s: PSym): bool = - s.kind in {skVar, skResult} and sfGlobal notin s.flags and - s.owner == a.owner and s.typ != nil + createTypeBoundOps(tracked.graph, tracked.c, typ, info, tracked.c.idgen) + if (tfHasAsgn in typ.flags) or + optSeqDestructors in tracked.config.globalOptions: + tracked.owner.flags.incl sfInjectDestructors -proc getLockLevel(t: PType): TLockLevel = - var t = t - # tyGenericInst(TLock {tyGenericBody}, tyStatic, tyObject): - if t.kind == tyGenericInst and t.len == 3: t = t.sons[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: @@ -101,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)) @@ -109,21 +166,21 @@ proc guardGlobal(a: PEffects; n: PNode; guard: PSym) = # 'guard*' are checks which are concerned with 'guard' annotations # (var x{.guard: y.}: int) proc guardDotAccess(a: PEffects; n: PNode) = - let ri = n.sons[1] + let ri = n[1] if ri.kind != nkSym or ri.sym.kind != skField: return var g = ri.sym.guard if g.isNil or a.isTopLevel: return # fixup guard: if g.kind == skUnknown: var field: PSym = nil - var ty = n.sons[0].typ.skipTypes(abstractPtrs) + var ty = n[0].typ.skipTypes(abstractPtrs) if ty.kind == tyTuple and not ty.n.isNil: field = lookupInRecord(ty.n, g.name) else: while ty != nil and ty.kind == tyObject: field = lookupInRecord(ty.n, g.name) if field != nil: break - ty = ty.sons[0] + ty = ty[0] if ty == nil: break ty = ty.skipTypes(skipPtrs) if field == nil: @@ -134,8 +191,8 @@ proc guardDotAccess(a: PEffects; n: PNode) = # XXX unfortunately this is not correct for generic instantiations! if g.kind == skField: let dot = newNodeI(nkDotExpr, n.info, 2) - dot.sons[0] = n.sons[0] - dot.sons[1] = newSymNode(g) + dot[0] = n[0] + dot[1] = newSymNode(g) dot.typ = g.typ for L in a.locked: #if a.guards.sameSubexprs(dot, L): return @@ -145,28 +202,57 @@ proc guardDotAccess(a: PEffects; n: PNode) = guardGlobal(a, n, g) proc makeVolatile(a: PEffects; s: PSym) {.inline.} = - template compileToCpp(a): untyped = - a.config.cmd == cmdCompileToCpp or sfCompileToCpp in getModule(a.owner).flags - if a.inTryStmt > 0 and not compileToCpp(a): + 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 {tfNeedsInit, tfNotNil} * s.typ.flags <= {tfNotNil}: + 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) = @@ -185,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, + a.owner.gcUnsafetyReason = newSym(skUnknown, a.owner.name, a.c.idgen, a.owner, reason.info, {}) -when true: - template markSideEffect(a: PEffects; reason: typed) = +proc markSideEffect(a: PEffects; reason: PNode | PSym; useLoc: TLineInfo) = + if not a.inEnforcedNoSideEffects: a.hasSideEffect = true -else: - template markSideEffect(a: PEffects; reason: typed) = - a.hasSideEffect = true - markGcUnsafe(a, reason) + 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 @@ -202,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 '$#'" % @@ -224,42 +328,95 @@ proc listGcUnsafety(s: PSym; onlyWarning: bool; conf: ConfigRef) = var cycleCheck = initIntSet() listGcUnsafety(s, onlyWarning, cycleCheck, conf) -proc useVar(a: PEffects, n: PNode) = - let s = n.sym - if isLocalVar(a, s): - if s.id notin a.init: - if {tfNeedsInit, tfNotNil} * s.typ.flags != {}: - message(a.config, n.info, warnProveInit, s.name.s) - else: - message(a.config, n.info, warnUninit, s.name.s) - # prevent superfluous warnings about the same variable: - a.init.add s.id +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: + s.magic != mNimvm: if s.guard != nil: guardGlobal(a, n, s.guard) if {sfGlobal, sfThread} * s.flags == {sfGlobal} and (tfHasGCedMem in s.typ.flags or s.typ.isGCedMem): - #if warnGcUnsafe in gNotes: warnAboutGcUnsafe(n) + #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 +proc useVar(a: PEffects, n: PNode) = + let s = n.sym + if a.inExceptOrFinallyStmt > 0: + incl s.flags, sfUsedInFinallyOrExcept + 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 + elif s.id notin a.init: + if s.typ.requiresInit: + message(a.config, n.info, warnProveInit, s.name.s) + elif a.leftPartOfAsgn <= 0: + 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)) - -proc throws(tracked, n: PNode) = - if n.typ == nil or n.typ.kind != tyError: tracked.add n + 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 = 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 = @@ -277,40 +434,48 @@ proc createTag(g: ModuleGraph; n: PNode): PNode = result.typ = g.sysTypeFromName(n.info, "RootEffect") if not n.isNil: result.info = n.info -proc addEffect(a: PEffects, e: PNode, useLineInfo=true) = - assert e.kind != nkRaiseStmt +proc addRaiseEffect(a: PEffects, e, comesFrom: PNode) = + #assert e.kind != nkRaiseStmt var aa = a.exc - for i in a.bottom ..< aa.len: - if sameType(a.graph.excType(aa[i]), a.graph.excType(e)): - if not useLineInfo or a.config.cmd == cmdDoc: return - elif aa[i].info == e.info: return - throws(a.exc, e) + for i in a.bottom..<aa.len: + # we only track the first node that can have the effect E in order + # to safe space and time. + if sameType(a.graph.excType(aa[i]), a.graph.excType(e)): return -proc addTag(a: PEffects, e: PNode, useLineInfo=true) = - var aa = a.tags - for i in 0 ..< aa.len: - if sameType(aa[i].typ.skipTypes(skipPtrs), e.typ.skipTypes(skipPtrs)): - if not useLineInfo or a.config.cmd == cmdDoc: return - elif aa[i].info == e.info: return - throws(a.tags, e) + if e.typ != nil: + if not isDefectException(e.typ): + throws(a.exc, e, comesFrom) -proc mergeEffects(a: PEffects, b, comesFrom: PNode) = +proc addTag(a: PEffects, e, comesFrom: PNode) = + var aa = a.tags + for i in 0..<aa.len: + # we only track the first node that can have the effect E in order + # to safe space and time. + 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: - addEffect(a, createRaise(a.graph, comesFrom)) + addRaiseEffect(a, createRaise(a.graph, comesFrom), comesFrom) else: - for effect in items(b): addEffect(a, effect, useLineInfo=comesFrom != nil) + for effect in items(b): addRaiseEffect(a, effect, comesFrom) proc mergeTags(a: PEffects, b, comesFrom: PNode) = if b.isNil: - addTag(a, createTag(a.graph, comesFrom)) + addTag(a, createTag(a.graph, comesFrom), comesFrom) else: - for effect in items(b): addTag(a, effect, useLineInfo=comesFrom != nil) + for effect in items(b): addTag(a, effect, comesFrom) proc listEffects(a: PEffects) = for e in items(a.exc): message(a.config, e.info, hintUser, typeToString(e.typ)) for e in items(a.tags): message(a.config, e.info, hintUser, typeToString(e.typ)) - #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) @@ -319,19 +484,31 @@ proc catches(tracked: PEffects, e: PType) = while i < L: # r supertype of e? if safeInheritanceDiff(tracked.graph.excType(tracked.exc[i]), e) <= 0: - tracked.exc.sons[i] = tracked.exc.sons[L-1] + tracked.exc[i] = tracked.exc[L-1] dec L else: inc i - if not isNil(tracked.exc.sons): + if tracked.exc.len > 0: setLen(tracked.exc.sons, L) else: assert L == 0 proc catchesAll(tracked: PEffects) = - if not isNil(tracked.exc.sons): + 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 @@ -340,132 +517,115 @@ 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.sons[0]) + 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 - for i in 1 ..< n.len: - let b = n.sons[i] - let blen = sonsLen(b) + inc tracked.inExceptOrFinallyStmt + + # Collect the exceptions caught by the except branches + for i in 1..<n.len: + let b = n[i] if b.kind == nkExceptBranch: inc branches - if blen == 1: + if b.len == 1: catchesAll(tracked) else: - for j in countup(0, blen - 2): - if b.sons[j].isInfixAs(): - assert(b.sons[j][1].kind == nkType) - catches(tracked, b.sons[j][1].typ) + for j in 0..<b.len - 1: + if b[j].isInfixAs(): + assert(b[j][1].kind == nkType) + catches(tracked, b[j][1].typ) + createTypeBoundOps(tracked, b[j][2].typ, b[j][2].info) else: - assert(b.sons[j].kind == nkType) - catches(tracked, b.sons[j].typ) + assert(b[j].kind == nkType) + catches(tracked, b[j].typ) + else: + assert b.kind == nkFinally + # Add any other exception raised in the except bodies + for i in 1..<n.len: + let b = n[i] + if b.kind == nkExceptBranch: setLen(tracked.init, oldState) - track(tracked, b.sons[blen-1]) + 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: - assert b.kind == nkFinally setLen(tracked.init, oldState) - track(tracked, b.sons[blen-1]) + track(tracked, b[^1]) hasFinally = true tracked.bottom = oldBottom + dec tracked.inExceptOrFinallyStmt if not hasFinally: setLen(tracked.init, oldState) 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 proc trackPragmaStmt(tracked: PEffects, n: PNode) = - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - if whichPragma(it) == wEffects: + for i in 0..<n.len: + var it = n[i] + let pragma = whichPragma(it) + case pragma + of wEffects: # list the computed effects up to here: listEffects(tracked) - -proc effectSpec(n: PNode, effectType: TSpecialWord): PNode = - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - if it.kind == nkExprColonExpr and whichPragma(it) == effectType: - result = it.sons[1] - if result.kind notin {nkCurly, nkBracket}: - result = newNodeI(nkCurly, result.info) - result.add(it.sons[1]) - return - -proc documentEffect(cache: IdentCache; n, x: PNode, effectType: TSpecialWord, idx: int): PNode = - let spec = effectSpec(x, effectType) - if isNil(spec): - let s = n.sons[namePos].sym - - let actual = s.typ.n.sons[0] - if actual.len != effectListLen: return - let real = actual.sons[idx] - - # warning: hack ahead: - var effects = newNodeI(nkBracket, n.info, real.len) - for i in 0 ..< real.len: - var t = typeToString(real[i].typ) - if t.startsWith("ref "): t = substr(t, 4) - effects.sons[i] = newIdentNode(getIdent(cache, t), n.info) - # set the type so that the following analysis doesn't screw up: - effects.sons[i].typ = real[i].typ - - result = newNode(nkExprColonExpr, n.info, @[ - newIdentNode(getIdent(cache, specialWords[effectType]), n.info), effects]) - -proc documentWriteEffect(cache: IdentCache; n: PNode; flag: TSymFlag; pragmaName: string): PNode = - let s = n.sons[namePos].sym - let params = s.typ.n - - var effects = newNodeI(nkBracket, n.info) - for i in 1 ..< params.len: - if params[i].kind == nkSym and flag in params[i].sym.flags: - effects.add params[i] - - if effects.len > 0: - result = newNode(nkExprColonExpr, n.info, @[ - newIdentNode(getIdent(cache, pragmaName), n.info), effects]) - -proc documentNewEffect(cache: IdentCache; n: PNode): PNode = - let s = n.sons[namePos].sym - if tfReturnsNew in s.typ.flags: - result = newIdentNode(getIdent(cache, "new"), n.info) - -proc documentRaises*(cache: IdentCache; n: PNode) = - if n.sons[namePos].kind != nkSym: return - let pragmas = n.sons[pragmasPos] - let p1 = documentEffect(cache, n, pragmas, wRaises, exceptionEffects) - let p2 = documentEffect(cache, n, pragmas, wTags, tagEffects) - let p3 = documentWriteEffect(cache, n, sfWrittenTo, "writes") - let p4 = documentNewEffect(cache, n) - let p5 = documentWriteEffect(cache, n, sfEscapes, "escapes") - - if p1 != nil or p2 != nil or p3 != nil or p4 != nil or p5 != nil: - if pragmas.kind == nkEmpty: - n.sons[pragmasPos] = newNodeI(nkPragma, n.info) - if p1 != nil: n.sons[pragmasPos].add p1 - if p2 != nil: n.sons[pragmasPos].add p2 - if p3 != nil: n.sons[pragmasPos].add p3 - if p4 != nil: n.sons[pragmasPos].add p4 - if p5 != nil: n.sons[pragmasPos].add p5 + 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 == {} @@ -473,118 +633,117 @@ 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.sons[pragmasPos] + let pragma = s.ast[pragmasPos] let spec = effectSpec(pragma, wRaises) - mergeEffects(tracked, spec, n) + mergeRaises(tracked, spec, n) let tagSpec = effectSpec(pragma, wTags) mergeTags(tracked, tagSpec, n) if notGcSafe(s.typ) and sfImportc notin s.flags: - if warnGcUnsafe in tracked.config.notes: warnAboutGcUnsafe(n, tracked.config) + 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) = +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 if paramType.isNil or paramType.kind != tyTypeDesc: - procVarcheck skipConvAndClosure(n), tracked.config + procVarCheck skipConvCastAndClosure(n), tracked.config #elif n.kind in nkSymChoices: # echo "came here" let paramType = paramType.skipTypesOrNil(abstractInst) - if paramType != nil and tfNotNil in paramType.flags and - n.typ != nil and tfNotNil notin n.typ.flags: - if n.kind == nkAddr: - # 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 - (n.kind in procDefs+{nkObjConstr, nkBracket, nkClosure, nkStrLit..nkTripleStrLit}) or - (n.kind in nkCallKinds and n[0].kind == nkSym and n[0].sym.magic == mArrToSeq): - # 'p' is not nil obviously: - return - case impliesNotNil(tracked.guards, n) - of impUnknown: - message(tracked.config, n.info, errGenerated, - "cannot prove '$1' is not nil" % n.renderTree) - of impNo: - message(tracked.config, n.info, errGenerated, - "'$1' is provably nil" % n.renderTree) - of impYes: discard + 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 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 + (n.kind in procDefs+{nkObjConstr, nkBracket, nkClosure, nkStrLit..nkTripleStrLit}) or + (n.kind in nkCallKinds and n[0].kind == nkSym and n[0].sym.magic == mArrToSeq) or + n.typ.kind == tyTypeDesc: + # 'p' is not nil obviously: + return + case impliesNotNil(tracked.guards, n) + of impUnknown: + message(tracked.config, n.info, errGenerated, + "cannot prove '$1' is not nil" % n.renderTree) + of impNo: + message(tracked.config, n.info, errGenerated, + "'$1' is provably nil" % n.renderTree) + of impYes: discard proc assumeTheWorst(tracked: PEffects; n: PNode; op: PType) = - addEffect(tracked, createRaise(tracked.graph, n)) - addTag(tracked, createTag(tracked.graph, n)) - 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 = - # XXX prove the soundness of this effect system rule - result = n.kind == nkSym and n.sym.kind == skParam and owner == n.sym.owner + addRaiseEffect(tracked, createRaise(tracked.graph, n), nil) + addTag(tracked, createTag(tracked.graph, n), nil) -proc trackOperand(tracked: PEffects, n: PNode, paramType: PType) = - let a = skipConvAndClosure(n) +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 + 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 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, formals: PType; argIndex: int; caller: PNode) = + let a = skipConvCastAndClosure(n) let op = a.typ - if op != nil and op.kind == tyProc and n.skipConv.kind != nkNilLit: - internalAssert tracked.config, op.n.sons[0].kind == nkEffectList - var effectList = op.n.sons[0] - let s = n.skipConv - if s.kind == nkSym and s.sym.kind in routineKinds: + let param = if formals != nil and formals.n != nil and argIndex < formals.n.len: formals.n[argIndex].sym else: nil + # assume indirect calls are taken here: + if op != nil and op.kind == tyProc and n.skipConv.kind != nkNilLit and + not isTrival(caller) and + ((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 + if s.kind == nkCast and s[1].typ.kind == tyProc: + s = s[1] + if s.kind == nkSym and s.sym.kind in routineKinds and isNoEffectList(effectList): propagateEffects(tracked, n, s.sym) - elif effectList.len == 0: + elif isNoEffectList(effectList): if isForwardedProc(n): # 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 warnGcUnsafe in tracked.config.notes: warnAboutGcUnsafe(n, tracked.config) + 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: - mergeEffects(tracked, effectList.sons[exceptionEffects], n) - mergeTags(tracked, effectList.sons[tagEffects], n) + mergeRaises(tracked, effectList[exceptionEffects], n) + mergeTags(tracked, effectList[tagEffects], n) if notGcSafe(op): - if warnGcUnsafe in tracked.config.notes: warnAboutGcUnsafe(n, tracked.config) + if tracked.config.hasWarn(warnGcUnsafe): warnAboutGcUnsafe(n, tracked.config) markGcUnsafe(tracked, a) elif tfNoSideEffect notin op.flags: - markSideEffect(tracked, a) - if paramType != nil and paramType.kind == tyVar: - if n.kind == nkSym and isLocalVar(tracked, n.sym): + 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 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) @@ -594,193 +753,547 @@ proc trackOperand(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 = - # sematic check doesn't allow statements after raise, break, return or + +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.sons[0]) + track(tracked, n[0]) + inc tracked.inIfStmt let oldState = tracked.init.len let oldFacts = tracked.guards.s.len - let stringCase = skipTypes(n.sons[0].typ, - abstractVarRange-{tyTypeDesc}).kind in {tyFloat..tyFloat128, tyString} - let interesting = not stringCase and interestingCaseExpr(n.sons[0]) and - warnProveField in tracked.config.notes + let stringCase = n[0].typ != nil and skipTypes(n[0].typ, + abstractVarRange-{tyTypeDesc}).kind in {tyFloat..tyFloat128, tyString, tyCstring} + let interesting = not stringCase and interestingCaseExpr(n[0]) and + (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.sons[i] + let branch = n[i] setLen(tracked.init, oldState) if interesting: setLen(tracked.guards.s, oldFacts) addCaseBranchFacts(tracked.guards, n, i) - for i in 0 ..< branch.len: - track(tracked, branch.sons[i]) - if not breaksBlock(branch.lastSon): inc toCover - for i in oldState..<tracked.init.len: - addToIntersection(inter, tracked.init[i]) + for i in 0..<branch.len: + track(tracked, branch[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.sons[0].sons[0]) + track(tracked, n[0][0]) + inc tracked.inIfStmt let oldFacts = tracked.guards.s.len - addFact(tracked.guards, n.sons[0].sons[0]) + 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.sons[0].sons[1]) - if not breaksBlock(n.sons[0].sons[1]): inc toCover - for i in oldState..<tracked.init.len: - addToIntersection(inter, tracked.init[i]) + track(tracked, n[0][1]) + 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.sons[i] + let branch = n[i] setLen(tracked.guards.s, oldFacts) for j in 0..i-1: - addFactNeg(tracked.guards, n.sons[j].sons[0]) + addFactNeg(tracked.guards, n[j][0]) if branch.len > 1: - addFact(tracked.guards, branch.sons[0]) + addFact(tracked.guards, branch[0]) setLen(tracked.init, oldState) - for i in 0 ..< branch.len: - track(tracked, branch.sons[i]) - if not breaksBlock(branch.lastSon): inc toCover - for i in oldState..<tracked.init.len: - addToIntersection(inter, tracked.init[i]) + for i in 0..<branch.len: + track(tracked, branch[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}: var oldState = -1 for i in 0..<n.len: - if hasSubnodeWith(n.sons[i], nkBreakStmt): + if hasSubnodeWith(n[i], nkBreakStmt): # block: # x = def # if ...: ... break # some nested break # y = def # --> 'y' not defined after block! if oldState < 0: oldState = tracked.init.len - track(tracked, n.sons[i]) + track(tracked, n[i]) if oldState > 0: setLen(tracked.init, oldState) else: track(tracked, n) -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 paramType(op: PType, i: int): PType = - if op != nil and i < op.len: result = op.sons[i] - proc cstringCheck(tracked: PEffects; n: PNode) = - if n.sons[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)) -proc track(tracked: PEffects, n: PNode) = - case n.kind - of nkSym: - useVar(tracked, n) - of nkRaiseStmt: - n.sons[0].info = n.info - #throws(tracked.exc, n.sons[0]) - addEffect(tracked, n.sons[0], useLineInfo=false) - for i in 0 ..< safeLen(n): - track(tracked, n.sons[i]) - of nkCallKinds: - # p's effects are ours too: - let a = n.sons[0] - let op = a.typ +proc patchResult(c: PEffects; n: PNode) = + if n.kind == nkSym and n.sym.kind == skResult: + let fn = c.owner + if fn != nil and fn.kind in routineKinds and fn.ast != nil and resultPos < fn.ast.len: + n.sym = fn.ast[resultPos].sym + else: + localError(c.config, n.info, "routine has no return type, but .requires contains 'result'") + else: + for i in 0..<safeLen(n): + patchResult(c, n[i]) + +proc checkLe(c: PEffects; a, b: PNode) = + case proveLe(c.guards, a, b) + of impUnknown: + #for g in c.guards.s: + # if g != nil: echo "I Know ", g + message(c.config, a.info, warnStaticIndexCheck, + "cannot prove: " & $a & " <= " & $b) + of impYes: + discard + of impNo: + message(c.config, a.info, warnStaticIndexCheck, + "can prove: " & $a & " > " & $b) + +proc checkBounds(c: PEffects; arr, idx: PNode) = + checkLe(c, lowBound(c.config, arr), idx) + checkLe(c, idx, highBound(c.config, arr, c.guards.g.operators)) + +proc checkRange(c: PEffects; value: PNode; typ: PType) = + let t = typ.skipTypes(abstractInst - {tyRange}) + if t.kind == tyRange: + let lowBound = copyTree(t.n[0]) + lowBound.info = value.info + let highBound = copyTree(t.n[1]) + highBound.info = value.info + 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): + # and it's not a recursive call: + if not (a.kind == nkSym and a.sym == tracked.owner): + if tracked.config.hasWarn(warnGcUnsafe): warnAboutGcUnsafe(n, tracked.config) + markGcUnsafe(tracked, a) + if tfNoSideEffect notin op.flags and not importedFromC(a): + # and it's not a recursive call: + if not (a.kind == nkSym and a.sym == tracked.owner): + markSideEffect(tracked, a, n.info) + # p's effects are ours too: + var a = n[0] + #if canRaise(a): + # echo "this can raise ", tracked.config $ n.info + let op = a.typ + if n.typ != nil: + if tracked.owner.kind != skMacro and n.typ.skipTypes(abstractVar).kind != tyOpenArray: + createTypeBoundOps(tracked, n.typ, n.info) + + when defined(nimsuggest): + var actualLoc = a.info + if n.kind == nkHiddenCallConv: + actualLoc = n.info + if a.kind == nkSym: + markCaughtExceptions(tracked, tracked.graph, actualLoc, a.sym, tracked.graph.usageSym) + + let notConstExpr = getConstExpr(tracked.ownerModule, n, tracked.c.idgen, tracked.graph) == nil + if notConstExpr: + if a.kind == nkCast and a[1].typ.kind == tyProc: + a = a[1] # XXX: in rare situations, templates and macros will reach here after # calling getAst(templateOrMacro()). Currently, templates and macros # are indistinguishable from normal procs (both have tyProc type) and # we can detect them only by checking for attached nkEffectList. - if op != nil and op.kind == tyProc and op.n.sons[0].kind == nkEffectList: + if op != nil and op.kind == tyProc and op.n[0].kind == nkEffectList: 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) - var effectList = op.n.sons[0] + 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 effectList.len == 0: + 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: - mergeEffects(tracked, effectList.sons[exceptionEffects], n) - mergeTags(tracked, effectList.sons[tagEffects], n) - if notGcSafe(op) and not importedFromC(a): - # and it's not a recursive call: - if not (a.kind == nkSym and a.sym == tracked.owner): - if warnGcUnsafe in tracked.config.notes: warnAboutGcUnsafe(n, tracked.config) - markGcUnsafe(tracked, a) - if tfNoSideEffect notin op.flags and not importedFromC(a): - # and it's not a recursive call: - if not (a.kind == nkSym and a.sym == tracked.owner): - markSideEffect(tracked, a) - if a.kind != nkSym or a.sym.magic != mNBindSym: - for i in 1 ..< len(n): trackOperand(tracked, n.sons[i], paramType(op, i)) + mergeRaises(tracked, effectList[exceptionEffects], n) + mergeTags(tracked, effectList[tagEffects], n) + gcsafeAndSideeffectCheck() + 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.sons[1] + let arg = n[1] initVarViaNew(tracked, arg) - if arg.typ.len != 0 and {tfNeedsInit} * 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! discard else: message(tracked.config, arg.info, warnProveInit, $arg) - for i in 0 ..< safeLen(n): - track(tracked, n.sons[i]) + + # check required for 'nim check': + 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'? + + elif a.kind == nkSym and a.sym.magic in {mArrGet, mArrPut} and + optStaticBoundsCheck in tracked.currOptions: + checkBounds(tracked, n[1], n[2]) + + + if a.kind == nkSym and a.sym.name.s.len > 0 and a.sym.name.s[0] == '=' and + tracked.owner.kind != skMacro: + var opKind = find(AttachedOpToStr, a.sym.name.s.normalize) + if a.sym.name.s == "=": opKind = attachedAsgn.int + if opKind != -1: + # rebind type bounds operations after createTypeBoundOps call + let t = n[1].typ.skipTypes({tyAlias, tyVar}) + if a.sym != getAttachedOp(tracked.graph, t, TTypeAttachedOp(opKind)): + createTypeBoundOps(tracked, t, n.info) + let op = getAttachedOp(tracked.graph, t, TTypeAttachedOp(opKind)) + if op != nil: + n[0].sym = op + + if op != nil and op.kind == tyProc: + for i in 1..<min(n.safeLen, op.signatureLen): + let paramType = op[i] + case paramType.kind + of tySink: + createTypeBoundOps(tracked, paramType.elementType, n.info) + checkForSink(tracked, n[i]) + of tyVar: + 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 + enforcedGcSafety, enforceNoSideEffects: bool + 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, + enforcedGcSafety: false, enforceNoSideEffects: false, + oldExc: tracked.exc.len, oldTags: tracked.tags.len, + oldForbids: oldForbidsLen) + +proc applyBlockContext(tracked: PEffects, bc: PragmaBlockContext) = + if bc.enforcedGcSafety: tracked.inEnforcedGcSafe = true + if bc.enforceNoSideEffects: tracked.inEnforcedNoSideEffects = true + +proc unapplyBlockContext(tracked: PEffects; bc: PragmaBlockContext) = + if bc.enforcedGcSafety: tracked.inEnforcedGcSafe = false + if bc.enforceNoSideEffects: tracked.inEnforcedNoSideEffects = false + setLen(tracked.locked, bc.oldLocked) + 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'. + setLen(tracked.exc.sons, bc.oldExc) + for e in bc.exc: + addRaiseEffect(tracked, e, e) + if bc.tags != nil: + 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) + of wGcSafe: + bc.enforcedGcSafety = true + of wNoSideEffect: + bc.enforceNoSideEffects = true + of wTags: + let n = pragma[1] + if n.kind in {nkCurly, nkBracket}: + bc.tags = n + 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}: + bc.exc = n + 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: + useVar(tracked, n) + if n.sym.typ != nil and tfHasAsgn in n.sym.typ.flags: + tracked.owner.flags.incl sfInjectDestructors + # bug #15038: ensure consistency + if n.typ == nil or (not hasDestructor(n.typ) and sameType(n.typ, n.sym.typ)): n.typ = n.sym.typ + of nkHiddenAddr, nkAddr: + 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]) + of nkRaiseStmt: + if n[0].kind != nkEmpty: + n[0].info = n.info + #throws(tracked.exc, n[0]) + addRaiseEffect(tracked, n[0], n) + for i in 0..<n.safeLen: + track(tracked, n[i]) + createTypeBoundOps(tracked, n[0].typ, n.info) + else: + # A `raise` with no arguments means we're going to re-raise the exception + # being handled or, if outside of an `except` block, a `ReraiseDefect`. + # Here we add a `Exception` tag in order to cover both the cases. + addRaiseEffect(tracked, createRaise(tracked.graph, n), nil) + of nkCallKinds: + trackCall(tracked, n) of nkDotExpr: guardDotAccess(tracked, n) - for i in 0 ..< len(n): track(tracked, n.sons[i]) + 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.sons[0]) - if warnProveField in tracked.config.notes: - checkFieldAccess(tracked.guards, n, tracked.config) + track(tracked, n[0]) + 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: - track(tracked, n.sons[1]) - initVar(tracked, n.sons[0], volatileCheck=true) - invalidateFacts(tracked.guards, n.sons[0]) - track(tracked, n.sons[0]) - addAsgnFact(tracked.guards, n.sons[0], n.sons[1]) - notNilCheck(tracked, n.sons[1], n.sons[0].typ) + of nkAsgn, nkFastAsgn, nkSinkAsgn: + track(tracked, n[1]) + initVar(tracked, n[0], volatileCheck=true) + invalidateFacts(tracked.guards, n[0]) + inc tracked.leftPartOfAsgn + track(tracked, n[0]) + dec tracked.leftPartOfAsgn + addAsgnFact(tracked.guards, n[0], n[1]) + notNilCheck(tracked, n[1], n[0].typ) when false: cstringCheck(tracked, n) + 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 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) if last.kind != nkEmpty: track(tracked, last) - if child.kind == nkIdentDefs and last.kind != nkEmpty: - for i in 0 .. child.len-3: - initVar(tracked, child.sons[i], volatileCheck=false) - addAsgnFact(tracked.guards, child.sons[i], last) - notNilCheck(tracked, last, child.sons[i].typ) + if tracked.owner.kind != skMacro: + if child.kind == nkVarTuple: + createTypeBoundOps(tracked, child[^1].typ, child.info) + for i in 0..<child.len-2: + createTypeBoundOps(tracked, child[i].typ, child.info) + else: + createTypeBoundOps(tracked, skipPragmaExpr(child[0]).typ, child.info) + if child.kind == nkIdentDefs: + for i in 0..<child.len-2: + 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.id == ord(wUnderscore): + continue + 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) # since 'var (a, b): T = ()' is not even allowed, there is always type # inference for (a, b) and thus no nil checking is necessary. of nkConstSection: @@ -789,175 +1302,408 @@ proc track(tracked: PEffects, n: PNode) = track(tracked, last) of nkCaseStmt: trackCase(tracked, n) of nkWhen, nkIfStmt, nkIfExpr: trackIf(tracked, n) - of nkBlockStmt, nkBlockExpr: trackBlock(tracked, n.sons[1]) + of nkBlockStmt, nkBlockExpr: trackBlock(tracked, n[1]) of nkWhileStmt: - track(tracked, n.sons[0]) # 'while true' loop? - if isTrue(n.sons[0]): - trackBlock(tracked, n.sons[1]) + inc tracked.currentBlock + if isTrue(n[0]): + trackBlock(tracked, n[1]) else: # loop may never execute: let oldState = tracked.init.len let oldFacts = tracked.guards.s.len - addFact(tracked.guards, n.sons[0]) - track(tracked, n.sons[1]) + addFact(tracked.guards, n[0]) + track(tracked, n[0]) + 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 - for i in 0 ..< len(n): - track(tracked, n.sons[i]) + + let oldFacts = tracked.guards.s.len + let iterCall = n[n.len-2] + if optStaticBoundsCheck in tracked.currOptions and iterCall.kind in nkCallKinds: + let op = iterCall[0] + if op.kind == nkSym and fromSystem(op.sym): + let iterVar = n[0] + case op.sym.name.s + of "..", "countup", "countdown": + let lower = iterCall[1] + let upper = iterCall[2] + # for i in 0..n means 0 <= i and i <= n. Countdown is + # the same since only the iteration direction changes. + addFactLe(tracked.guards, lower, iterVar) + addFactLe(tracked.guards, iterVar, upper) + of "..<": + let lower = iterCall[1] + let upper = iterCall[2] + addFactLe(tracked.guards, lower, iterVar) + addFactLt(tracked.guards, iterVar, upper) + else: discard + + for i in 0..<n.len-2: + let it = n[i] + track(tracked, it) + if tracked.owner.kind != skMacro: + if it.kind == nkVarTuple: + for x in it: + createTypeBoundOps(tracked, x.typ, x.info) + else: + createTypeBoundOps(tracked, it.typ, it.info) + let loopBody = n[^1] + if tracked.owner.kind != skMacro and iterCall.safeLen > 1: + # XXX this is a bit hacky: + if iterCall[1].typ != nil and iterCall[1].typ.skipTypes(abstractVar).kind notin {tyVarargs, tyOpenArray}: + createTypeBoundOps(tracked, iterCall[1].typ, iterCall[1].info) + track(tracked, iterCall) + track(tracked, loopBody) setLen(tracked.init, oldState) + setLen(tracked.guards.s, oldFacts) + dec tracked.currentBlock + of nkObjConstr: - when false: track(tracked, n.sons[0]) + when false: track(tracked, n[0]) let oldFacts = tracked.guards.s.len - for i in 1 ..< len(n): - let x = n.sons[i] + for i in 1..<n.len: + let x = n[i] track(tracked, x) - if x.sons[0].kind == nkSym and sfDiscriminant in x.sons[0].sym.flags: + if x[0].kind == nkSym and sfDiscriminant in x[0].sym.flags: addDiscriminantFact(tracked.guards, x) + if tracked.owner.kind != skMacro: + createTypeBoundOps(tracked, x[1].typ, n.info) + + if x.kind == nkExprColonExpr: + if x[0].kind == nkSym: + notNilCheck(tracked, x[1], x[0].sym.typ) + checkForSink(tracked, x[1]) + else: + 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.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, n[i]) of nkPragmaBlock: - let pragmaList = n.sons[0] - let oldLocked = tracked.locked.len - let oldLockLevel = tracked.currLockLevel - var enforcedGcSafety = false - for i in 0 ..< pragmaList.len: - let pragma = whichPragma(pragmaList.sons[i]) - if pragma == wLocks: - lockLocations(tracked, pragmaList.sons[i]) - elif pragma == wGcSafe: - enforcedGcSafety = true - if enforcedGcSafety: tracked.inEnforcedGcSafe = true + let pragmaList = n[0] + var bc = createBlockContext(tracked) + for i in 0..<pragmaList.len: + let pragma = whichPragma(pragmaList[i]) + case pragma + of wLocks: + lockLocations(tracked, pragmaList[i]) + of wGcSafe: + bc.enforcedGcSafety = true + of wNoSideEffect: + bc.enforceNoSideEffects = true + of wCast: + castBlock(tracked, pragmaList[i][1], bc) + else: + discard + applyBlockContext(tracked, bc) track(tracked, n.lastSon) - if enforcedGcSafety: tracked.inEnforcedGcSafe = false - setLen(tracked.locked, oldLocked) - tracked.currLockLevel = oldLockLevel - of nkTypeSection, nkProcDef, nkConverterDef, nkMethodDef, nkIteratorDef, - nkMacroDef, nkTemplateDef, nkLambda, nkDo, nkFuncDef: + unapplyBlockContext(tracked, bc) + + 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 nkCast, nkHiddenStdConv, nkHiddenSubConv, nkConv: - if n.len == 2: track(tracked, n.sons[1]) + 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: + createTypeBoundOps(tracked, n.typ, n.info) + # This is a hacky solution in order to fix bug #13110. Hopefully + # a better solution will come up eventually. + if n[1].typ.kind != tyString: + createTypeBoundOps(tracked, n[1].typ, n[1].info) + if optStaticBoundsCheck in tracked.currOptions: + checkRange(tracked, n[1], n.typ) of nkObjUpConv, nkObjDownConv, nkChckRange, nkChckRangeF, nkChckRange64: - if n.len == 1: track(tracked, n.sons[0]) + if n.len == 1: + track(tracked, n[0]) + if tracked.owner.kind != skMacro: + createTypeBoundOps(tracked, n.typ, n.info) + createTypeBoundOps(tracked, n[0].typ, n[0].info) + if optStaticBoundsCheck in tracked.currOptions: + checkRange(tracked, n[0], n.typ) + of nkBracket: + for i in 0..<n.safeLen: + track(tracked, n[i]) + checkForSink(tracked, n[i]) + if tracked.owner.kind != skMacro: + createTypeBoundOps(tracked, n.typ, n.info) + of nkBracketExpr: + if optStaticBoundsCheck in tracked.currOptions and n.len == 2: + if n[0].typ != nil and skipTypes(n[0].typ, abstractVar).kind != tyTuple: + checkBounds(tracked, n[0], n[1]) + track(tracked, n[0]) + 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 ..< safeLen(n): track(tracked, n.sons[i]) + for i in 0..<n.safeLen: track(tracked, n[i]) proc subtypeRelation(g: ModuleGraph; spec, real: PNode): bool = - result = safeInheritanceDiff(g.excType(real), spec.typ) <= 0 + if spec.typ.kind == tyOr: + 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; - effectPredicate: proc (g: ModuleGraph; a, b: PNode): bool {.nimcall.}) = +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; isForbids: bool = false) = # check that any real exception is listed in 'spec'; mark those as used; # report any unused exception var used = initIntSet() for r in items(real): block search: - for s in 0 ..< spec.len: + 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: - for s in 0 ..< spec.len: + for s in 0..<spec.len: if not used.contains(s): - message(g.config, spec[s].info, hintXDeclaredButNotUsed, renderTree(spec[s])) + message(g.config, spec[s].info, hintXCannotRaiseY, + "'$1' cannot raise '$2'" % [renderTree(hintsArg), renderTree(spec[s])]) proc checkMethodEffects*(g: ModuleGraph; disp, branch: PSym) = ## checks for consistent effects for multi methods. - let actual = branch.typ.n.sons[0] + let actual = branch.typ.n[0] if actual.len != effectListLen: return - let p = disp.ast.sons[pragmasPos] + let p = disp.ast[pragmasPos] let raisesSpec = effectSpec(p, wRaises) if not isNil(raisesSpec): - checkRaisesSpec(g, raisesSpec, actual.sons[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.sons[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) - 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]) + when defined(drnim): + if not g.compatibleProps(g, disp.typ, branch.typ): + localError(g.config, branch.info, "for method '" & branch.name.s & + "' the `.requires` or `.ensures` properties are incompatible.") -proc setEffectsForProcType*(g: ModuleGraph; t: PType, n: PNode) = - var effects = t.n.sons[0] +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 - - let - raisesSpec = effectSpec(n, wRaises) - tagsSpec = effectSpec(n, wTags) - if not isNil(raisesSpec) or not isNil(tagsSpec): + if n.kind != nkEmpty: internalAssert g.config, effects.len == 0 newSeq(effects.sons, effectListLen) + let raisesSpec = effectSpec(n, wRaises) if not isNil(raisesSpec): - effects.sons[exceptionEffects] = raisesSpec - if not isNil(tagsSpec): - effects.sons[tagEffects] = tagsSpec + effects[exceptionEffects] = raisesSpec + elif s != nil and (s.magic != mNone or {sfImportc, sfExportc} * s.flags == {sfImportc}): + effects[exceptionEffects] = newNodeI(nkArgList, effects.info) -proc initEffects(g: ModuleGraph; effects: PNode; s: PSym; t: var TEffects) = + 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): + effects[requiresEffects] = requiresSpec + let ensuresSpec = propSpec(n, wEnsures) + if not isNil(ensuresSpec): + effects[ensuresEffects] = ensuresSpec + + effects[pragmasEffects] = n + if s != nil and s.magic != mNone: + if s.magic != mEcho: + t.flags.incl tfNoSideEffect + +proc rawInitEffects(g: ModuleGraph; effects: PNode) = newSeq(effects.sons, effectListLen) - effects.sons[exceptionEffects] = newNodeI(nkArgList, s.info) - effects.sons[tagEffects] = newNodeI(nkArgList, s.info) - effects.sons[usesEffects] = g.emptyNode - effects.sons[writeEffects] = g.emptyNode - - t.exc = effects.sons[exceptionEffects] - t.tags = effects.sons[tagEffects] - t.owner = s - t.init = @[] - t.guards.s = @[] - t.guards.o = initOperators(g) - t.locked = @[] - t.graph = g - t.config = g.config - -proc trackProc*(g: ModuleGraph; s: PSym, body: PNode) = - var effects = s.typ.n.sons[0] + 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 + +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): + result.currOptions = g.config.options + s.options - {optStaticBoundsCheck} + else: + 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 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 sfForward in s.flags: return - if effects.len == effectListLen: return + if not s.hasRealBody: 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) track(t, body) - if not isEmptyType(s.typ.sons[0]) and - {tfNeedsInit, tfNotNil} * s.typ.sons[0].flags != {} and - s.kind in {skProc, skFunc, skConverter, skMethod}: - var res = s.ast.sons[resultPos].sym # get result symbol - if res.id notin t.init: - message(g.config, body.info, warnProveInit, "result") - let p = s.ast.sons[pragmasPos] + + if s.kind != skMacro: + let params = s.typ.n + for i in 1..<params.len: + let param = params[i].sym + let typ = param.typ + if isSinkTypeForParam(typ) or + (t.config.selectedGC in {gcArc, gcOrc, gcAtomicArc} and + (isClosure(typ.skipTypes(abstractInst)) or param.id in t.escapingParams)): + createTypeBoundOps(t, typ, param.info) + if isOutParam(typ) and param.id notin t.init: + message(g.config, param.info, warnProveInit, param.name.s) + + if not isEmptyType(s.typ.returnType) and + (s.typ.returnType.requiresInit or s.typ.returnType.skipTypes(abstractInst).kind == tyVar or + strictDefs in c.features) and + s.kind in {skProc, skFunc, skConverter, skMethod} and s.magic == mNone: + var res = s.ast[resultPos].sym # get result symbol + if res.id notin t.init and breaksBlock(body) != bsNoReturn: + if tfRequiresInit in s.typ.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: ", - hints=on, subtypeRelation) + 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.sons[exceptionEffects] = raisesSpec + 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.sons[tagEffects] = tagsSpec + 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): + effects[requiresEffects] = requiresSpec + let ensuresSpec = propSpec(p, wEnsures) + if not isNil(ensuresSpec): + patchResult(t, ensuresSpec) + effects[ensuresEffects] = ensuresSpec + + var mutationInfo = MutationInfo() + 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: @@ -970,29 +1716,39 @@ proc trackProc*(g: ModuleGraph; 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) + 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): - if s.kind == skFunc: + if s.name.s == "testp": dataflowAnalysis(s, body) + when false: trackWrites(s, body) + if strictNotNil in c.features and s.kind in {skProc, skFunc, skMethod, skConverter}: + checkNil(s, body, g.config, c.idgen) -proc trackTopLevelStmt*(g: ModuleGraph; module: PSym; n: PNode) = - if n.kind in {nkPragma, nkMacroDef, nkTemplateDef, nkProcDef, nkFuncDef, - nkTypeSection, nkConverterDef, nkMethodDef, nkIteratorDef}: - return - var effects = newNode(nkEffectList, n.info) - var t: TEffects - initEffects(g, effects, module, t) - t.isToplevel = true - track(t, n) +proc trackStmt*(c: PContext; module: PSym; n: PNode, isTopLevel: bool) = + 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 292238dc9..f5f8fea0c 100644 --- a/compiler/semstmts.nim +++ b/compiler/semstmts.nim @@ -12,7 +12,7 @@ const errNoSymbolToBorrowFromFound = "no symbol to borrow from found" - errDiscardValueX = "value of type '$1' has to be discarded" + errDiscardValueX = "value of type '$1' has to be used (or discarded)" errInvalidDiscard = "statement returns no value that can be discarded" errInvalidControlFlowX = "invalid control flow: $1" errSelectorMustBeOfCertainTypes = "selector must be of an ordinal type, float or string" @@ -27,314 +27,441 @@ const "it is used as an operand to another routine and the types " & "of the generic paramers can be inferred from the expected signature." errCannotInferTypeOfTheLiteral = "cannot infer the type of the $1" - errCannotInferReturnType = "cannot infer the return type of the proc" + errCannotInferReturnType = "cannot infer the return type of '$1'" errCannotInferStaticParam = "cannot infer the value of the static param '$1'" errProcHasNoConcreteType = "'$1' doesn't have a concrete type, due to unspecified generic parameters." errLetNeedsInit = "'let' symbol requires an initialization" errThreadvarCannotInit = "a thread var cannot be initialized explicitly; this would only run for the main thread" errImplOfXexpected = "implementation of '$1' expected" errRecursiveDependencyX = "recursive dependency: '$1'" + errRecursiveDependencyIteratorX = "recursion is not supported in iterators: '$1'" errPragmaOnlyInHeaderOfProcX = "pragmas are only allowed in the header of a proc; redefinition of $1" + 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 checkSonsLen(n, 1, c.config) - if n.sons[0].kind != nkEmpty: - n.sons[0] = semExprWithType(c, n.sons[0]) - if isEmptyType(n.sons[0].typ) or n.sons[0].typ.kind == tyNone or n.sons[0].kind == nkTypeOfExpr: + if n[0].kind != nkEmpty: + n[0] = semExprWithType(c, n[0]) + let sonType = n[0].typ + let sonKind = n[0].kind + 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. + localError(c.config, n.info, "illegal discard proc, did you mean: " & $n[0] & "()") proc semBreakOrContinue(c: PContext, n: PNode): PNode = result = n checkSonsLen(n, 1, c.config) - if n.sons[0].kind != nkEmpty: + if n[0].kind != nkEmpty: if n.kind != nkContinueStmt: - var s: PSym - case n.sons[0].kind - of nkIdent: s = lookUp(c, n.sons[0]) - of nkSym: s = n.sons[0].sym + var s: PSym = nil + case n[0].kind + of nkIdent: s = lookUp(c, n[0]) + of nkSym: s = n[0].sym else: illFormedAst(n, c.config) s = getGenSym(c, s) if s.kind == skLabel and s.owner.id == c.p.owner.id: var x = newSymNode(s) x.info = n.info incl(s.flags, sfUsed) - n.sons[0] = x - suggestSym(c.config, x.info, s, c.graph.usageSym) - styleCheckUse(x.info, s) + n[0] = x + suggestSym(c.graph, x.info, s, c.graph.usageSym) + onUse(x.info, s) else: localError(c.config, n.info, errInvalidControlFlowX % s.name.s) else: localError(c.config, n.info, errGenerated, "'continue' cannot have a label") - elif (c.p.nestedLoopCounter <= 0) and (c.p.nestedBlockCounter <= 0): + 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})) proc semAsm(c: PContext, n: PNode): PNode = checkSonsLen(n, 2, c.config) - var marker = pragmaAsm(c, n.sons[0]) + var marker = pragmaAsm(c, n[0]) if marker == '\0': marker = '`' # default marker result = semAsmOrEmit(c, n, marker) -proc semWhile(c: PContext, n: PNode): PNode = +proc semWhile(c: PContext, n: PNode; flags: TExprFlags): PNode = result = n checkSonsLen(n, 2, c.config) openScope(c) - n.sons[0] = forceBool(c, semExprWithType(c, n.sons[0])) + n[0] = forceBool(c, semExprWithType(c, n[0], expectedType = getSysType(c.graph, n.info, tyBool))) inc(c.p.nestedLoopCounter) - n.sons[1] = semStmt(c, n.sons[1]) + 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.sons[1].typ == c.enforceVoidContext: + if n[1].typ == c.enforceVoidContext: result.typ = c.enforceVoidContext - -proc toCover(c: PContext, t: PType): BiggestInt = - let t2 = skipTypes(t, abstractVarRange-{tyTypeDesc}) - if t2.kind == tyEnum and enumHasHoles(t2): - result = sonsLen(t2.n) - else: - result = lengthOrd(c.config, skipTypes(t, abstractVar-{tyTypeDesc})) + 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): PNode = - result = semExpr(c, n) +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, - nkElifBranch, nkElifExpr, nkElseExpr, nkBlockStmt, nkBlockExpr} + skipForDiscardable = {nkStmtList, nkStmtListExpr, + nkOfBranch, nkElse, nkFinally, nkExceptBranch, + nkElifBranch, nkElifExpr, nkElseExpr, nkBlockStmt, nkBlockExpr, + nkHiddenStdConv, nkHiddenSubConv, nkHiddenDeref} proc implicitlyDiscardable(n: PNode): bool = - var n = n - while n.kind in skipForDiscardable: n = n.lastSon - result = isCallExpr(n) and n.sons[0].kind == nkSym and - sfDiscardable in n.sons[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): if n.kind != nkNilLit and n.typ != nil: localError(c.config, n.info, errDiscardValueX % n.typ.typeToString) elif n.kind in {nkStmtList, nkStmtListExpr}: - n.kind = nkStmtList + n.transitionSonsKind(nkStmtList) for it in n: fixNilType(c, it) n.typ = nil -proc discardCheck(c: PContext, result: PNode) = - if c.matchedConcept != nil: return - if result.typ != nil and result.typ.kind notin {tyStmt, tyVoid}: +proc discardCheck(c: PContext, result: PNode, flags: TExprFlags) = + if c.matchedConcept != nil or efInTypeof in flags: return + + if result.typ != nil and result.typ.kind notin {tyTyped, tyVoid}: if implicitlyDiscardable(result): - var n = result - result.typ = nil - while n.kind in skipForDiscardable: - n = n.lastSon - n.typ = nil + 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 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): 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 countup(0, sonsLen(n) - 1): - var it = n.sons[i] + for i in 0..<n.len: + var it = n[i] if it.len == 2: - when newScopeForIf: openScope(c) - it.sons[0] = forceBool(c, semExprWithType(c, it.sons[0])) - when not newScopeForIf: openScope(c) - it.sons[1] = semExprBranch(c, it.sons[1]) - typ = commonType(typ, it.sons[1]) + openScope(c) + 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.sons[0] = semExprBranchScope(c, it.sons[0]) - typ = commonType(typ, it.sons[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, tyExpr} or not hasElse: - for it in n: discardCheck(c, it.lastSon) - result.kind = nkIfStmt + if isEmptyType(typ) or typ.kind in {tyNil, tyUntyped} or + (not hasElse and efInTypeof notin flags): + for it in n: discardCheck(c, it.lastSon, flags) + result.transitionSonsKind(nkIfStmt) # propagate any enforced VoidContext: if typ == c.enforceVoidContext: result.typ = c.enforceVoidContext else: for it in n: let j = it.len-1 - if not endsInNoReturn(it.sons[j]): - it.sons[j] = fitNode(c, typ, it.sons[j], it.sons[j].info) - result.kind = nkIfExpr - result.typ = typ - -proc semCase(c: PContext, n: PNode): PNode = - result = n - checkMinSonsLen(n, 2, c.config) - openScope(c) - n.sons[0] = semExprWithType(c, n.sons[0]) - var chckCovered = false - var covered: BiggestInt = 0 - var typ = commonTypeBegin - var hasElse = false - let caseTyp = skipTypes(n.sons[0].typ, abstractVarRange-{tyTypeDesc}) - case caseTyp.kind - of tyInt..tyInt64, tyChar, tyEnum, tyUInt..tyUInt32, tyBool: - chckCovered = true - of tyFloat..tyFloat128, tyString, tyError: - discard - else: - localError(c.config, n.info, errSelectorMustBeOfCertainTypes) - return - for i in countup(1, sonsLen(n) - 1): - var x = n.sons[i] - when defined(nimsuggest): - if c.config.ideCmd == ideSug and exactEquals(c.config.m.trackPos, x.info) and caseTyp.kind == tyEnum: - suggestEnum(c, x, caseTyp) - case x.kind - of nkOfBranch: - checkMinSonsLen(x, 2, c.config) - semCaseBranch(c, n, x, i, covered) - var last = sonsLen(x)-1 - x.sons[last] = semExprBranchScope(c, x.sons[last]) - typ = commonType(typ, x.sons[last]) - of nkElifBranch: - chckCovered = false - checkSonsLen(x, 2, c.config) - when newScopeForIf: openScope(c) - x.sons[0] = forceBool(c, semExprWithType(c, x.sons[0])) - when not newScopeForIf: openScope(c) - x.sons[1] = semExprBranch(c, x.sons[1]) - typ = commonType(typ, x.sons[1]) - closeScope(c) - of nkElse: - chckCovered = false - checkSonsLen(x, 1, c.config) - x.sons[0] = semExprBranchScope(c, x.sons[0]) - typ = commonType(typ, x.sons[0]) - hasElse = true - else: - illFormedAst(x, c.config) - if chckCovered: - if covered == toCover(c, n.sons[0].typ): - hasElse = true - else: - localError(c.config, n.info, "not all cases are covered") - closeScope(c) - if isEmptyType(typ) or typ.kind in {tyNil, tyExpr} or not hasElse: - for i in 1..n.len-1: discardCheck(c, n.sons[i].lastSon) - # propagate any enforced VoidContext: - if typ == c.enforceVoidContext: - result.typ = c.enforceVoidContext - else: - for i in 1..n.len-1: - var it = n.sons[i] - let j = it.len-1 - if not endsInNoReturn(it.sons[j]): - it.sons[j] = fitNode(c, typ, it.sons[j], it.sons[j].info) + if not endsInNoReturn(it[j]): + it[j] = fitNode(c, typ, it[j], it[j].info) + result.transitionSonsKind(nkIfExpr) result.typ = typ -proc semTry(c: PContext, n: PNode): 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 let typ = semTypeNode(c, typeNode, nil).toObject() - var is_imported = false + var isImported = false if isImportedException(typ, c.config): - is_imported = true + 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) typeNode = newNodeIT(nkType, typeNode.info, typ) - is_imported + isImported result = n - inc c.p.inTryStmt checkMinSonsLen(n, 2, c.config) var typ = commonTypeBegin - n[0] = semExprBranchScope(c, n[0]) - typ = commonType(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 = sonsLen(n) - 1 - for i in countup(1, last): - let a = n.sons[i] + var last = n.len - 1 + var catchAllExcepts = 0 + + for i in 1..last: + let a = n[i] checkMinSonsLen(a, 1, c.config) openScope(c) if a.kind == nkExceptBranch: 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`` - let is_imported = semExceptBranchType(a[0][1]) + let isImported = semExceptBranchType(a[0][1]) let symbol = newSymG(skLet, a[0][2], c) - symbol.typ = if is_imported: a[0][1].typ - else: a[0][1].typ.toRef() + symbol.typ = if isImported: a[0][1].typ + else: a[0][1].typ.toRef(c.idgen) addDecl(c, symbol) # Overwrite symbol in AST with the symbol in the symbol table. a[0][2] = newSymNode(symbol, a[0][2].info) + 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`` - var is_native, is_imported: bool - for j in 0..a.len-2: + if catchAllExcepts > 0: + # if ``except: body`` already encountered, + # cannot be followed by a ``except KeyError, ... : body`` block + inc catchAllExcepts + var isNative, isImported: bool = false + for j in 0..<a.len-1: let tmp = semExceptBranchType(a[j]) - if tmp: is_imported = true - else: is_native = true + if tmp: isImported = true + else: isNative = true - if is_native and is_imported: + if isNative and isImported: localError(c.config, a[0].info, "Mix of imported and native exception types is not allowed in one except branch") - elif a.kind != nkFinally: + elif a.kind == nkFinally: + if i != n.len-1: + localError(c.config, a.info, "Only one finally is allowed after all other branches") + + else: illFormedAst(n, c.config) + if catchAllExcepts > 1: + # if number of ``except: body`` blocks is greater than 1 + # or more specific exception follows a general except block, it is invalid + localError(c.config, a.info, "Only one general except clause is allowed after more specific exceptions") + # last child of an nkExcept/nkFinally branch is a statement: - a[^1] = semExprBranchScope(c, a[^1]) - if a.kind != nkFinally: typ = commonType(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, tyExpr}: - discardCheck(c, n.sons[0]) - for i in 1..n.len-1: discardCheck(c, n.sons[i].lastSon) + 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) if typ == c.enforceVoidContext: result.typ = c.enforceVoidContext else: - if n.lastSon.kind == nkFinally: discardCheck(c, n.lastSon.lastSon) - n.sons[0] = fitNode(c, typ, n.sons[0], n.sons[0].info) + if n.lastSon.kind == nkFinally: discardCheck(c, n.lastSon.lastSon, flags) + if not endsInNoReturn(n[0]): + n[0] = fitNode(c, typ, n[0], n[0].info) for i in 1..last: - var it = n.sons[i] + var it = n[i] let j = it.len-1 - it.sons[j] = fitNode(c, typ, it.sons[j], it.sons[j].info) + if not endsInNoReturn(it[j]): + it[j] = fitNode(c, typ, it[j], it[j].info) result.typ = typ proc fitRemoveHiddenConv(c: PContext, typ: PType, n: PNode): PNode = result = fitNode(c, typ, n, n.info) if result.kind in {nkHiddenStdConv, nkHiddenSubConv}: - let r1 = result.sons[1] + let r1 = result[1] if r1.kind in {nkCharLit..nkUInt64Lit} and typ.skipTypes(abstractRange).kind in {tyFloat..tyFloat128}: result = newFloatNode(nkFloatLit, BiggestFloat r1.intVal) result.info = n.info 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 @@ -342,20 +469,20 @@ proc fitRemoveHiddenConv(c: PContext, typ: PType, n: PNode): PNode = changeType(c, result, typ, check=false) proc findShadowedVar(c: PContext, v: PSym): PSym = - for scope in walkScopes(c.currentScope.parent): - if scope == c.topLevelScope: break + 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: return shadowed proc identWithin(n: PNode, s: PIdent): bool = - for i in 0 .. n.safeLen-1: - if identWithin(n.sons[i], s): return true + for i in 0..n.safeLen-1: + 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 @@ -363,22 +490,38 @@ proc semIdentDef(c: PContext, n: PNode, kind: TSymKind): PSym = result = semIdentWithPragma(c, kind, n, {}) if result.owner.kind == skModule: incl(result.flags, sfGlobal) - suggestSym(c.config, n.info, result, c.graph.usageSym) - styleCheckDef(c.config, result) + result.options = c.config.options + + proc getLineInfo(n: PNode): TLineInfo = + case n.kind + of nkPostfix: + if len(n) > 1: + return getLineInfo(n[1]) + of nkAccQuoted, nkPragmaExpr: + if len(n) > 0: + return getLineInfo(n[0]) + else: + discard + result = n.info + let info = getLineInfo(n) + if reportToNimsuggest: + suggestSym(c.graph, info, result, c.graph.usageSym) proc checkNilable(c: PContext; v: PSym) = - if {sfGlobal, sfImportC} * v.flags == {sfGlobal} and - {tfNotNil, tfNeedsInit} * v.typ.flags != {}: - if v.ast.isNil: + if {sfGlobal, sfImportc} * v.flags == {sfGlobal} and v.typ.requiresInit: + if v.astdef.isNil: message(c.config, v.info, warnProveInit, v.name.s) - elif tfNotNil in v.typ.flags and tfNotNil notin v.ast.typ.flags: + elif tfNotNil in v.typ.flags and not v.astdef.typ.isNil and tfNotNil notin v.astdef.typ.flags: message(c.config, v.info, warnProveInit, v.name.s) -include semasgn +#include liftdestructors + +proc addToVarSection(c: PContext; result: var PNode; n: PNode) = + if result.kind != nkStmtList: + result = makeStmtList(result) + result.add n -proc addToVarSection(c: PContext; result: PNode; orig, identDefs: PNode) = - let L = identDefs.len - let value = identDefs[L-1] +proc addToVarSection(c: PContext; result: var PNode; orig, identDefs: PNode) = if result.kind == nkStmtList: let o = copyNode(orig) o.add identDefs @@ -387,55 +530,68 @@ 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 if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "using") - for i in countup(0, sonsLen(n)-1): - var a = n.sons[i] + for i in 0..<n.len: + var a = n[i] if c.config.cmd == cmdIdeTools: suggestStmt(c, a) if a.kind == nkCommentStmt: continue if a.kind notin {nkIdentDefs, nkVarTuple, nkConstDef}: illFormedAst(a, c.config) checkMinSonsLen(a, 3, c.config) - var length = sonsLen(a) - if a.sons[length-2].kind != nkEmpty: - let typ = semTypeNode(c, a.sons[length-2], nil) - for j in countup(0, length-3): - let v = semIdentDef(c, a.sons[j], skParam) + if a[^2].kind != nkEmpty: + let typ = semTypeNode(c, a[^2], nil) + for j in 0..<a.len-2: + let v = semIdentDef(c, a[j], skParam) + styleCheckDef(c, v) + onDef(a[j].info, v) v.typ = typ strTableIncl(c.signatures, v) else: localError(c.config, a.info, "'using' section must have a type") var def: PNode - if a.sons[length-1].kind != nkEmpty: + 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 = skipTypes(t, {tyGenericInst, tyAlias, tySink}) + t = t.last + t = skipTypes(t, {tyGenericInst, tyAlias, tySink, tyOwned}) result = n if t.kind in {tyVar, tyLent}: - result = newNodeIT(nkHiddenDeref, n.info, t.sons[0]) - addSon(result, n) - t = skipTypes(t.sons[0], {tyGenericInst, tyAlias, tySink}) + result = newNodeIT(nkHiddenDeref, n.info, t.elementType) + result.add n + 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) - addSon(result, a) - t = skipTypes(baseTyp, {tyGenericInst, tyAlias, tySink}) + result.add a + t = skipTypes(baseTyp, {tyGenericInst, tyAlias, tySink, tyOwned}) proc fillPartialObject(c: PContext; n: PNode; typ: PType) = if n.len == 2: @@ -443,12 +599,12 @@ 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), obj.sym, n[1].info) - field.typ = skipIntLit(typ) - field.position = sonsLen(obj.n) - addSon(obj.n, newSymNode(field)) - n.sons[0] = makeDeref x - n.sons[1] = newSymNode(field) + 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) + n[0] = makeDeref x + n[1] = newSymNode(field) n.typ = field.typ else: localError(c.config, n.info, "implicit object field construction " & @@ -459,33 +615,233 @@ proc fillPartialObject(c: PContext; n: PNode; typ: PType) = proc setVarType(c: PContext; v: PSym, typ: PType) = if v.typ != nil and not sameTypeOrNil(v.typ, typ): localError(c.config, v.info, "inconsistent typing for reintroduced symbol '" & - v.name.s & "': previous type was: " & typeToString(v.typ) & - "; new type is: " & typeToString(typ)) + v.name.s & "': previous type was: " & typeToString(v.typ, preferDesc) & + "; new type is: " & typeToString(typ, preferDesc)) v.typ = typ +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: + 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 = var b: PNode result = copyNode(n) - var hasCompileTime = false - for i in countup(0, sonsLen(n)-1): - var a = n.sons[i] + + # 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) if a.kind == nkCommentStmt: continue - if a.kind notin {nkIdentDefs, nkVarTuple, nkConstDef}: illFormedAst(a, c.config) + if a.kind notin {nkIdentDefs, nkVarTuple}: illFormedAst(a, c.config) checkMinSonsLen(a, 3, c.config) - var length = sonsLen(a) - var typ: PType - if a.sons[length-2].kind != nkEmpty: - typ = semTypeNode(c, a.sons[length-2], nil) - else: - typ = nil + + 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 def: PNode = c.graph.emptyNode - if a.sons[length-1].kind != nkEmpty: - def = semExprWithType(c, a.sons[length-1], {efAllowDestructor}) - if def.typ.kind == tyTypeDesc and c.p.owner.kind != skMacro: - # prevent the all too common 'var x = int' bug: - localError(c.config, def.info, "'typedesc' metatype is not valid here; typed '=' instead of ':'?") - def.typ = errorType(c) + if typ != nil and typ.kind == tyRange and + c.graph.config.isDefined("nimPreviewRangeDefault") and + a[^1].kind == nkEmpty: + a[^1] = firstRange(c.config, typ) + + if a[^1].kind != nkEmpty: + def = semExprWithType(c, a[^1], {efTypeAllowed}, typ) + + if def.kind == nkSym and def.sym.kind in {skTemplate, skMacro}: + typFlags.incl taIsTemplateOrMacro + elif def.typ.kind == tyTypeDesc and c.p.owner.kind != skMacro: + typFlags.incl taProcContextIsNotMacro + if typ != nil: if typ.isMetaType: def = inferWithMetatype(c, typ, def) @@ -493,175 +849,323 @@ 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}).skipIntLit + 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).substr(2).toLowerAscii) - elif typ.kind == tyProc and tfUnresolved in typ.flags: - localError(c.config, def.info, errProcHasNoConcreteType % def.renderTree) - else: - if symkind == skLet: localError(c.config, a.info, errLetNeedsInit) + localError(c.config, def.info, errCannotInferTypeOfTheLiteral % typ.kind.toHumanStr) + 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 + # a more general solution. + if symkind == skVar and typ.kind == tyOwned and def.kind notin nkCallKinds: + # special type inference rule: 'var it = ownedPointer' is turned + # into an unowned pointer. + typ = typ.lastSon # this can only happen for errornous var statements: if typ == nil: continue - typeAllowedCheck(c.config, a.info, typ, symkind, if c.matchedConcept != nil: {taConcept} else: {}) - liftTypeBoundOps(c, typ, a.info) + + if c.matchedConcept != nil: + typFlags.incl taConcept + typeAllowedCheck(c, a.info, typ, symkind, typFlags) + var tup = skipTypes(typ, {tyGenericInst, tyAlias, tySink}) if a.kind == nkVarTuple: - if tup.kind != tyTuple: - localError(c.config, a.info, errXExpected, "tuple") - elif length-2 != sonsLen(tup): - localError(c.config, a.info, errWrongNumberOfVariables) - b = newNodeI(nkVarTuple, a.info) - newSons(b, length) - b.sons[length-2] = a.sons[length-2] # keep type desc for doc generator - b.sons[length-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 countup(0, length-3): - if a[j].kind == nkDotExpr: - fillPartialObject(c, a[j], - if a.kind != nkVarTuple: typ else: tup.sons[j]) - addToVarSection(c, result, n, a) - continue - var v = semIdentDef(c, a.sons[j], symkind) - if sfGenSym notin v.flags and not isDiscardUnderscore(v): - addInterfaceDecl(c, v) - 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) - # a shadowed variable is an error unless it appears on the right - # side of the '=': - if warnShadowIdent in c.config.notes and not identWithin(def, v.name): - message(c.config, a.info, warnShadowIdent, v.name.s) - 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: - # this is needed for the evaluation pass and for the guard checking: - v.ast = def 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 - addSon(b, newSymNode(v)) - addSon(b, a.sons[length-2]) # keep type desc for doc generator - addSon(b, copyTree(def)) + # 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] + b.add p + else: + b.add newSymNode(v) + # keep type desc for doc generator + b.add a[^2] + b.add copyTree(def) addToVarSection(c, result, n, b) - 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.sons[j]) - else: v.typ = tup - b.sons[j] = newSymNode(v) - checkNilable(c, v) - if sfCompileTime in v.flags: hasCompileTime = true - if v.flags * {sfGlobal, sfThread} == {sfGlobal}: - message(c.config, v.info, hintGlobalVar) - if hasCompileTime: - vm.setupCompileTimeVar(c.module, c.graph, result) - # handled by the VM codegen: - #c.graph.recordStmt(c.graph, c.module, result) + 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) - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] + inc c.inStaticContext + var b: PNode + for i in 0..<n.len: + var a = n[i] if c.config.cmd == cmdIdeTools: suggestStmt(c, a) if a.kind == nkCommentStmt: continue - if a.kind != nkConstDef: illFormedAst(a, c.config) - checkSonsLen(a, 3, c.config) - var v = semIdentDef(c, a.sons[0], skConst) - var typ: PType = nil - if a.sons[1].kind != nkEmpty: typ = semTypeNode(c, a.sons[1], nil) + if a.kind notin {nkConstDef, nkVarTuple}: illFormedAst(a, c.config) + checkMinSonsLen(a, 3, c.config) - var def = semConstExpr(c, a.sons[2]) - if def == nil: - localError(c.config, a.sons[2].info, errConstExprExpected) + 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 = {} + + # don't evaluate here since the type compatibility check below may add a converter + openScope(c) + var def = semExprWithType(c, a[^1], {efTypeAllowed}, typ) + + if def.kind == nkSym and def.sym.kind in {skTemplate, skMacro}: + typFlags.incl taIsTemplateOrMacro + elif def.typ.kind == tyTypeDesc and c.p.owner.kind != skMacro: + typFlags.incl taProcContextIsNotMacro + # check type compatibility between def.typ and typ: if typ != nil: - def = fitRemoveHiddenConv(c, typ, def) + if typ.isMetaType: + def = inferWithMetatype(c, typ, def) + typ = def.typ + else: + def = fitRemoveHiddenConv(c, typ, def) else: typ = def.typ - if typ == nil: - localError(c.config, a.sons[2].info, errConstExprExpected) - continue - if typeAllowed(typ, skConst) != nil and def.kind != nkNilLit: - localError(c.config, a.info, "invalid type for const: " & typeToString(typ)) + + # evaluate the node + def = semConstExpr(c, def) + if def == nil: + localError(c.config, a[^1].info, errConstExprExpected) continue - setVarType(c, v, typ) - v.ast = def # no need to copy - if sfGenSym notin v.flags: addInterfaceDecl(c, v) - var b = newNodeI(nkConstDef, a.info) - if importantComments(c.config): b.comment = a.comment - addSon(b, newSymNode(v)) - addSon(b, a.sons[1]) - addSon(b, copyTree(def)) - addSon(result, b) + if def.kind != nkNilLit: + if c.matchedConcept != nil: + typFlags.incl taConcept + typeAllowedCheck(c, a.info, typ, skConst, typFlags) + closeScope(c) + + if a.kind == nkVarTuple: + # generate new section from tuple unpacking and embed it into this one + 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 + # 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) + if fillSymbol: + v.ast = b + addToVarSection(c, result, n, b) + dec c.inStaticContext include semfields -proc addForVarDecl(c: PContext, v: PSym) = - if warnShadowIdent in c.config.notes: - let shadowed = findShadowedVar(c, v) - if shadowed != nil: - # XXX should we do this here? - #shadowed.flags.incl(sfShadowed) - message(c.config, v.info, warnShadowIdent, v.name.s) - addDecl(c, v) proc symForVar(c: PContext, n: PNode): PSym = - let m = if n.kind == nkPragmaExpr: n.sons[0] else: n + 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) -proc semForVars(c: PContext, n: PNode): PNode = +proc semForVars(c: PContext, n: PNode; flags: TExprFlags): PNode = result = n - var length = sonsLen(n) - let iterBase = n.sons[length-2].typ - var iter = skipTypes(iterBase, {tyGenericInst, tyAlias, tySink}) - # length == 3 means that there is one for loop variable + let iterBase = n[^2].typ + var iter = skipTypes(iterBase, {tyGenericInst, tyAlias, tySink, tyOwned}) + 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 iter.kind != tyTuple or length == 3: - if length == 3: - var v = symForVar(c, n.sons[0]) - if getCurrOwner(c).kind == skModule: incl(v.flags, sfGlobal) - # BUGFIX: don't use `iter` here as that would strip away - # the ``tyGenericInst``! See ``tests/compile/tgeneric.nim`` - # for an example: - v.typ = iterBase - n.sons[0] = newSymNode(v) - if sfGenSym notin v.flags: addForVarDecl(c, v) + 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 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) + case iter.kind + of tyVar, tyLent: + v.typ = newTypeS(iter.kind, c) + v.typ.add iterAfterVarLent[i] + if tfVarIsPtr in iter.flags: + v.typ.flags.incl tfVarIsPtr + else: + v.typ = iter[i] + n[0][i] = newSymNode(v) + if sfGenSym notin v.flags and not isDiscardUnderscore(v): addDecl(c, v) + elif v.owner == nil: v.owner = getCurrOwner(c) + else: + var v = symForVar(c, n[0]) + if getCurrOwner(c).kind == skModule: incl(v.flags, sfGlobal) + # BUGFIX: don't use `iter` here as that would strip away + # the ``tyGenericInst``! See ``tests/compile/tgeneric.nim`` + # for an example: + v.typ = iterBase + n[0] = newSymNode(v) + if sfGenSym notin v.flags and not isDiscardUnderscore(v): addDecl(c, v) + elif v.owner == nil: v.owner = getCurrOwner(c) else: localError(c.config, n.info, errWrongNumberOfVariables) - elif length-2 != sonsLen(iter): + elif n.len-2 != iterAfterVarLent.len: localError(c.config, n.info, errWrongNumberOfVariables) else: - for i in countup(0, length - 3): - var v = symForVar(c, n.sons[i]) - if getCurrOwner(c).kind == skModule: incl(v.flags, sfGlobal) - v.typ = iter.sons[i] - n.sons[i] = newSymNode(v) - if sfGenSym notin v.flags and not isDiscardUnderscore(v): - addForVarDecl(c, v) + for i in 0..<n.len - 2: + if n[i].kind == nkVarTuple: + var mutable = false + var isLent = false + case iter[i].kind + of tyVar: + mutable = true + iter[i] = iter[i].skipTypes({tyVar}) + of tyLent: + isLent = true + iter[i] = iter[i].skipTypes({tyLent}) + else: discard + + if n[i].len-1 != iter[i].len: + localError(c.config, n[i].info, errWrongNumberOfVariables) + for j in 0..<n[i].len-1: + var v = symForVar(c, n[i][j]) + if getCurrOwner(c).kind == skModule: incl(v.flags, sfGlobal) + if mutable: + v.typ = newTypeS(tyVar, c) + v.typ.add iter[i][j] + elif isLent: + v.typ = newTypeS(tyLent, c) + v.typ.add iter[i][j] + else: + v.typ = iter[i][j] + n[i][j] = newSymNode(v) + if not isDiscardUnderscore(v): addDecl(c, v) + elif v.owner == nil: v.owner = getCurrOwner(c) + else: + var v = symForVar(c, n[i]) + if getCurrOwner(c).kind == skModule: incl(v.flags, sfGlobal) + case iter.kind + of tyVar, tyLent: + v.typ = newTypeS(iter.kind, c) + v.typ.add iterAfterVarLent[i] + if tfVarIsPtr in iter.flags: + v.typ.flags.incl tfVarIsPtr + else: + v.typ = iter[i] + n[i] = newSymNode(v) + if sfGenSym notin v.flags: + 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.sons[length-1] = semStmt(c, n.sons[length-1]) + 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 = @@ -674,34 +1178,34 @@ proc implicitIterator(c: PContext, it: string, arg: PNode): PNode = result = semExprNoDeref(c, result, {efWantIterator}) proc isTrivalStmtExpr(n: PNode): bool = - for i in 0 .. n.len-2: + for i in 0..<n.len-1: if n[i].kind notin {nkEmpty, nkCommentStmt}: return false result = true -proc handleForLoopMacro(c: PContext; n: PNode): PNode = - let iterExpr = n[^2] - if iterExpr.kind in nkCallKinds: +proc handleStmtMacro(c: PContext; n, selector: PNode; magicType: string; + flags: TExprFlags): PNode = + if selector.kind in nkCallKinds: # we transform # n := for a, b, c in m(x, y, z): Y # to # m(n) - let forLoopStmt = magicsys.getCompilerProc(c.graph, "ForLoopStmt") - if forLoopStmt == nil: return + let maType = magicsys.getCompilerProc(c.graph, magicType) + if maType == nil: return - let headSymbol = iterExpr[0] - var o: TOverloadIter + let headSymbol = selector[0] + 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] == forLoopStmt.typ: + if symx.typ.len == 2 and symx.typ.firstParamType == maType.typ: if match == nil: match = symx else: localError(c.config, n.info, errAmbiguousCallXYZ % [ getProcHeader(c.config, match), - getProcHeader(c.config, symx), $iterExpr]) + getProcHeader(c.config, symx), $selector]) symx = nextOverloadIter(o, c, headSymbol) if match == nil: return @@ -709,146 +1213,300 @@ proc handleForLoopMacro(c: PContext; n: PNode): PNode = callExpr.add newSymNode(match) callExpr.add n case match.kind - of skMacro: result = semMacroExpr(c, callExpr, callExpr, match, {}) - of skTemplate: result = semTemplateExpr(c, callExpr, match, {}) + 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) + +proc handleCaseStmtMacro(c: PContext; n: PNode; flags: TExprFlags): PNode = + # n[0] has been sem'checked and has a type. We use this to resolve + # '`case`(n[0])' but then we pass 'n' to the `case` macro. This seems to + # be the best solution. + var toResolve = newNodeI(nkCall, n.info) + toResolve.add newIdentNode(getIdent(c.cache, "case"), n.info) + toResolve.add n[0] + + var errors: CandidateErrors = @[] + var r = resolveOverloads(c, toResolve, toResolve, {skTemplate, skMacro}, {efNoUndeclared}, + errors, false) + if r.state == csMatch: + var match = r.calleeSym + markUsed(c, n[0].info, match) + onUse(n[0].info, match) + + # but pass 'n' to the `case` macro, not 'n[0]': + r.call[1] = n + let toExpand = semResolvedCall(c, r, r.call, {}) + case match.kind + of skMacro: result = semMacroExpr(c, toExpand, toExpand, match, flags) + of skTemplate: result = semTemplateExpr(c, toExpand, match, flags) + 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: + when false: + result = handleStmtMacro(c, n, n[0], "CaseStmt") -proc semFor(c: PContext, n: PNode): PNode = +proc semFor(c: PContext, n: PNode; flags: TExprFlags): PNode = checkMinSonsLen(n, 3, c.config) - var length = sonsLen(n) - result = handleForLoopMacro(c, n) + result = handleForLoopMacro(c, n, flags) if result != nil: return result openScope(c) result = n - n.sons[length-2] = semExprNoDeref(c, n.sons[length-2], {efWantIterator}) - var call = n.sons[length-2] - if call.kind == nkStmtListExpr and isTrivalStmtExpr(call): + n[^2] = semExprNoDeref(c, n[^2], {efWantIterator}) + var call = n[^2] + + if call.kind == nkStmtListExpr and (isTrivalStmtExpr(call) or (call.lastSon.kind in nkCallKinds and call.lastSon[0].sym.kind == skIterator)): call = call.lastSon - n.sons[length-2] = call + n[^2] = call let isCallExpr = call.kind in nkCallKinds if isCallExpr and call[0].kind == nkSym and call[0].sym.magic in {mFields, mFieldPairs, mOmpParFor}: - if call.sons[0].sym.magic == mOmpParFor: - result = semForVars(c, n) - result.kind = nkParForStmt + if call[0].sym.magic == mOmpParFor: + result = semForVars(c, n, flags) + result.transitionSonsKind(nkParForStmt) else: - result = semForFields(c, n, call.sons[0].sym.magic) - elif isCallExpr and call.sons[0].typ.callConv == ccClosure and - tfIterator in call.sons[0].typ.flags: + result = semForFields(c, n, call[0].sym.magic) + elif isCallExpr and isClosureIterator(call[0].typ.skipTypes(abstractInst)): # first class iterator: - result = semForVars(c, n) - elif not isCallExpr or call.sons[0].kind != nkSym or - call.sons[0].sym.kind != skIterator: - if length == 3: - n.sons[length-2] = implicitIterator(c, "items", n.sons[length-2]) - elif length == 4: - n.sons[length-2] = implicitIterator(c, "pairs", n.sons[length-2]) + result = semForVars(c, n, flags) + elif not isCallExpr or call[0].kind != nkSym or + call[0].sym.kind != skIterator: + if n.len == 3: + n[^2] = implicitIterator(c, "items", n[^2]) + elif n.len == 4: + n[^2] = implicitIterator(c, "pairs", n[^2]) else: - localError(c.config, n.sons[length-2].info, "iterator within for loop context expected") - result = semForVars(c, n) + localError(c.config, n[^2].info, "iterator within for loop context expected") + result = semForVars(c, n, flags) else: - result = semForVars(c, n) + result = semForVars(c, n, flags) # propagate any enforced VoidContext: - if n.sons[length-1].typ == c.enforceVoidContext: + if n[^1].typ == c.enforceVoidContext: result.typ = c.enforceVoidContext + elif efInTypeof in flags: + result.typ = result.lastSon.typ closeScope(c) +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 covered: Int128 = toInt128(0) + var typ = commonTypeBegin + var expectedType = expectedType + var hasElse = false + let caseTyp = skipTypes(n[0].typ, abstractVar-{tyTypeDesc}) + var chckCovered = caseTyp.shouldCheckCaseCovered() + case caseTyp.kind + of tyFloat..tyFloat128, tyString, tyCstring, tyError, shouldChckCovered, tyRange: + discard + else: + popCaseContext(c) + closeScope(c) + 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] + when defined(nimsuggest): + if c.config.ideCmd == ideSug and exactEquals(c.config.m.trackPos, x.info) and caseTyp.kind == tyEnum: + 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], 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], 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], 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 + chckCovered = false + else: + illFormedAst(x, c.config) + if chckCovered: + if covered == toCover(c, n[0].typ): + hasElse = true + elif n[0].typ.skipTypes(abstractRange).kind in {tyEnum, tyChar}: + localError(c.config, n.info, "not all cases are covered; missing: $1" % + formatMissingEnums(c, n)) + else: + localError(c.config, n.info, "not all cases are covered") + popCaseContext(c) + closeScope(c) + if isEmptyType(typ) or typ.kind in {tyNil, tyUntyped} or + (not hasElse and efInTypeof notin flags): + for i in 1..<n.len: discardCheck(c, n[i].lastSon, flags) + # propagate any enforced VoidContext: + if typ == c.enforceVoidContext: + result.typ = c.enforceVoidContext + else: + for i in 1..<n.len: + var it = n[i] + let j = it.len-1 + if not endsInNoReturn(it[j]): + it[j] = fitNode(c, typ, it[j], it[j].info) + result.typ = typ + proc semRaise(c: PContext, n: PNode): PNode = result = n checkSonsLen(n, 1, c.config) if n[0].kind != nkEmpty: n[0] = semExprWithType(c, n[0]) - let typ = n[0].typ + var typ = n[0].typ if not isImportedException(typ, c.config): - if typ.kind != tyRef or typ.lastSon.kind != tyObject: + typ = typ.skipTypes({tyAlias, tyGenericInst, tyOwned}) + if typ.kind != tyRef: localError(c.config, n.info, errExprCannotBeRaised) - if 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) - for i in countup(0, sonsLen(n)-1): - var a = n.sons[i] + for i in 0..<n.len: + var a = n[i] if a.kind == nkSym: addDecl(c, a.sym) else: illFormedAst(a, c.config) proc typeSectionTypeName(c: PContext; n: PNode): PNode = if n.kind == nkPragmaExpr: if n.len == 0: illFormedAst(n, c.config) - result = n.sons[0] + 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 = nil + if name.kind == nkDotExpr and typeDef[2].kind == nkObjectTy: + let pkgName = considerQuotedIdent(c, name[0]) + let typName = considerQuotedIdent(c, name[1]) + let pkg = c.graph.packageSyms.strTableGet(pkgName) + if pkg.isNil or pkg.kind != skPackage: + localError(c.config, name.info, "unknown package name: " & pkgName.s) + else: + let typsym = c.graph.packageTypes.strTableGet(typName) + if typsym.isNil: + s = semIdentDef(c, name[1], skType) + onDef(name[1].info, s) + s.typ = newTypeS(tyObject, c) + s.typ.sym = s + s.flags.incl sfForward + c.graph.packageTypes.strTableAdd s + addInterfaceDecl(c, s) + 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 + else: + s = semIdentDef(c, name, skType) + onDef(name.info, s) + s.typ = newTypeS(tyForward, c) + s.typ.sym = s # process pragmas: + if name.kind == nkPragmaExpr: + let rewritten = applyTypeSectionPragmas(c, name[1], typeDef) + if rewritten != nil: + 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) + if sfForward in s.flags: + # check if the symbol already exists: + let pkg = c.module.owner + if not isTopLevel(c) or pkg.isNil: + localError(c.config, name.info, "only top level types in a package can be 'package'") + else: + let typsym = c.graph.packageTypes.strTableGet(s.name) + if typsym != nil: + if sfForward notin typsym.flags or sfNoForward notin typsym.flags: + typeCompleted(typsym) + typsym.info = s.info + else: + localError(c.config, name.info, "cannot complete type '" & s.name.s & "' twice; " & + "previous type completion was here: " & c.config$typsym.info) + s = typsym + # add it here, so that recursive types are possible: + if sfGenSym notin s.flags: addInterfaceDecl(c, s) + elif s.owner == nil: s.owner = getCurrOwner(c) + + if name.kind == nkPragmaExpr: + if name[0].kind == nkPostfix: + typeDef[0][0][1] = newSymNode(s) + else: + typeDef[0][0] = newSymNode(s) + else: + 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 countup(0, sonsLen(n) - 1): - var a = n.sons[i] + 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) - checkSonsLen(a, 3, c.config) - let name = a.sons[0] - var s: PSym - if name.kind == nkDotExpr and a[2].kind == nkObjectTy: - let pkgName = considerQuotedIdent(c, name[0]) - let typName = considerQuotedIdent(c, name[1]) - let pkg = c.graph.packageSyms.strTableGet(pkgName) - if pkg.isNil or pkg.kind != skPackage: - localError(c.config, name.info, "unknown package name: " & pkgName.s) - else: - let typsym = pkg.tab.strTableGet(typName) - if typsym.isNil: - s = semIdentDef(c, name[1], skType) - s.typ = newTypeS(tyObject, c) - s.typ.sym = s - s.flags.incl sfForward - pkg.tab.strTableAdd s - addInterfaceDecl(c, s) - elif typsym.kind == skType and sfForward in typsym.flags: - s = typsym - addInterfaceDecl(c, s) - else: - localError(c.config, name.info, typsym.name.s & " is not a type that can be forwarded") - s = typsym - else: - s = semIdentDef(c, name, skType) - s.typ = newTypeS(tyForward, c) - s.typ.sym = s # process pragmas: - if name.kind == nkPragmaExpr: - pragma(c, s, name.sons[1], typePragmas) - if sfForward in s.flags: - # check if the symbol already exists: - let pkg = c.module.owner - if not isTopLevel(c) or pkg.isNil: - localError(c.config, name.info, "only top level types in a package can be 'package'") - else: - let typsym = pkg.tab.strTableGet(s.name) - if typsym != nil: - if sfForward notin typsym.flags or sfNoForward notin typsym.flags: - typeCompleted(typsym) - typsym.info = s.info - else: - localError(c.config, name.info, "cannot complete type '" & s.name.s & "' twice; " & - "previous type completion was here: " & c.config$typsym.info) - s = typsym - # add it here, so that recursive types are possible: - if sfGenSym notin s.flags: addInterfaceDecl(c, s) - - if name.kind == nkPragmaExpr: - a.sons[0].sons[0] = newSymNode(s) - else: - a.sons[0] = newSymNode(s) + 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) @@ -865,18 +1523,18 @@ 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] - for i in 1 ..< t.len: + let targetBody = t.genericHead + for i in 1..<t.len: let param = t[i] if param.kind == tyGenericParam: if tfCovariant in param.flags: @@ -900,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) - of tyDistinct, tyAlias, tySink: - return traverseSubTypes(c, t.lastSon) + if t.elementType.kind == tyGenericParam: return true + return traverseSubTypes(c, t.elementType) + of tyDistinct, tyAlias, tySink, tyOwned: + return traverseSubTypes(c, t.skipModifier) of tyGenericInst: internalAssert c.config, false else: @@ -914,17 +1572,18 @@ proc checkCovariantParamsUsages(c: PContext; genericType: PType) = discard traverseSubTypes(c, body) proc typeSectionRightSidePass(c: PContext, n: PNode) = - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] + for i in 0..<n.len: + var a = n[i] if a.kind == nkCommentStmt: continue if a.kind != nkTypeDef: illFormedAst(a, c.config) checkSonsLen(a, 3, c.config) - let name = typeSectionTypeName(c, a.sons[0]) + let name = typeSectionTypeName(c, a[0]) var s = name.sym - if s.magic == mNone and a.sons[2].kind == nkEmpty: + 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) - if a.sons[1].kind != nkEmpty: + 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. openScope(c) @@ -937,21 +1596,32 @@ proc typeSectionRightSidePass(c: PContext, n: PNode) = # TGObj[T] = object # TAlias[T] = TGObj[T] # - s.typ.n = semGenericParamList(c, a.sons[1], s.typ) - a.sons[1] = s.typ.n + s.typ.n = semGenericParamList(c, a[1], s.typ) + a[1] = s.typ.n s.typ.size = -1 # could not be computed properly # 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.sons[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 - s.typ.sons[sonsLen(s.typ) - 1] = body + 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) # XXX: This is a temporary limitation: @@ -963,17 +1633,17 @@ 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 = nil + body.n.sons = @[] popOwner(c) closeScope(c) - elif a.sons[2].kind != nkEmpty: + elif a[2].kind != nkEmpty: # process the type's body: pushOwner(c, s) - var t = semTypeNode(c, a.sons[2], s.typ) + var t = semTypeNode(c, a[2], s.typ) if s.typ == nil: s.typ = t elif t != s.typ and (s.typ == nil or s.typ.kind != tyAlias): @@ -982,73 +1652,145 @@ proc typeSectionRightSidePass(c: PContext, n: PNode) = #debug s.typ s.ast = a popOwner(c) - let aa = a.sons[2] + # If the right hand side expression was a macro call we replace it with + # its evaluated result here so that we don't execute it once again in the + # final pass + if a[2].kind in nkCallKinds: + incl a[2].flags, nfSem # bug #10548 + 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.sons[0].kind == nkObjectTy: + 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"), - getCurrOwner(c), s.info) - obj.typ = st.lastSon - st.lastSon.sym = obj - - -proc checkForMetaFields(c: PContext; n: PNode) = - template checkMeta(t) = - if t != nil and t.isMetaType and tfGenericTypeParam notin t.flags: - localError(c.config, n.info, errTIsNotAConcreteType % t.typeToString) + 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 + 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] + 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 = 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 of tySequence, tySet, tyArray, tyOpenArray, tyVar, tyLent, tyPtr, tyRef, - tyProc, tyGenericInvocation, tyGenericInst, tyAlias, tySink: - let start = int ord(t.kind in {tyGenericInvocation, tyGenericInst}) - for i in start ..< t.sons.len: - checkMeta(t.sons[i]) + 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], hasError, t) else: - checkMeta(t) + checkMeta(c, n, t, hasError, nil) else: internalAssert c.config, false proc typeSectionFinalPass(c: PContext, n: PNode) = - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] + for i in 0..<n.len: + var a = n[i] if a.kind == nkCommentStmt: continue - let name = typeSectionTypeName(c, a.sons[0]) + let name = typeSectionTypeName(c, a[0]) var s = name.sym + # check the style here after the pragmas have been processed: + styleCheckDef(c, s) # compute the type's size and check for illegal recursions: - if a.sons[1].kind == nkEmpty: + if a[1].kind == nkEmpty: var x = a[2] - while x.kind in {nkStmtList, nkStmtListExpr} and x.len > 0: - x = x.lastSon - if x.kind notin {nkObjectTy, nkDistinctTy, nkEnumTy, nkEmpty} and - s.typ.kind notin {tyObject, tyEnum}: - # type aliases are hard: - var t = semTypeNode(c, x, nil) - assert t != nil - if s.typ != nil and s.typ.kind notin {tyAlias, tySink}: - if t.kind in {tyProc, tyGenericInst} and not t.isMetaType: - assignType(s.typ, t) - s.typ.id = t.id - elif t.kind in {tyObject, tyEnum, tyDistinct}: - assert s.typ != nil - assignType(s.typ, t) - s.typ.id = t.id # 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) - instAllTypeBoundOp(c, n.info) + if x.kind in nkCallKinds and nfSem in x.flags: + discard "already semchecked, see line marked with bug #10548" + else: + while x.kind in {nkStmtList, nkStmtListExpr} and x.len > 0: + x = x.lastSon + # we need the 'safeSkipTypes' here because illegally recursive types + # can enter at this point, see bug #13763 + if x.kind notin {nkObjectTy, nkDistinctTy, nkEnumTy, nkEmpty} and + s.typ.safeSkipTypes(abstractPtrs).kind notin {tyObject, tyEnum}: + # type aliases are hard: + var t = semTypeNode(c, x, nil) + assert t != nil + if s.typ != nil and s.typ.kind notin {tyAlias, tySink}: + if t.kind in {tyProc, tyGenericInst} and not t.isMetaType: + assignType(s.typ, t) + s.typ.itemId = t.itemId + elif t.kind in {tyObject, tyEnum, tyDistinct}: + assert s.typ != nil + assignType(s.typ, t) + s.typ.itemId = t.itemId # same id + 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) proc semAllTypeSections(c: PContext; n: PNode): PNode = @@ -1056,17 +1798,17 @@ proc semAllTypeSections(c: PContext; n: PNode): PNode = case n.kind of nkIncludeStmt: for i in 0..<n.len: - var f = checkModuleName(c.config, n.sons[i]) - if f != InvalidFileIDX: + var f = checkModuleName(c.config, n[i]) + if f != InvalidFileIdx: if containsOrIncl(c.includedFiles, f.int): - localError(c.config, n.info, errRecursiveDependencyX % toFilename(c.config, f)) + localError(c.config, n.info, errRecursiveDependencyX % toMsgFilename(c.config, f)) else: let code = c.graph.includeFileCallback(c.graph, c.module, f) gatherStmts c, code, result excl(c.includedFiles, f.int) of nkStmtList: - for i in 0 ..< n.len: - gatherStmts(c, n.sons[i], result) + for i in 0..<n.len: + gatherStmts(c, n[i], result) of nkTypeSection: incl n.flags, nfSem typeSectionLeftSidePass(c, n) @@ -1078,7 +1820,7 @@ proc semAllTypeSections(c: PContext; n: PNode): PNode = gatherStmts(c, n, result) template rec(name) = - for i in 0 ..< result.len: + for i in 0..<result.len: if result[i].kind == nkTypeSection: name(c, result[i]) @@ -1092,8 +1834,8 @@ proc semAllTypeSections(c: PContext; n: PNode): PNode = when setbit: incl n.flags, nfSem name(c, n) elif n.kind == nkStmtList: - for i in 0 ..< n.len: - `name rec`(c, n.sons[i]) + for i in 0..<n.len: + `name rec`(c, n[i]) `name rec`(c, n) rec typeSectionLeftSidePass, true rec typeSectionRightSidePass @@ -1113,158 +1855,124 @@ proc semTypeSection(c: PContext, n: PNode): PNode = proc semParamList(c: PContext, n, genericParams: PNode, s: PSym) = s.typ = semProcTypeNode(c, n, genericParams, nil, s.kind) - if s.kind notin {skMacro, skTemplate}: - if s.typ.sons[0] != nil and s.typ.sons[0].kind == tyStmt: - localError(c.config, n.info, "invalid return type: 'stmt'") proc addParams(c: PContext, n: PNode, kind: TSymKind) = - for i in countup(1, sonsLen(n)-1): - if n.sons[i].kind == nkSym: addParamOrResult(c, n.sons[i].sym, kind) + for i in 1..<n.len: + if n[i].kind == nkSym: addParamOrResult(c, n[i].sym, kind) else: illFormedAst(n, c.config) 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.sons[bodyPos] = newSymNode(b) + 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 addResult(c: PContext, t: PType, info: TLineInfo, owner: TSymKind) = - if t != nil: - var s = newSym(skResult, getIdent(c.cache, "result"), getCurrOwner(c), info) +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) - addParamOrResult(c, s, owner) - c.p.resultSym = s -proc addResultNode(c: PContext, n: PNode) = - if c.p.resultSym != nil: addSon(n, newSymNode(c.p.resultSym)) - -proc copyExcept(n: PNode, i: int): PNode = - result = copyNode(n) - for j in 0..<n.len: - if j != i: result.add(n.sons[j]) - -proc lookupMacro(c: PContext, n: PNode): PSym = - if n.kind == nkSym: - result = n.sym - if result.kind notin {skMacro, skTemplate}: result = nil - else: - result = searchInScopes(c, considerQuotedIdent(c, n), {skMacro, skTemplate}) + if owner == skMacro or t != nil: + if n.len > resultPos and n[resultPos] != nil: + 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: + genResSym(s) + c.p.resultSym = s + n.add newSymNode(c.p.resultSym) + addParamOrResult(c, c.p.resultSym, owner) proc semProcAnnotation(c: PContext, prc: PNode; validPragmas: TSpecialWords): PNode = - var n = prc.sons[pragmasPos] + # Mirrored with semVarMacroPragma + result = nil + var n = prc[pragmasPos] if n == nil or n.kind == nkEmpty: return - for i in countup(0, n.len-1): - var it = n.sons[i] - var key = if it.kind in nkPragmaCallKinds and it.len >= 1: it.sons[0] else: it - let m = lookupMacro(c, key) - if m == nil: - if key.kind == nkIdent and key.ident.id == ord(wDelegator): - if considerQuotedIdent(c, prc.sons[namePos]).s == "()": - prc.sons[namePos] = newIdentNode(c.cache.idDelegator, prc.info) - prc.sons[pragmasPos] = copyExcept(n, i) - else: - localError(c.config, prc.info, "only a call operator can be a delegator") - continue - elif sfCustomPragma in m.flags: - continue # semantic check for custom pragma happens later in semProcAux - - # we transform ``proc p {.m, rest.}`` into ``m(do: proc p {.rest.})`` and - # let the semantic checker deal with it: - var x = newNodeI(nkCall, n.info) - x.add(newSymNode(m)) - prc.sons[pragmasPos] = copyExcept(n, i) - if prc[pragmasPos].kind != nkEmpty and prc[pragmasPos].len == 0: - prc.sons[pragmasPos] = c.graph.emptyNode - - 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.sons[i]) - x.add(prc) - - # recursion assures that this works for multiple macro annotations too: - result = semExpr(c, x) - # 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) - return - -proc setGenericParamsMisc(c: PContext; n: PNode): PNode = - let orig = n.sons[genericParamsPos] - # we keep the original params around for better error messages, see - # issue https://github.com/nim-lang/Nim/issues/1713 - result = semGenericParamList(c, orig) - if n.sons[miscPos].kind == nkEmpty: - n.sons[miscPos] = newTree(nkBracket, c.graph.emptyNode, orig) - else: - n.sons[miscPos].sons[1] = orig - n.sons[genericParamsPos] = result + 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 + + 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 -proc semLambda(c: PContext, n: PNode, flags: TExprFlags): PNode = - # XXX semProcAux should be good enough for this now, we will eventually - # remove semLambda - result = semProcAnnotation(c, n, lambdaPragmas) - if result != nil: return result - result = n - checkSonsLen(n, bodyPos + 1, c.config) - var s: PSym - if n[namePos].kind != nkSym: - s = newSym(skProc, c.cache.idAnon, getCurrOwner(c), n.info) - s.ast = n - n.sons[namePos] = newSymNode(s) - else: - s = n[namePos].sym - pushOwner(c, s) - openScope(c) - var gp: PNode - if n.sons[genericParamsPos].kind != nkEmpty: - gp = setGenericParamsMisc(c, n) - else: - gp = newNodeI(nkGenericParams, n.info) - - if n.sons[paramsPos].kind != nkEmpty: - semParamList(c, n.sons[paramsPos], gp, s) - # paramsTypeCheck(c, s.typ) - if sonsLen(gp) > 0 and n.sons[genericParamsPos].kind == nkEmpty: - # we have a list of implicit type parameters: - n.sons[genericParamsPos] = gp - else: - s.typ = newProcType(c, n.info) - if n.sons[pragmasPos].kind != nkEmpty: - pragma(c, s, n.sons[pragmasPos], lambdaPragmas) - s.options = c.config.options - if n.sons[bodyPos].kind != nkEmpty: - if sfImportc in s.flags: - localError(c.config, n.sons[bodyPos].info, errImplOfXNotAllowed % s.name.s) - #if efDetermineType notin flags: - # XXX not good enough; see tnamedparamanonproc.nim - if gp.len == 0 or (gp.len == 1 and tfRetType in gp[0].typ.flags): - pushProcCon(c, s) - addResult(c, s.typ.sons[0], n.info, skProc) - addResultNode(c, n) - let semBody = hloBody(c, semProcBody(c, n.sons[bodyPos])) - n.sons[bodyPos] = transformBody(c.graph, c.module, semBody, s) - popProcCon(c) - elif efOperand notin flags: - localError(c.config, n.info, errGenericLambdaNotAllowed) - sideEffectsCheck(c, s) - else: - localError(c.config, n.info, errImplOfXexpected % s.name.s) - closeScope(c) # close scope for parameters - popOwner(c) - result.typ = s.typ + 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 -proc semInferredLambda(c: PContext, pt: TIdTable, n: PNode): PNode = - var n = n + doAssert result != nil - let original = n.sons[namePos].sym + return result + +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) #incl(s.flags, sfFromGeneric) #s.owner = original @@ -1272,11 +1980,10 @@ proc semInferredLambda(c: PContext, pt: TIdTable, n: PNode): PNode = n = replaceTypesInBody(c, pt, n, original) result = n s.ast = result - n.sons[namePos].sym = s - n.sons[genericParamsPos] = c.graph.emptyNode + n[namePos].sym = s + n[genericParamsPos] = c.graph.emptyNode # for LL we need to avoid wrong aliasing let params = copyTree n.typ.n - n.sons[paramsPos] = params s.typ = n.typ for i in 1..<params.len: if params[i].typ.kind in {tyTypeDesc, tyGenericParam, @@ -1288,14 +1995,14 @@ proc semInferredLambda(c: PContext, pt: TIdTable, n: PNode): PNode = pushOwner(c, s) addParams(c, params, skProc) pushProcCon(c, s) - addResult(c, n.typ.sons[0], n.info, skProc) - addResultNode(c, n) - let semBody = hloBody(c, semProcBody(c, n.sons[bodyPos])) - n.sons[bodyPos] = transformBody(c.graph, c.module, semBody, s) + 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) closeScope(c) - + if optOwnedRefs in c.config.globalOptions and result.typ != nil: + result.typ = makeVarType(c, result.typ, tyOwned) # alternative variant (not quite working): # var prc = arg[0].sym # let inferred = c.semGenerateInstance(c, prc, m.bindings, arg.info) @@ -1311,96 +2018,233 @@ proc activate(c: PContext, n: PNode) = of nkLambdaKinds: discard semLambda(c, n, {}) of nkCallKinds: - for i in 1 ..< n.len: activate(c, n[i]) + for i in 1..<n.len: activate(c, n[i]) else: discard proc maybeAddResult(c: PContext, s: PSym, n: PNode) = - if s.typ.sons[0] != nil and not - (s.kind == skIterator and s.typ.callConv != ccClosure): - addResult(c, s.typ.sons[0], n.info, s.kind) - addResultNode(c, n) + if s.kind == skMacro: + let resultType = sysTypeFromName(c.graph, n.info, "NimNode") + addResult(c, n, resultType, 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: + result = c.graph.sysTypes[tySequence] + else: + result = t -proc semOverride(c: PContext, s: PSym, n: PNode) = - case s.name.s.normalize - of "=destroy": - let t = s.typ - var noError = false - if t.len == 2 and t.sons[0] == nil and t.sons[1].kind == tyVar: - var obj = t.sons[1].sons[0] - while true: - incl(obj.flags, tfHasAsgn) - if obj.kind in {tyGenericBody, tyGenericInst}: obj = obj.lastSon - elif obj.kind == tyGenericInvocation: obj = obj.sons[0] - else: break - if obj.kind in {tyObject, tyDistinct}: - if obj.destructor.isNil: - obj.destructor = s - else: - localError(c.config, n.info, errGenerated, - "cannot bind another '" & s.name.s & "' to: " & typeToString(obj)) - noError = true - if not noError and sfSystemModule notin s.owner.flags: +proc prevDestructor(c: PContext; prevOp: PSym; obj: PType; info: TLineInfo) = + var msg = "cannot bind another '" & prevOp.name.s & "' to: " & typeToString(obj) + 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) + localError(c.config, info, errGenerated, msg) + +proc whereToBindTypeHook(c: PContext; t: PType): PType = + result = t + while true: + 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 bindDupHook(c: PContext; s: PSym; n: PNode; op: TTypeAttachedOp) = + let t = s.typ + var noError = false + 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.returnType == nil + + if cond: + var obj = t.firstParamType.skipTypes({tyVar}) + while true: + incl(obj.flags, tfHasAsgn) + 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: + 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: + 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, sfUsed) + 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.sons[1].skipTypes(abstractInst).kind in {tyRef, tyPtr} and - sameType(s.typ.sons[1], s.typ.sons[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.sons[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.sons[0] + if t.kind == tyGenericBody: t = t.typeBodyImpl + elif t.kind == tyGenericInvocation: t = t.genericHead else: break - if t.kind in {tyObject, tyDistinct, tyEnum}: - if t.deepCopy.isNil: t.deepCopy = s + if t.kind in {tyObject, tyDistinct, tyEnum, tySequence, tyString}: + if getAttachedOp(c.graph, t, attachedDeepCopy).isNil: + setAttachedOp(c.graph, c.module.position, t, attachedDeepCopy, s) else: localError(c.config, n.info, errGenerated, "cannot bind another 'deepCopy' to: " & typeToString(t)) else: localError(c.config, n.info, errGenerated, "cannot bind 'deepCopy' to: " & typeToString(t)) + + if t.owner.getModule != s.getModule: + localError(c.config, n.info, errGenerated, + "type bound operation `" & name & "` can be defined only in the same module with its type (" & t.typeToString() & ")") + else: localError(c.config, n.info, errGenerated, "signature for 'deepCopy' must be proc[T: ptr|ref](x: T): T") incl(s.flags, sfUsed) - of "=", "=sink": + incl(s.flags, sfOverridden) + of "=", "=copy", "=sink": if s.magic == mAsgn: return incl(s.flags, sfUsed) + 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.sons[0] == nil and t.sons[1].kind == tyVar: - var obj = t.sons[1].sons[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.sons[0] + if obj.kind == tyGenericBody: obj = obj.skipModifier + elif obj.kind == tyGenericInvocation: obj = obj.genericHead else: break - var objB = t.sons[2] + 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.sons[0] + objB = objB.genericHead else: break - if obj.kind in {tyObject, tyDistinct} and sameType(obj, objB): - let opr = if s.name.s == "=": addr(obj.assignment) else: addr(obj.sink) - if opr[].isNil: - opr[] = s + if obj.kind in {tyObject, tyDistinct, tySequence, tyString} and sameType(obj, objB): + # attach these ops to the canonical tySequence + obj = canonType(c, obj) + #echo "ATTACHING TO ", obj.id, " ", s.name.s, " ", cast[int](obj) + let k = if name == "=" or name == "=copy": attachedAsgn else: attachedSink + let ao = getAttachedOp(c.graph, obj, k) + if ao == s: + discard "forward declared op" + elif ao.isNil and tfCheckedForDestructor notin obj.flags: + setAttachedOp(c.graph, c.module.position, obj, k, s) else: + prevDestructor(c, ao, obj, n.info) + if obj.owner.getModule != s.getModule: localError(c.config, n.info, errGenerated, - "cannot bind another '" & s.name.s & "' to: " & typeToString(obj)) + "type bound operation `" & name & "` can be defined only in the same module with its type (" & obj.typeToString() & ")") + return if sfSystemModule notin s.owner.flags: localError(c.config, n.info, errGenerated, "signature for '" & s.name.s & "' must be proc[T: object](x: var T; y: T)") + of "=trace": + 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 @@ -1408,70 +2252,123 @@ 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) - -type - TProcCompilationSteps = enum - stepRegisterSymbol, - stepDetermineType, + else: + result = false proc hasObjParam(s: PSym): bool = + result = false var t = s.typ - for col in countup(1, sonsLen(t)-1): - if skipTypes(t.sons[col], skipPtrs).kind == tyObject: + for col in 1..<t.len: + if skipTypes(t[col], skipPtrs).kind == tyObject: return true proc finishMethod(c: PContext, s: PSym) = if hasObjParam(s): - methodDef(c.graph, s, false) + 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 isGenericRoutine(s): + if s.isGenericRoutine: let tt = s.typ var foundObj = false # we start at 1 for now so that tparsecombnum continues to compile. # XXX Revisit this problem later. - for col in countup(1, sonsLen(tt)-1): - let t = tt.sons[col] + for col in 1..<tt.len: + let t = tt[col] if t != nil and t.kind == tyGenericInvocation: - var x = skipTypes(t.sons[0], {tyVar, tyLent, tyPtr, tyRef, tyGenericInst, - tyGenericInvocation, tyGenericBody, - tyAlias, tySink}) - if x.kind == tyObject and t.len-1 == n.sons[genericParamsPos].len: + 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: foundObj = true - x.methods.safeAdd((col,s)) - if not foundObj: - message(c.config, n.info, warnDeprecated, "generic method not attachable to object type") + addMethodToGeneric(c.graph, c.module.position, x, col, s) + message(c.config, n.info, warnDeprecated, "generic methods are deprecated") + #if not foundObj: + # message(c.config, n.info, warnDeprecated, "generic method not attachable to object type is deprecated") else: # why check for the body? bug #2400 has none. Checking for sfForward makes # no sense either. - # and result.sons[bodyPos].kind != nkEmpty: + # and result[bodyPos].kind != nkEmpty: if hasObjParam(s): - methodDef(c.graph, s, fromCache=false) + methodDef(c.graph, c.idgen, s) else: localError(c.config, n.info, "'method' needs a parameter that has an object type") proc semProcAux(c: PContext, n: PNode, kind: TSymKind, - validPragmas: TSpecialWords, - phase = stepRegisterSymbol): PNode = + validPragmas: TSpecialWords, flags: TExprFlags = {}): PNode = result = semProcAnnotation(c, n, validPragmas) if result != nil: return result result = n - checkSonsLen(n, bodyPos + 1, c.config) + checkMinSonsLen(n, bodyPos + 1, c.config) + + let + isAnon = n[namePos].kind == nkEmpty + isHighlight = c.config.ideCmd == ideHighlight + var s: PSym - var typeIsDetermined = false - var isAnon = false - if n[namePos].kind != nkSym: - assert phase == stepRegisterSymbol - - if n[namePos].kind == nkEmpty: - s = newSym(kind, c.cache.idAnon, getCurrOwner(c), n.info) - incl(s.flags, sfUsed) - isAnon = true - else: - s = semIdentDef(c, n.sons[0], kind) - n.sons[namePos] = newSymNode(s) - s.ast = n - #s.scope = c.currentScope + + case n[namePos].kind + of nkEmpty: + 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: + # 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 if sfNoForward in c.module.flags and @@ -1479,191 +2376,270 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, addInterfaceOverloadableSymAt(c, c.currentScope, s) s.flags.incl sfForward return - else: - s = n[namePos].sym - s.owner = getCurrOwner(c) - typeIsDetermined = s.typ == nil - s.ast = n - #s.scope = c.currentScope + assert s.kind in skProcKinds + + 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 body, set as current the scope + # before compiling the proc params & body, set as current the scope # where the proc was declared - let oldScope = c.currentScope - #c.currentScope = s.scope + let declarationScope = c.currentScope pushOwner(c, s) openScope(c) - var gp: PNode - if n.sons[genericParamsPos].kind != nkEmpty: - gp = setGenericParamsMisc(c, n) - else: - gp = newNodeI(nkGenericParams, n.info) + # process parameters: - if n.sons[paramsPos].kind != nkEmpty: - semParamList(c, n.sons[paramsPos], gp, s) - if sonsLen(gp) > 0: - if n.sons[genericParamsPos].kind == nkEmpty: - # we have a list of implicit type parameters: - n.sons[genericParamsPos] = gp - # check for semantics again: - # semParamList(c, n.sons[ParamsPos], nil, s) + # generic parameters, parameters, and also the implicit generic parameters + # within are analysed. This is often the entirety of their semantic analysis + # but later we will have to do a check for forward declarations, which can by + # way of pragmas, default params, and so on invalidate this parsing. + # Nonetheless, we need to carry out this analysis to perform the search for a + # potential forward declaration. + setGenericParamsMisc(c, n) + + if n[paramsPos].kind != nkEmpty: + semParamList(c, n[paramsPos], n[genericParamsPos], s) else: s.typ = newProcType(c, n.info) + + if n[genericParamsPos].safeLen == 0: + # if there exist no explicit or implicit generic parameters, then this is + # at most a nullary generic (generic with no type params). Regardless of + # whether it's a nullary generic or non-generic, we restore the original. + # In the case of `nkEmpty` it's non-generic and an empty `nkGeneircParams` + # is a nullary generic. + # + # Remarks about nullary generics vs non-generics: + # The difference between a non-generic and nullary generic is minor in + # most cases but there are subtle and significant differences as well. + # Due to instantiation that generic procs go through, a static echo in the + # body of a nullary generic will not be executed immediately, as it's + # instantiated and not immediately evaluated. + n[genericParamsPos] = n[miscPos][1] + n[miscPos] = c.graph.emptyNode + if tfTriggersCompileTime in s.typ.flags: incl(s.flags, sfCompileTime) - if n.sons[patternPos].kind != nkEmpty: - n.sons[patternPos] = semPattern(c, n.sons[patternPos]) + if n[patternPos].kind != nkEmpty: + n[patternPos] = semPattern(c, n[patternPos], s) if s.kind == skIterator: s.typ.flags.incl(tfIterator) elif s.kind == skFunc: incl(s.flags, sfNoSideEffect) incl(s.typ.flags, tfNoSideEffect) - var proto = searchForProc(c, oldScope, s) - if proto == nil or isAnon: - if s.kind == skIterator: - if s.typ.callConv != ccClosure: - s.typ.callConv = if isAnon: ccClosure else: ccInline - else: + + var (proto, comesFromShadowScope) = + if isAnon: (nil, false) + 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 + + # set the default calling conventions + case s.kind + of skIterator: + if s.typ.callConv != ccClosure: + s.typ.callConv = if isAnon: ccClosure else: ccInline + of skMacro, skTemplate: + # we don't bother setting calling conventions for macros and templates + discard + else: + # NB: procs with a forward decl have theirs determined by the forward decl + if not hasProto: + # in this case we're either a forward declaration or we're an impl without + # a forward decl. We set the calling convention or will be set during + # pragma analysis further down. s.typ.callConv = lastOptionEntry(c).defaultCC - # add it here, so that recursive procs are possible: - if sfGenSym in s.flags: discard - elif kind in OverloadableSyms: - if not typeIsDetermined: - addInterfaceOverloadableSymAt(c, oldScope, s) - else: - if not typeIsDetermined: - addInterfaceDeclAt(c, oldScope, s) - if n.sons[pragmasPos].kind != nkEmpty: - pragma(c, s, n.sons[pragmasPos], validPragmas) + + if not hasProto and sfGenSym notin s.flags: #and not isAnon: + if s.kind in OverloadableSyms: + addInterfaceOverloadableSymAt(c, declarationScope, s) else: - implicitPragmas(c, s, n, validPragmas) + 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 + # list. + # XXX This needs more checks eventually, for example that external + # linking names do agree: + if hasProto and ( + # calling convention mismatch + tfExplicitCallConv in s.typ.flags and proto.typ.callConv != s.typ.callConv or + # implementation has additional pragmas + proto.typ.flags < s.typ.flags): + localError(c.config, n[pragmasPos].info, errPragmaOnlyInHeaderOfProcX % + ("'" & proto.name.s & "' from " & c.config$proto.info & + " '" & s.name.s & "' from " & c.config$s.info)) + + styleCheckDef(c, s) + if hasProto: + onDefResolveForward(n[namePos].info, proto) else: - if n.sons[pragmasPos].kind != nkEmpty: - pragma(c, s, n.sons[pragmasPos], validPragmas) - # To ease macro generation that produce forwarded .async procs we now - # allow a bit redudancy in the pragma declarations. The rule is - # a prototype's pragma list must be a superset of the current pragma - # list. - # XXX This needs more checks eventually, for example that external - # linking names do agree: - if proto.typ.callConv != s.typ.callConv or proto.typ.flags < s.typ.flags: - localError(c.config, n.sons[pragmasPos].info, errPragmaOnlyInHeaderOfProcX % - ("'" & proto.name.s & "' from " & c.config$proto.info)) - if sfForward notin proto.flags: - wrongRedefinition(c, n.info, proto.name.s) - excl(proto.flags, sfForward) + onDef(n[namePos].info, s) + + if hasProto: + if sfForward notin proto.flags and proto.magic == mNone: + wrongRedefinition(c, n.info, proto.name.s, proto.info) + if not comesFromShadowScope: + excl(proto.flags, sfForward) + incl(proto.flags, sfWasForwarded) + suggestSym(c.graph, s.info, proto, c.graph.usageSym) closeScope(c) # close scope with wrong parameter symbols openScope(c) # open scope for old (correct) parameter symbols - if proto.ast.sons[genericParamsPos].kind != nkEmpty: - addGenericParamListToScope(c, proto.ast.sons[genericParamsPos]) + if proto.ast[genericParamsPos].isGenericParams: + addGenericParamListToScope(c, proto.ast[genericParamsPos]) addParams(c, proto.typ.n, proto.kind) proto.info = s.info # more accurate line information - s.typ = proto.typ proto.options = s.options s = proto - n.sons[genericParamsPos] = proto.ast.sons[genericParamsPos] - n.sons[paramsPos] = proto.ast.sons[paramsPos] - n.sons[pragmasPos] = proto.ast.sons[pragmasPos] - if n.sons[namePos].kind != nkSym: internalError(c.config, n.info, "semProcAux") - n.sons[namePos].sym = proto - if importantComments(c.config) and not isNil(proto.ast.comment): + n[genericParamsPos] = proto.ast[genericParamsPos] + n[paramsPos] = proto.ast[paramsPos] + n[pragmasPos] = proto.ast[pragmasPos] + if n[namePos].kind != nkSym: internalError(c.config, n.info, "semProcAux") + n[namePos].sym = proto + if importantComments(c.config) and proto.ast.comment.len > 0: n.comment = proto.ast.comment proto.ast = n # needed for code generation popOwner(c) pushOwner(c, s) - if sfOverriden in s.flags or s.name.s[0] == '=': semOverride(c, s, n) - if s.name.s[0] in {'.', '('}: - if s.name.s in [".", ".()", ".="] and {destructor, dotOperators} * c.features == {}: - localError(c.config, n.info, "the overloaded " & s.name.s & - " operator has to be enabled with {.experimental: \"dotOperators\".}") - elif s.name.s == "()" and callOperator notin c.features: - localError(c.config, n.info, "the overloaded " & s.name.s & - " operator has to be enabled with {.experimental: \"callOperator\".}") - - if n.sons[bodyPos].kind != nkEmpty: - # for DLL generation it is annoying to check for sfImportc! - if sfBorrow in s.flags: - localError(c.config, n.sons[bodyPos].info, errImplOfXNotAllowed % s.name.s) - let usePseudoGenerics = kind in {skMacro, skTemplate} - # Macros and Templates can have generic parameters, but they are - # only used for overload resolution (there is no instantiation of - # the symbol, so we must process the body now) - if not usePseudoGenerics and c.config.ideCmd in {ideSug, ideCon} and not - cursorInProc(c.config, n.sons[bodyPos]): - discard "speed up nimsuggest" + if not isAnon: + 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 & + " operator has to be enabled with {.experimental: \"dotOperators\".}") + elif s.name.s == "()" and callOperator notin c.features: + localError(c.config, n.info, "the overloaded " & s.name.s & + " operator has to be enabled with {.experimental: \"callOperator\".}") + + 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 c.config.ideCmd in {ideSug, ideCon} and s.kind notin {skMacro, skTemplate} and not + cursorInProc(c.config, n[bodyPos]): + # speed up nimsuggest if s.kind == skMethod: semMethodPrototype(c, s, n) + elif isAnon: + let gp = n[genericParamsPos] + if gp.kind == nkEmpty or (gp.len == 1 and tfRetType in gp[0].typ.flags): + # 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.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: + localError(c.config, n.info, errGenericLambdaNotAllowed) else: pushProcCon(c, s) - if n.sons[genericParamsPos].kind == nkEmpty or usePseudoGenerics: - if not usePseudoGenerics: paramsTypeCheck(c, s.typ) - - c.p.wasForwarded = proto != nil + if n[genericParamsPos].kind == nkEmpty or s.kind in {skMacro, skTemplate}: + # 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) - if s.kind == skMethod: semMethodPrototype(c, s, n) - - if lfDynamicLib notin s.loc.flags: - # no semantic checking for importc: - let semBody = hloBody(c, semProcBody(c, n.sons[bodyPos])) - # unfortunately we cannot skip this step when in 'system.compiles' - # context as it may even be evaluated in 'system.compiles': - n.sons[bodyPos] = transformBody(c.graph, c.module, semBody, s) + 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], 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.sons[0] != nil and kind != skIterator: - addDecl(c, newSym(skUnknown, getIdent(c.cache, "result"), 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.sons[bodyPos] = semGenericStmt(c, n.sons[bodyPos]) + n[bodyPos] = semGenericStmt(c, n[bodyPos]) closeScope(c) - fixupInstantiatedSymbols(c, s) - if s.kind == skMethod: semMethodPrototype(c, s, n) - if sfImportc in s.flags: - # so we just ignore the body after semantic checking for importc: - n.sons[bodyPos] = c.graph.emptyNode + if s.magic == mNone: + fixupInstantiatedSymbols(c, s) + if s.kind == skMethod: semMethodPrototype(c, s, n) popProcCon(c) else: if s.kind == skMethod: semMethodPrototype(c, s, n) - if proto != nil: localError(c.config, n.info, errImplOfXexpected % proto.name.s) - if {sfImportc, sfBorrow} * s.flags == {} and s.magic == mNone: + 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.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) - if n.sons[patternPos].kind != nkEmpty: + if n[patternPos].kind != nkEmpty: c.patterns.add(s) if isAnon: - n.kind = nkLambda + n.transitionSonsKind(nkLambda) result.typ = s.typ - if isTopLevel(c) and s.kind != skIterator and - s.typ.callConv == ccClosure: + if optOwnedRefs in c.config.globalOptions: + result.typ = makeVarType(c, result.typ, tyOwned) + elif isTopLevel(c) and s.kind != skIterator and s.typ.callConv == ccClosure: localError(c.config, s.info, "'.closure' calling convention for top level routines is invalid") + # 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 #if s.ast.isNil: return - discard semProcAux(c, s.ast, s.kind, {}, stepDetermineType) + discard semProcAux(c, s.ast, s.kind, {}) proc semIterator(c: PContext, n: PNode): PNode = # gensym'ed iterator? - let isAnon = n[namePos].kind == nkEmpty if n[namePos].kind == nkSym: # gensym'ed iterators might need to become closure iterators: n[namePos].sym.owner = getCurrOwner(c) - n[namePos].sym.kind = skIterator + n[namePos].sym.transitionRoutineSymKind(skIterator) result = semProcAux(c, n, skIterator, iteratorPragmas) # bug #7093: if after a macro transformation we don't have an # nkIteratorDef aynmore, return. The iterator then might have been # sem'checked already. (Or not, if the macro skips it.) if result.kind != n.kind: return - var s = result.sons[namePos].sym + var s = result[namePos].sym var t = s.typ - if t.sons[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") - if isAnon and s.typ.callConv == ccInline: - localError(c.config, n.info, "inline iterators are not first-class / cannot be assigned to variables") # iterators are either 'inline' or 'closure'; for backwards compatibility, # we require first class iterators to be marked with 'closure' explicitly # -- at least for 0.9.2. @@ -1671,14 +2647,19 @@ proc semIterator(c: PContext, n: PNode): PNode = incl(s.typ.flags, tfCapturesEnv) else: s.typ.callConv = ccInline - if n.sons[bodyPos].kind == nkEmpty and s.magic == mNone: + if n[bodyPos].kind == nkEmpty and s.magic == mNone and c.inConceptDecl == 0: localError(c.config, n.info, errImplOfXexpected % s.name.s) + if optOwnedRefs in c.config.globalOptions and result.typ != nil: + result.typ = makeVarType(c, result.typ, tyOwned) + result.typ.callConv = ccClosure proc semProc(c: PContext, n: PNode): PNode = result = semProcAux(c, n, skProc, procPragmas) proc semFunc(c: PContext, n: PNode): PNode = - result = semProcAux(c, n, skFunc, procPragmas) + let validPragmas = if n[namePos].kind != nkEmpty: procPragmas + else: lambdaPragmas + result = semProcAux(c, n, skFunc, validPragmas) proc semMethod(c: PContext, n: PNode): PNode = if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "method") @@ -1689,21 +2670,20 @@ proc semMethod(c: PContext, n: PNode): PNode = # nkIteratorDef aynmore, return. The iterator then might have been # sem'checked already. (Or not, if the macro skips it.) if result.kind != nkMethodDef: return - var s = result.sons[namePos].sym + var s = result[namePos].sym # we need to fix the 'auto' return type for the dispatcher here (see tautonotgeneric # test case): let disp = getDispatcher(s) # auto return type? - if disp != nil and disp.typ.sons[0] != nil and disp.typ.sons[0].kind == tyExpr: - let ret = s.typ.sons[0] - disp.typ.sons[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.sons[resultPos] = c.graph.emptyNode + 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 @@ -1711,14 +2691,13 @@ proc semConverterDef(c: PContext, n: PNode): PNode = # nkIteratorDef aynmore, return. The iterator then might have been # sem'checked already. (Or not, if the macro skips it.) if result.kind != nkConverterDef: return - var s = result.sons[namePos].sym + var s = result[namePos].sym var t = s.typ - if t.sons[0] == nil: localError(c.config, n.info, errXNeedsReturnType % "converter") - if sonsLen(t) != 2: localError(c.config, n.info, "a converter takes exactly one argument") - addConverter(c, s) + if t.returnType == nil: localError(c.config, n.info, errXNeedsReturnType % "converter") + if t.len != 2: localError(c.config, n.info, "a converter takes exactly one argument") + addConverterDef(c, LazySym(sym: s)) 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 @@ -1726,62 +2705,105 @@ proc semMacroDef(c: PContext, n: PNode): PNode = # nkIteratorDef aynmore, return. The iterator then might have been # sem'checked already. (Or not, if the macro skips it.) if result.kind != nkMacroDef: return - var s = result.sons[namePos].sym + var s = result[namePos].sym var t = s.typ var allUntyped = true - for i in 1 .. t.n.len-1: - let param = t.n.sons[i].sym - if param.typ.kind != tyExpr: allUntyped = false + 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 t.sons[0] == nil: localError(c.config, n.info, "macro needs a return type") - if n.sons[bodyPos].kind == nkEmpty: + 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) +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: + includeStmtResult.add semStmt(c, c.graph.includeFileCallback(c.graph, c.module, f), {}) + excl(c.includedFiles, f.int) + proc evalInclude(c: PContext, n: PNode): PNode = result = newNodeI(nkStmtList, n.info) - addSon(result, n) - for i in countup(0, sonsLen(n) - 1): - var f = checkModuleName(c.config, n.sons[i]) - if f != InvalidFileIDX: - if containsOrIncl(c.includedFiles, f.int): - localError(c.config, n.info, errRecursiveDependencyX % toFilename(c.config, f)) + 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: + let it = n[i] + 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 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; expectedType: PType = nil): PNode = + checkSonsLen(n, 2, c.config) + let pragmaList = n[0] + pragma(c, nil, pragmaList, exprPragmas, isStatement = true) + + 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: - addSon(result, semStmt(c, c.graph.includeFileCallback(c.graph, c.module, f))) - excl(c.includedFiles, f.int) - -proc setLine(n: PNode, info: TLineInfo) = - for i in 0 ..< safeLen(n): setLine(n.sons[i], info) - n.info = info - -proc semPragmaBlock(c: PContext, n: PNode): PNode = - let pragmaList = n.sons[0] - pragma(c, nil, pragmaList, exprPragmas) - result = semExpr(c, n.sons[1]) - n.sons[1] = result - for i in 0 ..< pragmaList.len: - case whichPragma(pragmaList.sons[i]) - of wLine: setLine(result, pragmaList.sons[i].info) - of wLocks, wGcSafe: - result = n - result.typ = n.sons[1].typ - of wNoRewrite: - incl(result.flags, nfNoRewrite) + 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: setInfoRecursive(result, pragmaList[i].info) + of wNoRewrite: recursiveSetFlag(result, nfNoRewrite) else: discard proc semStaticStmt(c: PContext, n: PNode): PNode = #echo "semStaticStmt" #writeStackTrace() inc c.inStaticContext - let a = semStmt(c, n.sons[0]) + openScope(c) + let a = semStmt(c, n[0], {}) + closeScope(c) dec c.inStaticContext - n.sons[0] = a - evalStaticStmt(c.module, c.graph, a, c.p.owner) + n[0] = a + evalStaticStmt(c.module, c.idgen, c.graph, a, c.p.owner) when false: # for incremental replays, keep the AST as required for replays: result = n else: result = newNodeI(nkDiscardStmt, n.info, 1) - result.sons[0] = c.graph.emptyNode + result[0] = c.graph.emptyNode proc usesResult(n: PNode): bool = # nkStmtList(expr) properly propagates the void context, @@ -1793,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 @@ -1802,67 +2827,62 @@ 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 = - # these must be last statements in a block: - const - LastBlockStmts = {nkRaiseStmt, nkReturnStmt, nkBreakStmt, nkContinueStmt} +proc semStmtList(c: PContext, n: PNode, flags: TExprFlags, expectedType: PType = nil): PNode = result = n - result.kind = nkStmtList - var length = sonsLen(n) + result.transitionSonsKind(nkStmtList) var voidContext = false - var last = length-1 + var last = n.len-1 # by not allowing for nkCommentStmt etc. we ensure nkStmtListExpr actually # really *ends* in the expression that produces the type: The compiler now # relies on this fact and it's too much effort to change that. And arguably # 'R(); #comment' shouldn't produce R's type anyway. - #while last > 0 and n.sons[last].kind in {nkPragma, nkCommentStmt, + #while last > 0 and n[last].kind in {nkPragma, nkCommentStmt, # nkNilLit, nkEmpty}: # dec last - for i in countup(0, length - 1): - var expr = semExpr(c, n.sons[i], flags) - n.sons[i] = expr - if c.matchedConcept != nil and expr.typ != nil and + for i in 0..<n.len: + 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.intVal == 0: + 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.sons[i].typ == c.enforceVoidContext: #or usesResult(n.sons[i]): + if n[i].typ == c.enforceVoidContext: #or usesResult(n[i]): voidContext = true n.typ = c.enforceVoidContext - if i == last and (length == 1 or efWantValue in flags): - n.typ = n.sons[i].typ - if not isEmptyType(n.typ): n.kind = nkStmtListExpr + if i == last and (n.len == 1 or ({efWantValue, efInTypeof} * flags != {})): + n.typ = n[i].typ + if not isEmptyType(n.typ): n.transitionSonsKind(nkStmtListExpr) elif i != last or voidContext: - discardCheck(c, n.sons[i]) + discardCheck(c, n[i], flags) else: - n.typ = n.sons[i].typ - if not isEmptyType(n.typ): n.kind = nkStmtListExpr - if n.sons[i].kind in LastBlockStmts or - n.sons[i].kind in nkCallKinds and n.sons[i][0].kind == nkSym and - sfNoReturn in n.sons[i][0].sym.flags: - for j in countup(i + 1, length - 1): - case n.sons[j].kind - of nkPragma, nkCommentStmt, nkNilLit, nkEmpty, nkBlockExpr, - nkBlockStmt, nkState: discard - else: localError(c.config, n.sons[j].info, "unreachable statement after 'return'") + n.typ = n[i].typ + if not isEmptyType(n.typ): n.transitionSonsKind(nkStmtListExpr) + 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 + else: message(c.config, n[j].info, warnUnreachableCode) else: discard if result.len == 1 and @@ -1871,15 +2891,11 @@ proc semStmtList(c: PContext, n: PNode, flags: TExprFlags): PNode = # also, don't make life complicated for macros. # they will always expect a proper stmtlist: nfBlockArg notin n.flags and - result.sons[0].kind != nkDefer: - result = result.sons[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): PNode = - # now: simply an alias: - result = semExprNoType(c, n) + result[0].kind != nkDefer: + result = result[0] + +proc semStmt(c: PContext, n: PNode; flags: TExprFlags): PNode = + if efInTypeof notin flags: + result = semExprNoType(c, n) + else: + result = semExpr(c, n, flags) 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 75c6bc4bb..817cb6249 100644 --- a/compiler/semtempl.nim +++ b/compiler/semtempl.nim @@ -34,9 +34,10 @@ type spNone, spGenSym, spInject proc symBinding(n: PNode): TSymBinding = - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - var key = if it.kind == nkExprColonExpr: it.sons[0] else: it + result = spNone + for i in 0..<n.len: + var it = n[i] + var key = if it.kind == nkExprColonExpr: it[0] else: it if key.kind == nkIdent: case whichKeyword(key.ident) of wGensym: return spGenSym @@ -47,10 +48,11 @@ type TSymChoiceRule = enum scClosed, scOpen, scForceOpen -proc symChoice(c: PContext, n: PNode, s: PSym, r: TSymChoiceRule): PNode = +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: @@ -58,28 +60,39 @@ proc symChoice(c: PContext, n: PNode, s: PSym, r: TSymChoiceRule): PNode = inc(i) if i > 1: break a = nextOverloadIter(o, c, n) + let info = getCallLineInfo(n) if i <= 1 and r != scForceOpen: # XXX this makes more sense but breaks bootstrapping for now: # (s.kind notin routineKinds or s.magic != mNone): # for instance 'nextTry' is both in tables.nim and astalgo.nim ... - result = newSymNode(s, n.info) - markUsed(c.config, n.info, s, c.graph.usageSym) + if not isField or sfGenSym notin s.flags: + result = newSymNode(s, info) + markUsed(c, info, s) + 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 let kind = if r == scClosed or n.kind == nkDotExpr: nkClosedSymChoice else: nkOpenSymChoice - result = newNodeIT(kind, n.info, newTypeS(tyNone, c)) + result = newNodeIT(kind, info, newTypeS(tyNone, c)) a = initOverloadIter(o, c, n) while a != nil: - if a.kind != skModule: + if a.kind != skModule and (not isField or sfGenSym notin a.flags): incl(a.flags, sfUsed) - addSon(result, newSymNode(a, n.info)) + markOwnerModuleAsUsed(c, a) + result.add newSymNode(a, info) + onUse(info, a) a = nextOverloadIter(o, c, n) proc semBindStmt(c: PContext, n: PNode, toBind: var IntSet): PNode = - for i in 0 ..< n.len: - var a = n.sons[i] + result = copyNode(n) + for i in 0..<n.len: + var a = n[i] # If 'a' is an overloaded symbol, we used to use the first symbol # as a 'witness' and use the fact that subsequent lookups will yield # the same symbol! @@ -91,21 +104,25 @@ proc semBindStmt(c: PContext, n: PNode, toBind: var IntSet): PNode = let sc = symChoice(c, n, s, scClosed) if sc.kind == nkSym: toBind.incl(sc.sym.id) + result.add sc else: - for x in items(sc): toBind.incl(x.sym.id) + for x in items(sc): + toBind.incl(x.sym.id) + result.add x else: illFormedAst(a, c.config) - result = newNodeI(nkEmpty, n.info) proc semMixinStmt(c: PContext, n: PNode, toMixin: var IntSet): PNode = - for i in 0 ..< n.len: - toMixin.incl(considerQuotedIdent(c, n.sons[i]).id) - result = newNodeI(nkEmpty, n.info) + result = copyNode(n) + for i in 0..<n.len: + toMixin.incl(considerQuotedIdent(c, n[i]).id) + let x = symChoice(c, n[i], nil, scForceOpen) + result.add x proc replaceIdentBySym(c: PContext; n: var PNode, s: PNode) = case n.kind - of nkPostfix: replaceIdentBySym(c, n.sons[1], s) - of nkPragmaExpr: replaceIdentBySym(c, n.sons[0], s) + of nkPostfix: replaceIdentBySym(c, n[1], s) + of nkPragmaExpr: replaceIdentBySym(c, n[0], s) of nkIdent, nkAccQuoted, nkSym: n = s else: illFormedAst(n, c.config) @@ -116,28 +133,35 @@ type owner: PSym cursorInBody: bool # only for nimsuggest scopeN: int + 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.sons[1]) - of nkPragmaExpr: result = getIdentNode(c, n.sons[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 sfGenSym notin n.sym.flags + result = (n, false) proc semTemplBody(c: var TemplCtx, n: PNode): PNode @@ -152,156 +176,201 @@ 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) - styleCheckUse(n.info, s) - else: - for i in 0 ..< n.safeLen: - result.sons[i] = onlyReplaceParams(c, n.sons[i]) - proc newGenSym(kind: TSymKind, n: PNode, c: var TemplCtx): PSym = - result = newSym(kind, considerQuotedIdent(c.c, n), 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.sons[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: - let ident = getIdentNode(c, n) - if not isTemplParam(c, ident): - # fix #2670, consider: - # - # when b: - # var a = "hi" - # else: - # var a = 5 - # echo a - # - # We need to ensure that both 'a' produce the same gensym'ed symbol. - # So we need only check the *current* scope. - let s = localSearchInScope(c.c, considerQuotedIdent(c.c, ident)) - if s != nil and s.owner == c.owner and sfGenSym in s.flags: - styleCheckUse(n.info, s) - replaceIdentBySym(c.c, n, newSymNode(s, n.info)) - else: + if (n.kind == nkPragmaExpr and n.len >= 2 and n[1].kind == nkPragma): + let pragmaNode = n[1] + for i in 0..<pragmaNode.len: + 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)) - else: - replaceIdentBySym(c.c, n, ident) + if k == skParam and c.inTemplateHeader > 0: + local.flags.incl sfTemplateParam -proc semTemplSymbol(c: PContext, n: PNode, s: PSym): PNode = +proc semTemplSymbol(c: var TemplCtx, n: PNode, s: PSym; isField, isAmbiguous: bool): PNode = incl(s.flags, sfUsed) - # we do not call styleCheckUse here, as the identifier is not really + # 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.c, s) + # we do not call onUse here, as the identifier is not really # resolved here. We will fixup the used identifiers later. case s.kind of skUnknown: # Introduced in this pass! Leave it as an identifier. result = n of OverloadableSyms: - result = symChoice(c, n, s, scOpen) + 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: - result = newSymNodeTypeDesc(s, n.info) + if isField and sfGenSym in s.flags: result = n + 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: - result = newSymNodeTypeDesc(s, n.info) + if isField and sfGenSym in s.flags: result = n + 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: - result = newSymNode(s, n.info) + if isField and sfGenSym in s.flags: result = n + 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.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) - styleCheckUse(n.info, s) + onUse(n.info, s) else: - for i in countup(0, safeLen(n) - 1): - result.sons[i] = semRoutineInTemplName(c, n.sons[i]) + for i in 0..<n.safeLen: + 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.sons[pragmasPos]) == spGenSym: - let ident = getIdentNode(c, n.sons[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) - n.sons[namePos] = newSymNode(s, n.sons[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.sons[namePos] = ident - else: - n.sons[namePos] = semRoutineInTemplName(c, n.sons[namePos]) + n[namePos] = semRoutineInTemplName(c, n[namePos], binding == spInject) # open scope for parameters openScope(c) - for i in patternPos..miscPos: - n.sons[i] = semTemplBody(c, n.sons[i]) + for i in patternPos..paramsPos-1: + n[i] = semTemplBody(c, n[i]) + + if k == skTemplate: inc(c.inTemplateHeader) + n[paramsPos] = semTemplBody(c, n[paramsPos]) + if k == skTemplate: dec(c.inTemplateHeader) + + for i in paramsPos+1..miscPos: + n[i] = semTemplBody(c, n[i]) # open scope for locals inc c.scopeN openScope(c) - n.sons[bodyPos] = semTemplBody(c, n.sons[bodyPos]) + n[bodyPos] = semTemplBody(c, n[bodyPos]) # close scope for locals closeScope(c) dec c.scopeN # close scope for parameters closeScope(c) -proc semTemplSomeDecl(c: var TemplCtx, n: PNode, symKind: TSymKind; start=0) = - for i in countup(start, sonsLen(n) - 1): - var a = n.sons[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) - var L = sonsLen(a) - when defined(nimsuggest): - inc c.c.inTypeContext - a.sons[L-2] = semTemplBody(c, a.sons[L-2]) - when defined(nimsuggest): - dec c.c.inTypeContext - a.sons[L-1] = semTemplBody(c, a.sons[L-1]) - for j in countup(0, L-3): - addLocalDecl(c, a.sons[j], symKind) +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] + 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 - for i in 0 ..< n.len: - result.sons[i] = semTemplBody(c, n.sons[i]) + for i in 0..<n.len: + result[i] = semTemplBody(c, n[i]) proc semTemplBody(c: var TemplCtx, n: PNode): PNode = result = n @@ -309,26 +378,29 @@ 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: + if s.owner == c.owner and s.kind == skParam and sfTemplateParam in s.flags: incl(s.flags, sfUsed) result = newSymNode(s, n.info) - styleCheckUse(n.info, s) + onUse(n.info, s) elif contains(c.toBind, s.id): - result = symChoice(c.c, n, s, scClosed) + result = symChoice(c.c, n, s, scClosed, c.noGenSym > 0) elif contains(c.toMixin, s.name.id): - result = symChoice(c.c, n, s, scForceOpen) - elif s.owner == c.owner and sfGenSym in s.flags: + result = symChoice(c.c, n, s, scForceOpen, c.noGenSym > 0) + elif s.owner == c.owner and sfGenSym in s.flags and c.noGenSym == 0: # template tmp[T](x: var seq[T]) = # var yz: T incl(s.flags, sfUsed) result = newSymNode(s, n.info) - styleCheckUse(n.info, s) + onUse(n.info, s) else: - result = semTemplSymbol(c.c, n, s) + 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.sons[0]) + result = semTemplBody(c, n[0]) of nkBindStmt: result = semBindStmt(c.c, n, c.toBind) of nkMixinStmt: @@ -337,105 +409,117 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = of nkEmpty, nkSym..nkNilLit, nkComesFrom: discard of nkIfStmt: - for i in countup(0, sonsLen(n)-1): - var it = n.sons[i] + for i in 0..<n.len: + var it = n[i] if it.len == 2: - when newScopeForIf: openScope(c) - it.sons[0] = semTemplBody(c, it.sons[0]) - when not newScopeForIf: openScope(c) - it.sons[1] = semTemplBody(c, it.sons[1]) + openScope(c) + it[0] = semTemplBody(c, it[0]) + it[1] = semTemplBody(c, it[1]) closeScope(c) else: - n.sons[i] = semTemplBodyScope(c, it) + n[i] = semTemplBodyScope(c, it) of nkWhileStmt: openScope(c) - for i in countup(0, sonsLen(n)-1): - n.sons[i] = semTemplBody(c, n.sons[i]) + for i in 0..<n.len: + n[i] = semTemplBody(c, n[i]) closeScope(c) of nkCaseStmt: openScope(c) - n.sons[0] = semTemplBody(c, n.sons[0]) - for i in countup(1, sonsLen(n)-1): - var a = n.sons[i] + n[0] = semTemplBody(c, n[0]) + for i in 1..<n.len: + var a = n[i] checkMinSonsLen(a, 1, c.c.config) - var L = sonsLen(a) - for j in countup(0, L-2): - a.sons[j] = semTemplBody(c, a.sons[j]) - a.sons[L-1] = semTemplBodyScope(c, a.sons[L-1]) + for j in 0..<a.len-1: + a[j] = semTemplBody(c, a[j]) + a[^1] = semTemplBodyScope(c, a[^1]) closeScope(c) of nkForStmt, nkParForStmt: - var L = sonsLen(n) openScope(c) - n.sons[L-2] = semTemplBody(c, n.sons[L-2]) - for i in countup(0, L - 3): - addLocalDecl(c, n.sons[i], skForVar) + n[^2] = semTemplBody(c, n[^2]) + for i in 0..<n.len - 2: + if n[i].kind == nkVarTuple: + for j in 0..<n[i].len-1: + addLocalDecl(c, n[i][j], skForVar) + else: + addLocalDecl(c, n[i], skForVar) openScope(c) - n.sons[L-1] = semTemplBody(c, n.sons[L-1]) + n[^1] = semTemplBody(c, n[^1]) closeScope(c) closeScope(c) of nkBlockStmt, nkBlockExpr, nkBlockType: checkSonsLen(n, 2, c.c.config) openScope(c) - if n.sons[0].kind != nkEmpty: - addLocalDecl(c, n.sons[0], skLabel) + if n[0].kind != nkEmpty: + addLocalDecl(c, n[0], skLabel) when false: # labels are always 'gensym'ed: - let s = newGenSym(skLabel, n.sons[0], c) + let s = newGenSym(skLabel, n[0], c) addPrelimDecl(c.c, s) - styleCheckDef(c.c.config, s) - n.sons[0] = newSymNode(s, n.sons[0].info) - n.sons[1] = semTemplBody(c, n.sons[1]) + styleCheckDef(c.c, s) + onDef(n[0].info, s) + n[0] = newSymNode(s, n[0].info) + n[1] = semTemplBody(c, n[1]) closeScope(c) - of nkTryStmt: + of nkTryStmt, nkHiddenTryStmt: checkMinSonsLen(n, 2, c.c.config) - n.sons[0] = semTemplBodyScope(c, n.sons[0]) - for i in countup(1, sonsLen(n)-1): - var a = n.sons[i] + n[0] = semTemplBodyScope(c, n[0]) + for i in 1..<n.len: + var a = n[i] checkMinSonsLen(a, 1, c.c.config) - var L = sonsLen(a) openScope(c) - for j in countup(0, L-2): - if a.sons[j].isInfixAs(): - addLocalDecl(c, a.sons[j].sons[2], skLet) - a.sons[j].sons[1] = semTemplBody(c, a.sons[j][1]) + for j in 0..<a.len-1: + if a[j].isInfixAs(): + addLocalDecl(c, a[j][2], skLet) + a[j][1] = semTemplBody(c, a[j][1]) else: - a.sons[j] = semTemplBody(c, a.sons[j]) - a.sons[L-1] = semTemplBodyScope(c, a.sons[L-1]) + a[j] = semTemplBody(c, a[j]) + a[^1] = semTemplBodyScope(c, a[^1]) closeScope(c) of nkVarSection: semTemplSomeDecl(c, n, skVar) of nkLetSection: semTemplSomeDecl(c, n, skLet) of nkFormalParams: checkMinSonsLen(n, 1, c.c.config) - n.sons[0] = semTemplBody(c, n.sons[0]) semTemplSomeDecl(c, n, skParam, 1) - of nkConstSection: - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if (a.kind != nkConstDef): illFormedAst(a, c.c.config) - checkSonsLen(a, 3, c.c.config) - addLocalDecl(c, a.sons[0], skConst) - a.sons[1] = semTemplBody(c, a.sons[1]) - a.sons[2] = semTemplBody(c, a.sons[2]) + n[0] = semTemplBody(c, n[0]) + of nkConstSection: semTemplSomeDecl(c, n, skConst) of nkTypeSection: - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] + for i in 0..<n.len: + var a = n[i] if a.kind == nkCommentStmt: continue if (a.kind != nkTypeDef): illFormedAst(a, c.c.config) checkSonsLen(a, 3, c.c.config) - addLocalDecl(c, a.sons[0], skType) - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] + addLocalDecl(c, a[0], skType) + for i in 0..<n.len: + var a = n[i] if a.kind == nkCommentStmt: continue if (a.kind != nkTypeDef): illFormedAst(a, c.c.config) checkSonsLen(a, 3, c.c.config) - if a.sons[1].kind != nkEmpty: + if a[1].kind != nkEmpty: openScope(c) - a.sons[1] = semTemplBody(c, a.sons[1]) - a.sons[2] = semTemplBody(c, a.sons[2]) + a[1] = semTemplBody(c, a[1]) + a[2] = semTemplBody(c, a[2]) closeScope(c) else: - a.sons[2] = semTemplBody(c, a.sons[2]) + 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: @@ -451,68 +535,109 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = of nkConverterDef: result = semRoutineInTemplBody(c, n, skConverter) of nkPragmaExpr: - result.sons[0] = semTemplBody(c, n.sons[0]) + result[0] = semTemplBody(c, n[0]) of nkPostfix: - result.sons[1] = semTemplBody(c, n.sons[1]) + result[1] = semTemplBody(c, n[1]) of nkPragma: for x in n: if x.kind == nkExprColonExpr: - x.sons[1] = semTemplBody(c, x.sons[1]) + 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.sons[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.sons[0] - let b = n.sons[1] + let a = n[0] + let b = n[1] 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) - let a0 = semTemplBody(c, a.sons[0]) - withBracketExpr c, a0: - result = semTemplBodySons(c, result) + if a.typ == nil: + # see nkBracketExpr case above for explanation + result = newNodeI(nkCall, n.info) + result.add newIdentNode(getIdent(c.c.cache, "[]="), n.info) + for i in 0..<a.len: result.add(a[i]) + result.add(b) + let a0 = semTemplBody(c, a[0]) + result = semTemplBodySons(c, result) of nkCurlyExpr: - result = newNodeI(nkCall, n.info) - result.add newIdentNode(getIdent(c.c.cache, "{}="), n.info) - for i in 0 ..< a.len: result.add(a[i]) - result.add(b) + if a.typ == nil: + # see nkBracketExpr case above for explanation + result = newNodeI(nkCall, n.info) + result.add newIdentNode(getIdent(c.c.cache, "{}="), n.info) + for i in 0..<a.len: result.add(a[i]) + result.add(b) result = semTemplBodySons(c, result) else: result = semTemplBodySons(c, n) of nkCallKinds-{nkPostfix}: - result = semTemplBodySons(c, n) + # do not transform runnableExamples (bug #9143) + if not isRunnableExamples(n[0]): + result = semTemplBodySons(c, n) 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: incl(s.flags, sfUsed) - styleCheckUse(n.info, s) + onUse(n.info, s) return newSymNode(s, n.info) elif contains(c.toBind, s.id): - return symChoice(c.c, n, s, scClosed) + return symChoice(c.c, n, s, scClosed, c.noGenSym > 0) elif contains(c.toMixin, s.name.id): - return symChoice(c.c, n, s, scForceOpen) + return symChoice(c.c, n, s, scForceOpen, c.noGenSym > 0) else: - return symChoice(c.c, n, s, scOpen) - result = semTemplBodySons(c, n) + 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: + if n.len == 2: + inc c.noGenSym + result[0] = semTemplBody(c, n[0]) + dec c.noGenSym + result[1] = semTemplBody(c, n[1]) + else: + result = semTemplBodySons(c, n) + of nkTableConstr: + # also transform the keys (bug #12595) + for i in 0..<n.len: + result[i] = semTemplBodySons(c, n[i]) else: result = semTemplBodySons(c, n) @@ -528,7 +653,7 @@ proc semTemplBodyDirty(c: var TemplCtx, n: PNode): PNode = elif contains(c.toBind, s.id): result = symChoice(c.c, n, s, scClosed) of nkBind: - result = semTemplBodyDirty(c, n.sons[0]) + result = semTemplBodyDirty(c, n[0]) of nkBindStmt: result = semBindStmt(c.c, n, c.toBind) of nkEmpty, nkSym..nkNilLit, nkComesFrom: @@ -541,87 +666,118 @@ proc semTemplBodyDirty(c: var TemplCtx, n: PNode): PNode = if s != nil and contains(c.toBind, s.id): return symChoice(c.c, n, s, scClosed) result = n - for i in countup(0, sonsLen(n) - 1): - result.sons[i] = semTemplBodyDirty(c, n.sons[i]) + 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): - s = semIdentVis(c, skTemplate, n.sons[0], {sfExported}) + s = semIdentVis(c, skTemplate, n[namePos], {sfExported}) incl(s.flags, sfGlobal) else: - s = semIdentVis(c, skTemplate, n.sons[0], {}) - styleCheckDef(c.config, s) + s = semIdentVis(c, skTemplate, n[namePos], {}) + assert s.kind == skTemplate + + 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.sons[namePos] = newSymNode(s, n.sons[namePos].info) - if n.sons[pragmasPos].kind != nkEmpty: - pragma(c, s, n.sons[pragmasPos], templatePragmas) - - var gp: PNode - if n.sons[genericParamsPos].kind != nkEmpty: - n.sons[genericParamsPos] = semGenericParamList(c, n.sons[genericParamsPos]) - gp = n.sons[genericParamsPos] - else: - gp = newNodeI(nkGenericParams, n.info) + 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 - if n.sons[paramsPos].kind != nkEmpty: - semParamList(c, n.sons[paramsPos], gp, s) + 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: - for i in 1 .. s.typ.n.len-1: - let param = s.typ.n.sons[i].sym - param.flags.excl sfGenSym - if param.typ.kind != tyExpr: allUntyped = false - if sonsLen(gp) > 0: - if n.sons[genericParamsPos].kind == nkEmpty: - # we have a list of implicit type parameters: - n.sons[genericParamsPos] = gp - # no explicit return type? -> use tyStmt - if n.sons[paramsPos].sons[0].kind == nkEmpty: - # use ``stmt`` as implicit result type - s.typ.sons[0] = newTypeS(tyStmt, c) - s.typ.n.sons[0] = newNodeIT(nkType, n.info, s.typ.sons[0]) + 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 + 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 tyStmt as a return type again? + # XXX why do we need tyTyped as a return type again? s.typ.n = newNodeI(nkFormalParams, n.info) - rawAddSon(s.typ, newTypeS(tyStmt, c)) - addSon(s.typ.n, newNodeIT(nkType, n.info, s.typ.sons[0])) + rawAddSon(s.typ, newTypeS(tyTyped, c)) + 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 n.sons[patternPos].kind != nkEmpty: - n.sons[patternPos] = semPattern(c, n.sons[patternPos]) - var ctx: TemplCtx - ctx.toBind = initIntSet() - ctx.toMixin = initIntSet() - ctx.toInject = initIntSet() - ctx.c = c - ctx.owner = s + 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], 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.sons[bodyPos] = semTemplBodyDirty(ctx, n.sons[bodyPos]) + n[bodyPos] = semTemplBodyDirty(ctx, n[bodyPos]) else: - n.sons[bodyPos] = semTemplBody(ctx, n.sons[bodyPos]) + n[bodyPos] = semTemplBody(ctx, n[bodyPos]) # only parameters are resolved, no type checking is performed - semIdeForTemplateOrGeneric(c, n.sons[bodyPos], ctx.cursorInBody) + semIdeForTemplateOrGeneric(c, n[bodyPos], ctx.cursorInBody) closeScope(c) popOwner(c) - s.ast = n - result = n + if sfCustomPragma in s.flags: - if n.sons[bodyPos].kind != nkEmpty: - localError(c.config, n.sons[bodyPos].info, errImplOfXNotAllowed % s.name.s) - elif n.sons[bodyPos].kind == nkEmpty: + if n[bodyPos].kind != nkEmpty: + localError(c.config, n[bodyPos].info, errImplOfXNotAllowed % s.name.s) + elif n[bodyPos].kind == nkEmpty: localError(c.config, n.info, "implementation of '$1' expected" % s.name.s) - var proto = searchForProc(c, c.currentScope, s) + var (proto, comesFromShadowscope) = searchForProc(c, c.currentScope, s) if proto == nil: addInterfaceOverloadableSymAt(c, c.currentScope, s) - else: + 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.sons[patternPos].kind != nkEmpty: + if n[patternPos].kind != nkEmpty: c.patterns.add(s) proc semPatternBody(c: var TemplCtx, n: PNode): PNode = @@ -634,8 +790,8 @@ proc semPatternBody(c: var TemplCtx, n: PNode): PNode = # semtypes.addParamOrResult). Within the pattern we have to ensure # to use the param with the proper type though: incl(s.flags, sfUsed) - styleCheckUse(n.info, s) - let x = c.owner.typ.n.sons[s.position+1].sym + onUse(n.info, s) + let x = c.owner.typ.n[s.position+1].sym assert x.name == s.name result = newSymNode(x, n.info) @@ -661,11 +817,6 @@ proc semPatternBody(c: var TemplCtx, n: PNode): PNode = localError(c.c.config, n.info, "invalid expression") result = n - proc stupidStmtListExpr(n: PNode): bool = - for i in 0 .. n.len-2: - if n[i].kind notin {nkEmpty, nkCommentStmt}: return false - result = true - result = n case n.kind of nkIdent: @@ -679,14 +830,14 @@ proc semPatternBody(c: var TemplCtx, n: PNode): PNode = # '(pattern){|x}' does the same but the matches will be gathered in 'x' if n.len != 2: localError(c.c.config, n.info, "invalid expression") - elif n.sons[1].kind == nkIdent: - n.sons[0] = semPatternBody(c, n.sons[0]) - n.sons[1] = expectParam(c, n.sons[1]) - elif n.sons[1].kind == nkPrefix and n.sons[1].sons[0].kind == nkIdent: - let opr = n.sons[1].sons[0] + elif n[1].kind == nkIdent: + n[0] = semPatternBody(c, n[0]) + n[1] = expectParam(c, n[1]) + elif n[1].kind == nkPrefix and n[1][0].kind == nkIdent: + let opr = n[1][0] if opr.ident.s == "|": - n.sons[0] = semPatternBody(c, n.sons[0]) - n.sons[1].sons[1] = expectParam(c, n.sons[1].sons[1]) + n[0] = semPatternBody(c, n[0]) + n[1][1] = expectParam(c, n[1][1]) else: localError(c.c.config, n.info, "invalid expression") else: @@ -695,43 +846,41 @@ proc semPatternBody(c: var TemplCtx, n: PNode): PNode = if stupidStmtListExpr(n): result = semPatternBody(c, n.lastSon) else: - for i in countup(0, sonsLen(n) - 1): - result.sons[i] = semPatternBody(c, n.sons[i]) + for i in 0..<n.len: + result[i] = semPatternBody(c, n[i]) of nkCallKinds: - let s = qualifiedLookUp(c.c, n.sons[0], {}) + let s = qualifiedLookUp(c.c, n[0], {}) if s != nil: if s.owner == c.owner and s.kind == skParam: discard elif contains(c.toBind, s.id): discard elif templToExpand(s): return semPatternBody(c, semTemplateExpr(c.c, n, s, {efNoSemCheck})) - if n.kind == nkInfix and n.sons[0].kind == nkIdent: + if n.kind == nkInfix and (let id = considerQuotedIdent(c.c, n[0]); id != nil): # we interpret `*` and `|` only as pattern operators if they occur in # infix notation, so that '`*`(a, b)' can be used for verbatim matching: - let opr = n.sons[0] - if opr.ident.s == "*" or opr.ident.s == "**": + if id.s == "*" or id.s == "**": result = newNodeI(nkPattern, n.info, n.len) - result.sons[0] = opr - result.sons[1] = semPatternBody(c, n.sons[1]) - result.sons[2] = expectParam(c, n.sons[2]) + result[0] = newIdentNode(id, n.info) + result[1] = semPatternBody(c, n[1]) + result[2] = expectParam(c, n[2]) return - elif opr.ident.s == "|": + elif id.s == "|": result = newNodeI(nkPattern, n.info, n.len) - result.sons[0] = opr - result.sons[1] = semPatternBody(c, n.sons[1]) - result.sons[2] = semPatternBody(c, n.sons[2]) + result[0] = newIdentNode(id, n.info) + result[1] = semPatternBody(c, n[1]) + result[2] = semPatternBody(c, n[2]) return - if n.kind == nkPrefix and n.sons[0].kind == nkIdent: - let opr = n.sons[0] - if opr.ident.s == "~": + if n.kind == nkPrefix and (let id = considerQuotedIdent(c.c, n[0]); id != nil): + if id.s == "~": result = newNodeI(nkPattern, n.info, n.len) - result.sons[0] = opr - result.sons[1] = semPatternBody(c, n.sons[1]) + result[0] = newIdentNode(id, n.info) + result[1] = semPatternBody(c, n[1]) return - for i in countup(0, sonsLen(n) - 1): - result.sons[i] = semPatternBody(c, n.sons[i]) + for i in 0..<n.len: + result[i] = semPatternBody(c, n[i]) else: # dotExpr is ambiguous: note that we explicitly allow 'x.TemplateParam', # so we use the generic code for nkDotExpr too @@ -744,23 +893,25 @@ proc semPatternBody(c: var TemplCtx, n: PNode): PNode = else: return newIdentNode(s.name, n.info) of nkPar: - if n.len == 1: return semPatternBody(c, n.sons[0]) + if n.len == 1: return semPatternBody(c, n[0]) else: discard - for i in countup(0, sonsLen(n) - 1): - result.sons[i] = semPatternBody(c, n.sons[i]) + 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: - result = result.sons[0] + result = result[0] 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 3e62652a7..113946fef 100644 --- a/compiler/semtypes.nim +++ b/compiler/semtypes.nim @@ -11,18 +11,19 @@ # included from sem.nim 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" @@ -37,8 +38,17 @@ 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 @@ -46,164 +56,237 @@ proc newOrPrevType(kind: TTypeKind, prev: PType, c: PContext): PType = proc newConstraint(c: PContext, k: TTypeKind): PType = result = newTypeS(tyBuiltInTypeClass, c) - result.addSonSkipIntLit(newTypeS(k, c)) + result.flags.incl tfCheckedForDestructor + result.addSonSkipIntLit(newTypeS(k, c), c.idgen) proc semEnum(c: PContext, n: PNode, prev: PType): PType = - if n.sonsLen == 0: return newConstraint(c, tyEnum) - elif n.sonsLen == 1: + if n.len == 0: return newConstraint(c, tyEnum) + elif n.len == 1: # don't create an empty tyEnum; fixes #3052 return errorType(c) var - counter, x: BiggestInt - e: PSym - base: PType + 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) result.n = newNodeI(nkEnumTy, n.info) checkMinSonsLen(n, 1, c.config) - if n.sons[0].kind != nkEmpty: - base = semTypeNode(c, n.sons[0].sons[0], nil) + if n[0].kind != nkEmpty: + base = semTypeNode(c, n[0][0], nil) if base.kind != tyEnum: - localError(c.config, n.sons[0].info, "inheritance only works with an enum") - counter = lastOrd(c.config, base) + 1 + localError(c.config, n[0].info, "inheritance only works with an enum") + 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 countup(1, sonsLen(n) - 1): - case n.sons[i].kind + for i in 1..<n.len: + if n[i].kind == nkEmpty: continue + var useAutoCounter = false + case n[i].kind of nkEnumFieldDef: - e = newSymS(skEnumField, n.sons[i].sons[0], c) - var v = semConstExpr(c, n.sons[i].sons[1]) + if n[i][0].kind == nkPragmaExpr: + e = newSymS(skEnumField, n[i][0][0], c) + identToReplace = addr n[i][0][0] + pragma(c, e, n[i][0][1], enumFieldPragmas) + else: + e = newSymS(skEnumField, n[i][0], c) + identToReplace = addr n[i][0] + var v = semConstExpr(c, n[i][1]) var strVal: PNode = nil case skipTypes(v.typ, abstractInst-{tyTypeDesc}).kind of tyTuple: - if sonsLen(v) == 2: - strVal = v.sons[1] # second tuple part is the string value - if skipTypes(strVal.typ, abstractInst).kind in {tyString, tyCString}: - x = getOrdValue(v.sons[0]) # first tuple part is the ordinal + if v.len == 2: + strVal = v[1] # second tuple part is the string value + if skipTypes(strVal.typ, abstractInst).kind in {tyString, tyCstring}: + if not isOrdinalType(v[0].typ, allowEnumWithHoles=true): + 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: - x = getOrdValue(v) + 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.sons[i].info, errInvalidOrderInEnumX % e.name.s) - x = counter e.ast = strVal # might be nil counter = x of nkSym: - e = n.sons[i].sym + e = n[i].sym + useAutoCounter = true of nkIdent, nkAccQuoted: - e = newSymS(skEnumField, n.sons[i], c) + 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 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: strTableAdd(c.module.tab, e) - addSon(result.n, newSymNode(e)) - styleCheckDef(c.config, e) + e.flags.incl {sfUsed, sfExported} + + result.n.add symNode + 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: importPureEnumField(c, e) - if isPure and strTableIncl(symbols, e): - wrongRedefinition(c, e.info, e.name.s) - inc(counter) - if not hasNull: incl(result.flags, tfNeedsInit) + 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) + 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: + result.flags.incl tfRequiresInit + setToStringProc(c.graph, result, genEnumToStrProc(result, n.info, c.graph, c.idgen)) proc semSet(c: PContext, n: PNode, prev: PType): PType = result = newOrPrevType(tySet, prev, c) - if sonsLen(n) == 2: - var base = semTypeNode(c, n.sons[1], nil) - addSonSkipIntLit(result, base) - if base.kind in {tyGenericInst, tyAlias, tySink}: base = lastSon(base) - if base.kind != tyGenericParam: - if not isOrdinalType(base): - localError(c.config, n.info, errOrdinalTypeExpected) + 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 = skipModifier(base) + if base.kind notin {tyGenericParam, tyGenericInvocation}: + 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: localError(c.config, n.info, errXExpectsOneTypeParam % "set") - addSonSkipIntLit(result, errorType(c)) + addSonSkipIntLit(result, errorType(c), c.idgen) -proc semContainer(c: PContext, n: PNode, kind: TTypeKind, kindStr: string, - prev: PType): PType = - result = newOrPrevType(kind, prev, c) - if sonsLen(n) == 2: - var base = semTypeNode(c, n.sons[1], nil) +proc semContainerArg(c: PContext; n: PNode, kindStr: string; result: PType) = + if n.len == 2: + var base = semTypeNode(c, n[1], nil) if base.kind == tyVoid: localError(c.config, n.info, errTIsNotAConcreteType % typeToString(base)) - addSonSkipIntLit(result, base) + addSonSkipIntLit(result, base, c.idgen) else: localError(c.config, n.info, errXExpectsOneTypeParam % kindStr) - addSonSkipIntLit(result, errorType(c)) + addSonSkipIntLit(result, errorType(c), c.idgen) + +proc semContainer(c: PContext, n: PNode, kind: TTypeKind, kindStr: string, + prev: PType): PType = + result = newOrPrevType(kind, prev, c) + semContainerArg(c, n, kindStr, result) proc semVarargs(c: PContext, n: PNode, prev: PType): PType = result = newOrPrevType(tyVarargs, prev, c) - if sonsLen(n) == 2 or sonsLen(n) == 3: - var base = semTypeNode(c, n.sons[1], nil) - addSonSkipIntLit(result, base) - if sonsLen(n) == 3: - result.n = newIdentNode(considerQuotedIdent(c, n.sons[2]), n.sons[2].info) + if n.len == 2 or n.len == 3: + var base = semTypeNode(c, n[1], nil) + addSonSkipIntLit(result, base, c.idgen) + if n.len == 3: + result.n = newIdentNode(considerQuotedIdent(c, n[2]), n[2].info) else: localError(c.config, n.info, errXExpectsOneTypeParam % "varargs") - addSonSkipIntLit(result, errorType(c)) - -proc semAnyRef(c: PContext; n: PNode; kind: TTypeKind; prev: PType): PType = - if n.len < 1: - result = newConstraint(c, kind) - else: - let isCall = int ord(n.kind in nkCallKinds+{nkBracketExpr}) - let n = if n[0].kind == nkBracket: n[0] else: n - checkMinSonsLen(n, 1, c.config) - var t = semTypeNode(c, n.lastSon, nil) - if t.kind == tyTypeDesc and tfUnresolved notin t.flags: - t = t.base - result = newOrPrevType(kind, prev, c) - var isNilable = false - # check every except the last is an object: - for i in isCall .. n.len-2: - let ni = n[i] - if ni.kind == nkNilLit: - isNilable = true - else: - let region = semTypeNode(c, ni, nil) - if region.skipTypes({tyGenericInst, tyAlias, tySink}).kind notin { - tyError, tyObject}: - message c.config, n[i].info, errGenerated, "region needs to be an object type" - addSonSkipIntLit(result, region) - addSonSkipIntLit(result, t) - if tfPartial in result.flags: - if result.lastSon.kind == tyObject: incl(result.lastSon.flags, tfPartial) - #if not isNilable: result.flags.incl tfNotNil + addSonSkipIntLit(result, errorType(c), c.idgen) -proc semVarType(c: PContext, n: PNode, prev: PType): PType = - if sonsLen(n) == 1: +proc semVarOutType(c: PContext, n: PNode, prev: PType; flags: TTypeFlags): PType = + if n.len == 1: result = newOrPrevType(tyVar, prev, c) - var base = semTypeNode(c, n.sons[0], nil).skipTypes({tyTypeDesc}) + result.flags = flags + var base = semTypeNode(c, n[0], nil) + if base.kind == tyTypeDesc and not isSelf(base): + base = base[0] if base.kind == tyVar: localError(c.config, n.info, "type 'var var' is not allowed") - base = base.sons[0] - addSonSkipIntLit(result, base) + base = base[0] + addSonSkipIntLit(result, base, c.idgen) else: 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.sons[0], nil)) + 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 = @@ -213,36 +296,43 @@ proc semRangeAux(c: PContext, n: PNode, prev: PType): PType = result.n = newNodeI(nkRange, n.info) # always create a 'valid' range type, but overwrite it later # because 'semExprWithType' can raise an exception. See bug #6895. - addSonSkipIntLit(result, errorType(c)) + addSonSkipIntLit(result, errorType(c), c.idgen) if (n[1].kind == nkEmpty) or (n[2].kind == nkEmpty): 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 + 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") - elif not rangeT[0].isOrdinalType: - localError(c.config, n.info, "ordinal type expected") + 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, but got " & typeToString(rangeT[0])) elif enumHasHoles(rangeT[0]): localError(c.config, n.info, "enum '$1' has holes" % typeToString(rangeT[0])) for i in 0..1: - if hasGenericArguments(range[i]): - result.n.addSon makeStaticExpr(c, range[i]) + if hasUnresolvedArgs(c, range[i]): + result.n.add makeStaticExpr(c, range[i]) result.flags.incl tfUnresolved else: - result.n.addSon semConstExpr(c, range[i]) + result.n.add semConstExpr(c, range[i]) + + 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") @@ -251,55 +341,72 @@ proc semRangeAux(c: PContext, n: PNode, prev: PType): PType = proc semRange(c: PContext, n: PNode, prev: PType): PType = result = nil - if sonsLen(n) == 2: + if n.len == 2: if isRange(n[1]): result = semRangeAux(c, n[1], prev) - let n = result.n - if n.sons[0].kind in {nkCharLit..nkUInt64Lit} and n.sons[0].intVal > 0: - incl(result.flags, tfNeedsInit) - elif n.sons[1].kind in {nkCharLit..nkUInt64Lit} and n.sons[1].intVal < 0: - incl(result.flags, tfNeedsInit) - elif n.sons[0].kind in {nkFloatLit..nkFloat64Lit} and - n.sons[0].floatVal > 0.0: - incl(result.flags, tfNeedsInit) - elif n.sons[1].kind in {nkFloatLit..nkFloat64Lit} and - n.sons[1].floatVal < 0.0: - incl(result.flags, tfNeedsInit) + 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") else: - localError(c.config, n.sons[0].info, "expected range") + localError(c.config, n[0].info, "expected range") result = newOrPrevType(tyError, prev, c) else: 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 in nkCallKinds and hasGenericArguments(e): - if not isOrdinalType(e.typ): - localError(c.config, n[1].info, errOrdinalTypeExpected) + 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 % 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). @@ -307,120 +414,73 @@ 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 = var base: PType - if sonsLen(n) == 3: + if n.len == 3: # 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.sons[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.sons[1].info, "enum '$1' has holes" % + localError(c.config, n[1].info, "enum '$1' has holes" % typeToString(indxB.skipTypes({tyRange}))) - base = semTypeNode(c, n.sons[2], nil) + 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) - addSonSkipIntLit(result, base) + 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 sonsLen(n) == 2: - var base = semTypeNode(c, n.sons[1], nil) + if n.len == 2: + var base = semTypeNode(c, n[1], nil) if base.kind != tyGenericParam: if not isOrdinalType(base): - localError(c.config, n.sons[1].info, errOrdinalTypeExpected) - addSonSkipIntLit(result, base) + 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}) - if result.isNil: - result = qualifiedLookUp(c, n, {checkAmbiguity, checkUndeclared}) - if result != nil: - markUsed(c.config, n.info, result, c.graph.usageSym) - styleCheckUse(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.sons[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 - result.typ = copyType(result.typ, result.typ.owner, true) - 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.kind = skType - result.typ.flags.excl tfWildcard - return - else: - localError(c.config, n.info, errTypeExpected) - return errorSym(c, n) - - if result.kind != skType: - # 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.kind = nkSym - 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 sonsLen(n) == 0: + 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)) + 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 @@ -428,288 +488,442 @@ proc semTuple(c: PContext, n: PNode, prev: PType): PType = result.n = newNodeI(nkRecList, n.info) var check = initIntSet() var counter = 0 - for i in countup(ord(n.kind == nkBracketExpr), sonsLen(n) - 1): - var a = n.sons[i] + for i in ord(n.kind == nkBracketExpr)..<n.len: + var a = n[i] if (a.kind != nkIdentDefs): illFormedAst(a, c.config) checkMinSonsLen(a, 3, c.config) - var length = sonsLen(a) - if a.sons[length - 2].kind != nkEmpty: - typ = semTypeNode(c, a.sons[length - 2], nil) + 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.sons[length - 1].kind != nkEmpty: - localError(c.config, a.sons[length - 1].info, errInitHereNotAllowed) - for j in countup(0, length - 3): - var field = newSymG(skField, a.sons[j], c) + for j in 0..<a.len - 2: + var field = newSymG(skField, a[j], c) field.typ = typ field.position = counter inc(counter) if containsOrIncl(check, field.name.id): - localError(c.config, a.sons[j].info, "attempt to redefine: '" & field.name.s & "'") + localError(c.config, a[j].info, "attempt to redefine: '" & field.name.s & "'") else: - addSon(result.n, newSymNode(field)) - addSonSkipIntLit(result, typ) - styleCheckDef(c.config, a.sons[j].info, 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, a[j].info, field) + onDef(field.info, field) if result.n.len == 0: result.n = nil + if isTupleRecursive(result): + localError(c.config, n.info, errIllegalRecursionInTypeX % typeToString(result)) proc semIdentVis(c: PContext, kind: TSymKind, n: PNode, allowed: TSymFlags): PSym = # identifier with visibility if n.kind == nkPostfix: - if sonsLen(n) == 2: + if n.len == 2: # for gensym'ed identifiers the identifier may already have been # transformed to a symbol and we need to use that here: - result = newSymG(kind, n.sons[1], c) - var v = considerQuotedIdent(c, n.sons[0]) + result = newSymG(kind, n[1], c) + var v = considerQuotedIdent(c, n[0]) if sfExported in allowed and v.id == ord(wStar): incl(result.flags, sfExported) else: if not (sfExported in allowed): - localError(c.config, n.sons[0].info, errXOnlyAtModuleScope % "export") + localError(c.config, n[0].info, errXOnlyAtModuleScope % "export") else: - localError(c.config, n.sons[0].info, errInvalidVisibilityX % renderTree(n[0])) + 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.sons[0], allowed) + result = semIdentVis(c, kind, n[0], allowed) case kind of skType: # process pragmas later, because result.typ has not been set yet discard - of skField: pragma(c, result, n.sons[1], fieldPragmas) - of skVar: pragma(c, result, n.sons[1], varPragmas) - of skLet: pragma(c, result, n.sons[1], letPragmas) - of skConst: pragma(c, result, n.sons[1], constPragmas) + of skField: pragma(c, result, n[1], fieldPragmas) + of skVar: pragma(c, result, n[1], varPragmas) + of skLet: pragma(c, result, n[1], letPragmas) + of skConst: pragma(c, result, n[1], constPragmas) else: discard else: result = semIdentVis(c, kind, n, allowed) - styleCheckDef(c.config, n.info, result) + 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 - for i in countup(1, branchIndex): - for j in countup(0, sonsLen(t.sons[i]) - 2): + for i in 1..branchIndex: + for j in 0..<t[i].len - 1: if i == branchIndex and j == currentEx: break - if overlap(t.sons[i].sons[j].skipConv, ex): + if overlap(t[i][j].skipConv, ex): localError(c.config, ex.info, errDuplicateCaseLabel) -proc semBranchRange(c: PContext, t, a, b: PNode, covered: var BiggestInt): 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.sons[0].typ, ac, ac.info).skipConvTakeType - let bt = fitNode(c, t.sons[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) if emptyRange(ac, bc): localError(c.config, b.info, "range is empty") - else: covered = covered + getOrdValue(bc) - getOrdValue(ac) + 1 + else: covered = covered + getOrdValue(bc) + 1 - getOrdValue(ac) proc semCaseBranchRange(c: PContext, t, b: PNode, - covered: var BiggestInt): PNode = + covered: var Int128): PNode = checkSonsLen(b, 3, c.config) - result = semBranchRange(c, t, b.sons[1], b.sons[2], covered) + result = semBranchRange(c, t, b[1], b[2], covered) -proc semCaseBranchSetElem(c: PContext, t, b: PNode, - covered: var BiggestInt): 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.sons[1], b.sons[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.sons[0], b.sons[1], covered) + result = semBranchRange(c, n, b[0], b[1], covered) else: - result = fitNode(c, t.sons[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, - covered: var BiggestInt) = - let lastIndex = sonsLen(branch) - 2 +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.sons[i] + var b = branch[i] if b.kind == nkRange: - branch.sons[i] = b + branch[i] = b + # same check as in semBranchRange for exhaustiveness + covered = covered + getOrdValue(b[1]) + 1 - getOrdValue(b[0]) elif isRange(b): - branch.sons[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) - if r.kind in {nkCurly, nkBracket} and len(r) == 0 and sonsLen(branch)==2: + # 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 len(r) == 0: - checkMinSonsLen(t, 1, c.config) - branch.sons[i] = skipConv(fitNode(c, t.sons[0].typ, r, r.info)) + elif r.kind notin {nkCurly, nkBracket} or r.len == 0: + 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 + # mirrored with semBranchRange + if tmp.kind in {nkHiddenCallConv, nkHiddenStdConv, nkHiddenSubConv}: + tmp = semConstExpr(c, tmp) + branch[i] = skipConv(tmp) inc(covered) else: if r.kind == nkCurly: r = deduplicate(c.config, r) - # first element is special and will overwrite: branch.sons[i]: - branch.sons[i] = semCaseBranchSetElem(c, t, r[0], covered) + # first element is special and will overwrite: branch[i]: + 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)) + for j in 1..<r.len: + branch.add(semCaseBranchSetElem(c, n, r[j], covered)) # caution! last son of branch must be the actions to execute: - swap(branch.sons[^2], branch.sons[^1]) - checkForOverlap(c, t, i, branchIndex) + swap(branch[^2], branch[^1]) + checkForOverlap(c, n, i, branchIndex) # Elements added above needs to be checked for overlaps. - for i in lastIndex.succ..(sonsLen(branch) - 2): - checkForOverlap(c, t, i, branchIndex) + for i in lastIndex.succ..<branch.len - 1: + checkForOverlap(c, n, i, branchIndex) + +proc toCover(c: PContext, t: PType): Int128 = + let t2 = skipTypes(t, abstractVarRange-{tyTypeDesc}) + if t2.kind == tyEnum and enumHasHoles(t2): + result = toInt128(t2.n.len) + else: + # <---- + let t = skipTypes(t, abstractVar-{tyTypeDesc}) + # XXX: hack incoming. lengthOrd is incorrect for 64bit integer + # types because it doesn't uset Int128 yet. This entire branching + # should be removed as soon as lengthOrd uses int128. + if t.kind in {tyInt64, tyUInt64}: + result = toInt128(1) shl 64 + elif t.kind in {tyInt, tyUInt}: + result = toInt128(1) shl (c.config.target.intSize * 8) + else: + result = lengthOrd(c.config, t) proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, - father: PNode, rectype: PType) + father: PNode, rectype: PType, hasCaseFields = false) + +proc getIntSetOfType(c: PContext, t: PType): IntSet = + result = initIntSet() + if t.enumHasHoles: + let t = t.skipTypes(abstractRange) + for field in t.n.sons: + result.incl(field.sym.position) + else: + assert(lengthOrd(c.config, t) <= BiggestInt(MaxSetElements)) + for i in toInt64(firstOrd(c.config, t))..toInt64(lastOrd(c.config, t)): + result.incl(i.int) + +iterator processBranchVals(b: PNode): int = + assert b.kind in {nkOfBranch, nkElifBranch, nkElse} + if b.kind == nkOfBranch: + for i in 0..<b.len-1: + if b[i].kind in {nkIntLit, nkCharLit}: + yield b[i].intVal.int + elif b[i].kind == nkRange: + for i in b[i][0].intVal..b[i][1].intVal: + yield i.int + +proc renderAsType(vals: IntSet, t: PType): string = + result = "{" + let t = t.skipTypes(abstractRange) + var enumSymOffset = 0 + var i = 0 + for val in vals: + if result.len > 1: + result &= ", " + case t.kind: + of tyEnum, tyBool: + while t.n[enumSymOffset].sym.position < val: inc(enumSymOffset) + result &= t.n[enumSymOffset].sym.name.s + of tyChar: + result.addQuoted(char(val)) + else: + if i == 64: + result &= "omitted $1 values..." % $(vals.len - i) + break + else: + result &= $val + inc(i) + result &= "}" + +proc formatMissingEnums(c: PContext, n: PNode): string = + var coveredCases = initIntSet() + for i in 1..<n.len: + for val in processBranchVals(n[i]): + coveredCases.incl val + result = (c.getIntSetOfType(n[0].typ) - coveredCases).renderAsType(n[0].typ) + proc semRecordCase(c: PContext, n: PNode, check: var IntSet, pos: var int, father: PNode, rectype: PType) = var a = copyNode(n) checkMinSonsLen(n, 2, c.config) - semRecordNodeAux(c, n.sons[0], check, pos, a, rectype) - if a.sons[0].kind != nkSym: + semRecordNodeAux(c, n[0], check, pos, a, rectype, hasCaseFields = true) + if a[0].kind != nkSym: internalError(c.config, "semRecordCase: discriminant is no symbol") return - incl(a.sons[0].sym.flags, sfDiscriminant) - var covered: BiggestInt = 0 - var typ = skipTypes(a.sons[0].typ, abstractVar-{tyTypeDesc}) - if not isOrdinalType(typ): - localError(c.config, n.info, "selector must be of an ordinal type") - elif firstOrd(c.config, typ) != 0: - localError(c.config, n.info, "low(" & $a.sons[0].sym.name.s & + incl(a[0].sym.flags, sfDiscriminant) + var covered = toInt128(0) + var chckCovered = false + var typ = skipTypes(a[0].typ, abstractVar-{tyTypeDesc}) + const shouldChckCovered = {tyInt..tyInt64, tyChar, tyEnum, tyUInt..tyUInt32, tyBool} + case typ.kind + of shouldChckCovered: + chckCovered = true + of tyFloat..tyFloat128, tyError: + discard + of tyRange: + if skipTypes(typ.elementType, abstractInst).kind in shouldChckCovered: + chckCovered = true + of tyForward: + errorUndeclaredIdentifier(c, n[0].info, typ.sym.name.s) + elif not isOrdinalType(typ): + localError(c.config, n[0].info, "selector must be of an ordinal type, float") + if firstOrd(c.config, typ) != 0: + localError(c.config, n.info, "low(" & $a[0].sym.name.s & ") must be 0 for discriminant") elif lengthOrd(c.config, typ) > 0x00007FFF: - localError(c.config, n.info, "len($1) must be less than 32768" % a.sons[0].sym.name.s) - var chckCovered = true - for i in countup(1, sonsLen(n) - 1): - var b = copyTree(n.sons[i]) - addSon(a, b) - case n.sons[i].kind + localError(c.config, n.info, "len($1) must be less than 32768" % a[0].sym.name.s) + + for i in 1..<n.len: + var b = copyTree(n[i]) + a.add b + case n[i].kind of nkOfBranch: checkMinSonsLen(b, 2, c.config) semCaseBranch(c, a, b, i, covered) of nkElse: - chckCovered = false checkSonsLen(b, 1, c.config) + if chckCovered and covered == toCover(c, a[0].typ): + message(c.config, b.info, warnUnreachableElse) + chckCovered = false else: illFormedAst(n, c.config) - delSon(b, sonsLen(b) - 1) - semRecordNodeAux(c, lastSon(n.sons[i]), check, pos, b, rectype) - if chckCovered and covered != lengthOrd(c.config, a.sons[0].typ): - localError(c.config, a.info, "not all cases are covered") - addSon(father, a) + delSon(b, b.len - 1) + semRecordNodeAux(c, lastSon(n[i]), check, pos, b, rectype, hasCaseFields = true) + if chckCovered and covered != toCover(c, a[0].typ): + if a[0].typ.skipTypes(abstractRange).kind == tyEnum: + localError(c.config, a.info, "not all cases are covered; missing: $1" % + formatMissingEnums(c, a)) + else: + localError(c.config, a.info, "not all cases are covered") + father.add a proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, - father: PNode, rectype: PType) = + father: PNode, rectype: PType, hasCaseFields: bool) = if n == nil: return case n.kind of nkRecWhen: + var a = copyTree(n) var branch: PNode = nil # the branch to take - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[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 of nkElifBranch: checkSonsLen(it, 2, c.config) if c.inGenericContext == 0: - var e = semConstBoolExpr(c, it.sons[0]) - if e.kind != nkIntLit: internalError(c.config, e.info, "semRecordNodeAux") - elif e.intVal != 0 and branch == nil: branch = it.sons[1] + var e = semConstBoolExpr(c, it[0]) + if e.kind != nkIntLit: discard "don't report followup error" + elif e.intVal != 0 and branch == nil: branch = it[1] else: - it.sons[0] = forceBool(c, semExprWithType(c, it.sons[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.sons[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.sons[idx], newCheck, newPos, newf, rectype) - it.sons[idx] = if newf.len == 1: newf[0] else: newf - if c.inGenericContext > 0: - addSon(father, n) - elif branch != nil: - semRecordNodeAux(c, branch, check, pos, father, rectype) + semRecordNodeAux(c, it[idx], newCheck, newPos, newf, rectype, hasCaseFields) + it[idx] = if newf.len == 1: newf[0] else: newf + 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: semRecordCase(c, n, check, pos, father, rectype) of nkNilLit: - if father.kind != nkRecList: addSon(father, newNodeI(nkRecList, n.info)) + if father.kind != nkRecList: father.add newNodeI(nkRecList, n.info) of nkRecList: # attempt to keep the nesting at a sane level: var a = if father.kind == nkRecList: father else: copyNode(n) - for i in countup(0, sonsLen(n) - 1): - semRecordNodeAux(c, n.sons[i], check, pos, a, rectype) - if a != father: addSon(father, a) + for i in 0..<n.len: + semRecordNodeAux(c, n[i], check, pos, a, rectype, hasCaseFields) + if a != father: father.add a of nkIdentDefs: checkMinSonsLen(n, 3, c.config) - var length = sonsLen(n) var a: PNode - if father.kind != nkRecList and length>=4: a = newNodeI(nkRecList, n.info) + if father.kind != nkRecList and n.len >= 4: a = newNodeI(nkRecList, n.info) else: a = newNodeI(nkEmpty, n.info) - if n.sons[length-1].kind != nkEmpty: - localError(c.config, n.sons[length-1].info, errInitHereNotAllowed) var typ: PType - if n.sons[length-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.sons[length-2], nil) + 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 - for i in countup(0, sonsLen(n)-3): - var f = semIdentWithPragma(c, skField, n.sons[i], {sfExported}) - suggestSym(c.config, n.sons[i].info, f, c.graph.usageSym) + for i in 0..<n.len-2: + var f = semIdentWithPragma(c, skField, n[i], {sfExported}) + let info = if n[i].kind == nkPostfix: + n[i][1].info + else: + n[i].info + suggestSym(c.graph, info, f, c.graph.usageSym) f.typ = typ f.position = pos + f.options = c.config.options if fieldOwner != nil and {sfImportc, sfExportc} * fieldOwner.flags != {} and - f.loc.r == nil: - f.loc.r = rope(f.name.s) - f.flags = f.flags + ({sfImportc, sfExportc} * fieldOwner.flags) + 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, n.sons[i].info, "attempt to redefine: '" & f.name.s & "'") - if a.kind == nkEmpty: addSon(father, newSymNode(f)) - else: addSon(a, newSymNode(f)) - styleCheckDef(c.config, f) - if a.kind != nkEmpty: addSon(father, a) + localError(c.config, info, "attempt to redefine: '" & f.name.s & "'") + 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: # This branch only valid during generic object # inherited from generic/partial specialized parent second check. # There is no branch validity check here if containsOrIncl(check, n.sym.name.id): localError(c.config, n.info, "attempt to redefine: '" & n.sym.name.s & "'") - addSon(father, n) - of nkEmpty: discard + father.add n + of nkEmpty: + if father.kind in {nkElse, nkOfBranch}: + father.add n else: illFormedAst(n, c.config) proc addInheritedFieldsAux(c: PContext, check: var IntSet, pos: var int, n: PNode) = case n.kind of nkRecCase: - if (n.sons[0].kind != nkSym): internalError(c.config, n.info, "addInheritedFieldsAux") - addInheritedFieldsAux(c, check, pos, n.sons[0]) - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind + if (n[0].kind != nkSym): internalError(c.config, n.info, "addInheritedFieldsAux") + addInheritedFieldsAux(c, check, pos, n[0]) + for i in 1..<n.len: + case n[i].kind of nkOfBranch, nkElse: - addInheritedFieldsAux(c, check, pos, lastSon(n.sons[i])) + addInheritedFieldsAux(c, check, pos, lastSon(n[i])) else: internalError(c.config, n.info, "addInheritedFieldsAux(record case branch)") - of nkRecList: - for i in countup(0, sonsLen(n) - 1): - addInheritedFieldsAux(c, check, pos, n.sons[i]) + of nkRecList, nkRecWhen, nkElifBranch, nkElse: + for i in int(n.kind == nkElifBranch)..<n.len: + addInheritedFieldsAux(c, check, pos, n[i]) of nkSym: incl(check, n.sym.name.id) inc(pos) @@ -718,27 +932,35 @@ proc addInheritedFieldsAux(c: PContext, check: var IntSet, pos: var int, proc skipGenericInvocation(t: PType): PType {.inline.} = result = t if result.kind == tyGenericInvocation: - result = result.sons[0] - while result.kind in {tyGenericInst, tyGenericBody, tyRef, tyPtr, tyAlias, tySink}: - result = lastSon(result) - -proc addInheritedFields(c: PContext, check: var IntSet, pos: var int, - obj: PType) = - assert obj.kind == tyObject - if (sonsLen(obj) > 0) and (obj.sons[0] != nil): - addInheritedFields(c, check, pos, obj.sons[0].skipGenericInvocation) - addInheritedFieldsAux(c, check, pos, obj.n) - -proc semObjectNode(c: PContext, n: PNode, prev: PType): PType = - if n.sonsLen == 0: + result = result[0] + while result.kind in {tyGenericInst, tyGenericBody, tyRef, tyPtr, tyAlias, tySink, tyOwned}: + 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; flags: TTypeFlags): PType = + result = nil + if n.len == 0: return newConstraint(c, tyObject) var check = initIntSet() var pos = 0 var base, realBase: PType = nil - # n.sons[0] contains the pragmas (if any). We process these later... + # n[0] contains the pragmas (if any). We process these later... checkSonsLen(n, 3, c.config) - if n.sons[1].kind != nkEmpty: - realBase = semTypeNode(c, n.sons[1].sons[0], nil) + if n[1].kind != nkEmpty: + realBase = semTypeNode(c, n[1][0], nil) base = skipTypesOrNil(realBase, skipPtrs) if base.isNil: localError(c.config, n.info, "cannot inherit from a type that is not an object type") @@ -751,37 +973,107 @@ proc semObjectNode(c: PContext, n: PNode, prev: PType): PType = # specialized object, there will be second check after instantiation # located in semGeneric. if concreteBase.kind == tyObject: - addInheritedFields(c, check, pos, concreteBase) + if concreteBase.sym != nil and concreteBase.sym.magic == mException and + sfSystemModule notin c.module.flags: + message(c.config, n.info, warnInheritFromException, "") + 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.sons[1].info, "inheritance only works with non-final objects; " & - "to enable inheritance write '" & typeToString(realBase) & " of RootObj'") + localError(c.config, n[1].info, "inheritance only works with non-final objects; " & + "for " & typeToString(realBase) & " to be inheritable it must be " & + "'object of RootObj' instead of 'object'") base = nil realBase = nil if n.kind != nkObjectTy: internalError(c.config, n.info, "semObjectNode") result = newOrPrevType(tyObject, prev, c) rawAddSon(result, realBase) + 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) - semRecordNodeAux(c, n.sons[2], check, pos, result.n, result) - if n.sons[0].kind != nkEmpty: + 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`: var s = newSymS(skType, newIdentNode(getIdent(c.cache, "dummy"), n.info), c) s.typ = result - pragma(c, s, n.sons[0], typePragmas) + pragma(c, s, n[0], typePragmas) if base == nil and tfInheritable notin result.flags: incl(result.flags, tfFinal) + if c.inGenericContext == 0 and computeRequiresInit(c, result): + result.flags.incl tfRequiresInit + +proc semAnyRef(c: PContext; n: PNode; kind: TTypeKind; prev: PType): PType = + if n.len < 1: + result = newConstraint(c, kind) + else: + let isCall = int ord(n.kind in nkCallKinds+{nkBracketExpr}) + 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 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: + t = t.base + if t.kind == tyVoid: + localError(c.config, n.info, "type '$1 void' is not allowed" % kind.toHumanStr) + result = newOrPrevType(kind, prev, c) + var isNilable = false + var wrapperKind = tyNone + # check every except the last is an object: + for i in isCall..<n.len-1: + let ni = n[i] + # echo "semAnyRef ", "n: ", n, "i: ", i, "ni: ", ni + if ni.kind == nkNilLit: + isNilable = true + else: + let region = semTypeNode(c, ni, nil) + if region.kind in {tyOwned, tySink}: + wrapperKind = region.kind + elif region.skipTypes({tyGenericInst, tyAlias, tySink}).kind notin { + tyError, tyObject}: + message c.config, n[i].info, errGenerated, "region needs to be an object type" + addSonSkipIntLit(result, region, c.idgen) + else: + message(c.config, n.info, warnDeprecated, "region for pointer types is deprecated") + addSonSkipIntLit(result, region, c.idgen) + addSonSkipIntLit(result, t, c.idgen) + if tfPartial in result.flags: + if result.elementType.kind == tyObject: incl(result.elementType.flags, tfPartial) + # if not isNilable: result.flags.incl tfNotNil + case wrapperKind + of tyOwned: + if optOwnedRefs in c.config.globalOptions: + let t = newTypeS(tyOwned, c, result) + t.flags.incl tfHasOwned + result = t + of tySink: + let t = newTypeS(tySink, c, result) + result = t + else: discard + 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 @@ -789,196 +1081,225 @@ proc addParamOrResult(c: PContext, param: PSym, kind: TSymKind) = if kind == skMacro: let staticType = findEnforcedStaticType(param.typ) if staticType != nil: - var a = copySym(param) + var a = copySym(param, c.idgen) a.typ = staticType.base addDecl(c, a) - elif param.typ.kind == tyTypeDesc: - addDecl(c, param) + #elif param.typ != nil and param.typ.kind == tyTypeDesc: + # addDecl(c, param) else: # within a macro, every param has the type NimNode! let nn = getSysSym(c.graph, param.info, "NimNode") - var a = copySym(param) + var a = copySym(param, c.idgen) a.typ = nn.typ addDecl(c, a) else: - if sfGenSym notin param.flags: addDecl(c, param) + if sfGenSym in param.flags: + # bug #XXX, fix the gensym'ed parameters owner: + if param.owner == nil: + param.owner = getCurrOwner(c) + else: addDecl(c, param) template shouldHaveMeta(t) = internalAssert c.config, tfHasMeta in t.flags # result.lastSon.flags.incl tfHasMeta +proc addImplicitGeneric(c: PContext; typeClass: PType, typId: PIdent; + info: TLineInfo; genericParams: PNode; + paramName: string): PType = + if genericParams == nil: + # This happens with anonymous proc types appearing in signatures + # XXX: we need to lift these earlier + return + let finalTypId = if typId != nil: typId + else: getIdent(c.cache, paramName & ":type") + # is this a bindOnce type class already present in the param list? + for i in 0..<genericParams.len: + if genericParams[i].sym.name.id == finalTypId.id: + return genericParams[i].typ + + let owner = if typeClass.sym != nil: typeClass.sym + else: getCurrOwner(c) + var s = newSym(skType, finalTypId, c.idgen, owner, info) + if sfExplain in owner.flags: s.flags.incl sfExplain + if typId == nil: s.flags.incl(sfAnon) + s.linkTo(typeClass) + typeClass.flags.incl tfImplicitTypeParam + s.position = genericParams.len + genericParams.add newSymNode(s) + result = typeClass + addDecl(c, s) + proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, paramType: PType, paramName: string, info: TLineInfo, anon = false): PType = if paramType == nil: return # (e.g. proc return type) - proc addImplicitGenericImpl(c: PContext; typeClass: PType, typId: PIdent): PType = - if genericParams == nil: - # This happens with anonymous proc types appearing in signatures - # XXX: we need to lift these earlier - return - let finalTypId = if typId != nil: typId - else: getIdent(c.cache, paramName & ":type") - # is this a bindOnce type class already present in the param list? - for i in countup(0, genericParams.len - 1): - if genericParams.sons[i].sym.name.id == finalTypId.id: - return genericParams.sons[i].typ - - let owner = if typeClass.sym != nil: typeClass.sym - else: getCurrOwner(c) - var s = newSym(skType, finalTypId, owner, info) - if sfExplain in owner.flags: s.flags.incl sfExplain - if typId == nil: s.flags.incl(sfAnon) - s.linkTo(typeClass) - typeClass.flags.incl tfImplicitTypeParam - s.position = genericParams.len - genericParams.addSon(newSymNode(s)) - result = typeClass - addDecl(c, s) - - # XXX: There are codegen errors if this is turned into a nested proc - template liftingWalk(typ: PType, anonFlag = false): untyped = + template recurse(typ: PType, anonFlag = false): untyped = liftParamType(c, procKind, genericParams, typ, paramName, info, anonFlag) - #proc liftingWalk(paramType: PType, anon = false): PType = var paramTypId = if not anon and paramType.sym != nil: paramType.sym.name else: nil - template maybeLift(typ: PType): untyped = - let lifted = liftingWalk(typ) - (if lifted != nil: lifted else: typ) - - template addImplicitGeneric(e): untyped = - addImplicitGenericImpl(c, e, paramTypId) - - case paramType.kind: + case paramType.kind of tyAnything: - result = addImplicitGenericImpl(c, newTypeS(tyGenericParam, c), nil) + result = addImplicitGeneric(c, newTypeS(tyGenericParam, c), nil, info, genericParams, paramName) of tyStatic: - # proc(a: expr{string}, b: expr{nkLambda}) - # overload on compile time values and AST trees - if paramType.n != nil: return # this is a concrete type + if paramType.base.kind != tyNone and paramType.n != nil: + # this is a concrete static value + return if tfUnresolved in paramType.flags: return # already lifted - let base = paramType.base.maybeLift + + let lifted = recurse(paramType.base) + let base = (if lifted != nil: lifted else: paramType.base) if base.isMetaType and procKind == skMacro: localError(c.config, info, errMacroBodyDependsOnGenericTypes % paramName) - result = addImplicitGeneric(c.newTypeWithSons(tyStatic, @[base])) - result.flags.incl({tfHasStatic, tfUnresolved}) + result = addImplicitGeneric(c, newTypeS(tyStatic, c, base), + paramTypId, info, genericParams, paramName) + if result != nil: result.flags.incl({tfHasStatic, tfUnresolved}) of tyTypeDesc: if tfUnresolved notin paramType.flags: # naked typedescs are not bindOnce types if paramType.base.kind == tyNone and paramTypId != nil and - paramTypId.id == getIdent(c.cache, "typedesc").id: + (paramTypId.id == getIdent(c.cache, "typedesc").id or + paramTypId.id == getIdent(c.cache, "type").id): # XXX Why doesn't this check for tyTypeDesc instead? paramTypId = nil - result = addImplicitGeneric( - 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.sonsLen == 1: + if paramType.len == 1: # disable the bindOnce behavior for the type class - result = liftingWalk(paramType.sons[0], true) + 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: + 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)]) - result = addImplicitGeneric(typ) + 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: - for i in 0 ..< paramType.len: - if paramType.sons[i] == paramType: + result = nil + for i in 0..<paramType.len: + if paramType[i] == paramType: globalError(c.config, info, errIllegalRecursionInTypeX % typeToString(paramType)) - var lifted = liftingWalk(paramType.sons[i]) + var lifted = recurse(paramType[i]) if lifted != nil: - paramType.sons[i] = lifted + paramType[i] = lifted result = paramType of tyGenericBody: result = newTypeS(tyGenericInvocation, c) result.rawAddSon(paramType) - for i in 0 .. paramType.sonsLen - 2: - if paramType.sons[i].kind == tyStatic: - var staticCopy = paramType.sons[i].exactReplica + for i in 0..<paramType.len - 1: + if paramType[i].kind == tyStatic: + var staticCopy = paramType[i].exactReplica staticCopy.flags.incl tfInferrableStatic result.rawAddSon staticCopy else: result.rawAddSon newTypeS(tyAnything, c) - if paramType.lastSon.kind == tyUserTypeClass: + if paramType.typeBodyImpl.kind == tyUserTypeClass: result.kind = tyUserTypeClassInst - result.rawAddSon paramType.lastSon - return addImplicitGeneric(result) + 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.sons[i]) - result = addImplicitGeneric(result) + 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, getCurrOwner(c), false) + 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 - return addImplicitGeneric(cp) + return addImplicitGeneric(c, cp, paramTypId, info, genericParams, paramName) - for i in 1 .. paramType.len-2: - var lifted = liftingWalk(paramType.sons[i]) + for i in 1..<paramType.len-1: + var lifted = recurse(paramType[i]) if lifted != nil: - paramType.sons[i] = lifted + paramType[i] = lifted result = paramType - result.lastSon.shouldHaveMeta + result.last.shouldHaveMeta - let liftBody = liftingWalk(paramType.lastSon, true) + let liftBody = recurse(paramType.skipModifier, true) if liftBody != nil: result = liftBody - result.shouldHaveMeta + result.flags.incl tfHasMeta + #result.shouldHaveMeta of tyGenericInvocation: - for i in 1 ..< paramType.len: - let lifted = liftingWalk(paramType.sons[i]) - if lifted != nil: paramType.sons[i] = lifted + result = nil + for i in 1..<paramType.len: + #if paramType[i].kind != tyTypeDesc: + let lifted = recurse(paramType[i]) + if lifted != nil: paramType[i] = lifted let body = paramType.base - if body.kind == tyForward: + if body.kind in {tyForward, tyError}: # this may happen for proc type appearing in a type section # 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 = liftingWalk(expanded, true) + result = recurse(expanded, true) of tyUserTypeClasses, tyBuiltInTypeClass, tyCompositeTypeClass, - tyAnd, tyOr, tyNot: - result = addImplicitGeneric(copyType(paramType, getCurrOwner(c), false)) + tyAnd, tyOr, tyNot, tyConcept: + result = addImplicitGeneric(c, + copyType(paramType, c.idgen, getCurrOwner(c)), paramTypId, + info, genericParams, paramName) of tyGenericParam: - markUsed(c.config, info, paramType.sym, c.graph.usageSym) - styleCheckUse(info, paramType.sym) + 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.kind = skType + paramType.sym.transitionGenericParamToType() - else: discard - - # result = liftingWalk(paramType) + 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.sons[0], nil) - constraint = semNodeKindConstraints(n, c.config) + 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, nkOpenSym} and + considerQuotedIdent(c, n[0]).s == "{}": + result = semTypeNode(c, n[1], nil) + constraint = semNodeKindConstraints(n, c.config, 2) else: result = semTypeNode(c, n, nil) @@ -990,21 +1311,27 @@ proc newProcType(c: PContext; info: TLineInfo; prev: PType = nil): PType = # result.n[0] used to be `nkType`, but now it's `nkEffectList` because # the effects are now stored in there too ... this is a bit hacky, but as # usual we desperately try to save memory: - addSon(result.n, newNodeI(nkEffectList, info)) + 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) proc semProcTypeNode(c: PContext, n, genericParams: PNode, prev: PType, kind: TSymKind; isType=false): PType = # for historical reasons (code grows) this is invoked for parameter # lists too and then 'isType' is false. - var cl: IntSet checkMinSonsLen(n, 1, c.config) result = newProcType(c, n.info, prev) - if genericParams != nil and sonsLen(genericParams) == 0: - cl = initIntSet() var check = initIntSet() var counter = 0 - for i in countup(1, n.len - 1): - var a = n.sons[i] + 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] if a.kind != nkIdentDefs: # for some generic instantiations the passed ':env' parameter # for closures has already been produced (see bug #898). We simply @@ -1012,87 +1339,180 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, # pass over this instantiation: if a.kind == nkSym and sfFromGeneric in a.sym.flags: continue illFormedAst(a, c.config) + checkMinSonsLen(a, 3, c.config) var typ: PType = nil def: PNode = nil constraint: PNode = nil - length = sonsLen(a) - hasType = a.sons[length-2].kind != nkEmpty - hasDefault = a.sons[length-1].kind != nkEmpty + hasType = a[^2].kind != nkEmpty + hasDefault = a[^1].kind != nkEmpty + if hasType: - typ = semParamType(c, a.sons[length-2], constraint) + let isGeneric = isCurrentlyGeneric() + inc c.inGenericContext, ord(isGeneric) + typ = semParamType(c, a[^2], constraint) + dec c.inGenericContext, ord(isGeneric) + # TODO: Disallow typed/untyped in procs in the compiler/stdlib + if kind in {skProc, skFunc} and (typ.kind == tyTyped or typ.kind == tyUntyped): + if not isMagic(getCurrOwner(c)): + localError(c.config, a[^2].info, "'" & typ.sym.name.s & "' is only allowed in templates and macros or magic procs") + if hasDefault: - def = semExprWithType(c, a.sons[length-1]) - # check type compatibility between def.typ and typ: + 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: + 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 + 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 + if typ == nil: typ = def.typ - elif def != nil: - # and def.typ != nil and def.typ.kind != tyNone: + if isEmptyContainer(typ): + localError(c.config, a.info, "cannot infer the type of parameter '" & $a[0] & "'") + + if typ.kind == tyTypeDesc: + # consider a proc such as: + # proc takesType(T = int) + # a naive analysis may conclude that the proc type is type[int] + # 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 = newTypeS(tyTypeDesc, c, newTypeS(tyNone, c)) + typ.flags.incl tfCheckedForDestructor + + 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) if not containsGenericType(typ): + # check type compatibility between def.typ and typ: def = fitNode(c, typ, def, def.info) + elif typ.kind == tyStatic: + def = semConstExpr(c, def) + def = fitNode(c, typ, def, def.info) + if not hasType and not hasDefault: if isType: localError(c.config, a.info, "':' expected") if kind in {skTemplate, skMacro}: - typ = newTypeS(tyExpr, c) + typ = newTypeS(tyUntyped, c) elif skipTypes(typ, {tyGenericInst, tyAlias, tySink}).kind == tyVoid: continue - for j in countup(0, length-3): - var arg = newSymG(skParam, a.sons[j], c) + + 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) - let finalType = if lifted != nil: lifted else: typ.skipIntLit + 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.sons[j].info, "attempt to redefine: '" & arg.name.s & "'") - addSon(result.n, newSymNode(arg)) + if def != nil and def.kind != nkEmpty: + arg.ast = copyTree(def) + result.n.add newSymNode(arg) rawAddSon(result, finalType) addParamOrResult(c, arg, kind) - styleCheckDef(c.config, a.sons[j].info, arg) - - var r: PType - if n.sons[0].kind != nkEmpty: - r = semTypeNode(c, n.sons[0], nil) + styleCheckDef(c, a[j].info, arg) + onDef(a[j].info, arg) + a[j] = newSymNode(arg) + + 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 + # delete this entire if block. The rest is (at least at time of + # writing this comment) already implemented. + let info = n[0].info + const msg = "`typed` will change its meaning in future versions of Nim. " & + "`void` or no return type declaration at all has the same " & + "meaning as the current meaning of `typed` as return type " & + "declaration." + message(c.config, info, warnDeprecated, msg) + r = nil if r != nil: # turn explicit 'void' return type into 'nil' because the rest of the # compiler only checks for 'nil': if skipTypes(r, {tyGenericInst, tyAlias, tySink}).kind != tyVoid: + if kind notin {skMacro, skTemplate} and r.kind in {tyTyped, tyUntyped}: + localError(c.config, n[0].info, "return type '" & typeToString(r) & + "' is only valid for macros and templates") # 'auto' as a return type does not imply a generic: - if r.kind == tyAnything: - # 'p(): auto' and 'p(): expr' are equivalent, but the rest of the - # compiler is hardly aware of 'auto': - r = newTypeS(tyExpr, c) - elif r.kind != tyExpr: + elif r.kind == tyAnything: + r = copyType(r, c.idgen, r.owner) + r.flags.incl tfRetType + elif r.kind == tyStatic: + # type allowed should forbid this type + discard + else: if r.sym == nil or sfAnon notin r.sym.flags: let lifted = liftParamType(c, kind, genericParams, r, "result", - n.sons[0].info) + n[0].info) if lifted != nil: r = lifted #if r.kind != tyGenericParam: #echo "came here for ", typeToString(r) r.flags.incl tfRetType - r = skipIntLit(r) + r = skipIntLit(r, c.idgen) if kind == skIterator: # see tchainediterators - # in cases like iterator foo(it: iterator): type(it) + # in cases like iterator foo(it: iterator): typeof(it) # we don't need to change the return type to iter[T] result.flags.incl tfIterator # XXX Would be nice if we could get rid of this - result.sons[0] = r + result[0] = r let oldFlags = result.flags propagateToOwner(result, r) if oldFlags != result.flags: @@ -1101,85 +1521,101 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, result.flags.excl tfHasMeta result.n.typ = r - if genericParams != nil and genericParams.len > 0: + if isCurrentlyGeneric(): for n in genericParams: if {sfUsed, sfAnon} * n.sym.flags == {}: result.flags.incl tfUnresolved if tfWildcard in n.sym.typ.flags: - n.sym.kind = skType + n.sym.transitionGenericParamToType() n.sym.typ.flags.excl tfWildcard proc semStmtListType(c: PContext, n: PNode, prev: PType): PType = checkMinSonsLen(n, 1, c.config) - var length = sonsLen(n) - for i in countup(0, length - 2): - n.sons[i] = semStmt(c, n.sons[i]) - if length > 0: - result = semTypeNode(c, n.sons[length - 1], prev) + for i in 0..<n.len - 1: + n[i] = semStmt(c, n[i], {}) + if n.len > 0: + result = semTypeNode(c, n[^1], prev) n.typ = result - n.sons[length - 1].typ = result + n[^1].typ = result else: result = nil 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.sons[0].kind notin {nkEmpty, nkSym}: - addDecl(c, newSymS(skLabel, n.sons[0], c)) - result = semStmtListType(c, n.sons[1], prev) - n.sons[1].typ = result + if n[0].kind notin {nkEmpty, nkSym}: + addDecl(c, newSymS(skLabel, n[0], c)) + result = semStmtListType(c, n[1], prev) + n[1].typ = result n.typ = result 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.sons[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" % - [s.name.s, ($s.kind).substr(2).toLowerAscii]) + [s.name.s, s.kind.toHumanStr]) return newOrPrevType(tyError, prev, c) - var t = s.typ + 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) + addSonSkipIntLit(result, t, c.idgen) + + template addToResult(typ, skip) = - template addToResult(typ) = if typ.isNil: internalAssert c.config, false rawAddSon(result, typ) - else: addSonSkipIntLit(result, typ) + else: + if skip: + addSonSkipIntLit(result, typ, c.idgen) + else: + rawAddSon(result, makeRangeWithStaticExpr(c, typ.n)) if t.kind == tyForward: - for i in countup(1, sonsLen(n)-1): - var elem = semGenericParamInInvocation(c, n.sons[i]) - addToResult(elem) + for i in 1..<n.len: + var elem = semGenericParamInInvocation(c, n[i]) + addToResult(elem, true) return elif t.kind != tyGenericBody: # we likely got code of the form TypeA[TypeB] where TypeA is @@ -1192,29 +1628,38 @@ 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 - - for i in 1 ..< m.call.len: + 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 - if typ.kind == tyTypeDesc and typ.sons[0].kind == tyNone: + # is this a 'typedesc' *parameter*? If so, use the typedesc type, + # unstripped. + 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) @@ -1222,20 +1667,41 @@ proc semGeneric(c: PContext, n: PNode, s: PSym, prev: PType): PType = # special check for generic object with # generic/partial specialized parent let tx = result.skipTypes(abstractPtrs, 50) - if tx.isNil: - localError(c.config, n.info, "invalid recursion in type '$1'" % typeToString(result[0])) + if tx.isNil or isTupleRecursive(tx): + localError(c.config, n.info, "illegal recursion in type '$1'" % typeToString(result[0])) return errorType(c) - if tx != result and tx.kind == tyObject and tx.sons[0] != nil: - semObjectTypeForInheritedGenericInst(c, n, tx) + if tx != result and tx.kind == tyObject: + if tx[0] != nil: + 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 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 + if prev.kind != tyGenericBody: + assignType(prev, result) + else: + result = nil -proc maybeAliasType(c: PContext; typeExpr, prev: PType): PType +proc fixupTypeOf(c: PContext, prev: PType, typExpr: PNode) = + if prev != nil: + let result = newTypeS(tyAlias, c) + result.rawAddSon typExpr.typ + result.sym = prev.sym + 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 @@ -1251,13 +1717,18 @@ 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(res, prev: PType): PType {.inline.} = - if prev.isNil: - result = copyType(res, res.owner, keepId=false) +proc freshType(c: PContext; res, prev: PType): PType {.inline.} = + 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 @@ -1271,21 +1742,27 @@ template modifierTypeKindOfNode(n: PNode): TTypeKind = else: tyNone proc semTypeClass(c: PContext, n: PNode, prev: PType): PType = - # if n.sonsLen == 0: return newConstraint(c, tyTypeClass) + # if n.len == 0: return newConstraint(c, tyTypeClass) + if isNewStyleConcept(n): + result = newOrPrevType(tyConcept, prev, c) + result.flags.incl tfCheckedForDestructor + result.n = semConceptDeclaration(c, n) + return result + let pragmas = n[1] inherited = n[2] - result = newOrPrevType(tyUserTypeClass, prev, c) var owner = getCurrOwner(c) - var candidateTypeSlot = newTypeWithSons(owner, tyAlias, @[c.errorType]) - 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: for n in inherited.sons: let typ = semTypeNode(c, n, nil) - result.sons.add(typ) + result.add(typ) openScope(c) for param in n[0]: @@ -1298,50 +1775,97 @@ proc semTypeClass(c: PContext, n: PNode, prev: PType): PType = if modifier != tyNone: dummyName = param[0] dummyType = c.makeTypeWithModifier(modifier, candidateTypeSlot) - if modifier == tyTypeDesc: dummyType.flags.incl tfExplicit + # if modifier == tyRef: + # dummyType.flags.incl tfNotNil + if modifier == tyTypeDesc: + dummyType.flags.incl tfConceptMatchedTypeSym + dummyType.flags.incl tfCheckedForDestructor else: dummyName = param dummyType = candidateTypeSlot + # this can be true for 'nim check' on incomplete concepts, + # see bug #8230 + if dummyName.kind == nkEmpty: continue + internalAssert c.config, dummyName.kind == nkIdent var dummyParam = newSym(if modifier == tyTypeDesc: skType else: skVar, - dummyName.ident, owner, param.info) + dummyName.ident, c.idgen, owner, param.info) dummyParam.typ = dummyType incl dummyParam.flags, sfUsed addDecl(c, dummyParam) - result.n.sons[3] = semConceptBody(c, n[3]) + result.n[3] = semConceptBody(c, n[3]) 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: + 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: + 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" + else: + # we transform ``(arg1, arg2: T) {.m, rest.}`` into ``m((arg1, arg2: T) {.rest.})`` and + # let the semantic checker deal with it: + var x = newNodeI(nkCall, key.info) + x.add(key) + if p.kind in nkPragmaCallKinds and p.len > 1: + # pass pragma arguments to the macro too: + for i in 1 ..< p.len: + x.add(p[i]) + # Also pass the node the pragma has been applied to + x.add(operand.copyTreeWithoutNode(p)) + # recursion assures that this works for multiple macro annotations too: + var r = semOverloadedCall(c, x, x, {skMacro, skTemplate}, {efNoUndeclared}) + if r != nil: + doAssert r[0].kind == nkSym + let m = r[0].sym + case m.kind + of skMacro: return semMacroExpr(c, r, r, m, {efNoSemCheck}) + of skTemplate: return semTemplateExpr(c, r, m, {efNoSemCheck}) + else: doAssert(false, "cannot happen") + proc semProcTypeWithScope(c: PContext, n: PNode, - prev: PType, kind: TSymKind): PType = + prev: PType, kind: TSymKind): PType = checkSonsLen(n, 2, c.config) + + if n[1].kind != nkEmpty and n[1].len > 0: + let macroEval = applyTypeSectionPragmas(c, n[1], n) + if macroEval != nil: + return semTypeNode(c, macroEval, prev) + openScope(c) - result = semProcTypeNode(c, n.sons[0], nil, prev, kind, isType=true) + result = semProcTypeNode(c, n[0], nil, prev, kind, isType=true) # start with 'ccClosure', but of course pragmas can overwrite this: result.callConv = ccClosure # dummy symbol for `pragma`: var s = newSymS(kind, newIdentNode(getIdent(c.cache, "dummy"), n.info), c) s.typ = result - if n.sons[1].kind != nkEmpty and n.sons[1].len > 0: - pragma(c, s, n.sons[1], procTypePragmas) - when useEffectSystem: setEffectsForProcType(c.graph, result, n.sons[1]) + 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: + # 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)) + implicitPragmas(c, s, n.info, {wTags, wRaises}) + when useEffectSystem: setEffectsForProcType(c.graph, result, s.ast[pragmasPos]) closeScope(c) -proc maybeAliasType(c: PContext; typeExpr, prev: PType): PType = - if typeExpr.kind in {tyObject, tyEnum, tyDistinct} and prev != nil: - result = newTypeS(tyAlias, c) - result.rawAddSon typeExpr - result.sym = prev.sym - assignType(prev, result) - -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) - proc symFromExpectedTypeNode(c: PContext, n: PNode): PSym = if n.kind == nkType: result = symFromType(c, n.typ, n.info) @@ -1349,32 +1873,128 @@ proc symFromExpectedTypeNode(c: PContext, n: PNode): PSym = localError(c.config, n.info, errTypeExpected) result = errorSym(c, n) +proc semStaticType(c: PContext, childNode: PNode, prev: PType): PType = + result = newOrPrevType(tyStatic, prev, c) + var base = semTypeNode(c, childNode, nil).skipTypes({tyTypeDesc, tyAlias}) + result.rawAddSon(base) + result.flags.incl tfHasStatic + +proc semTypeOf(c: PContext; n: PNode; prev: PType): PType = + openScope(c) + inc c.inTypeofContext + defer: dec c.inTypeofContext # compiles can raise an exception + let t = semExprWithType(c, n, {efInTypeof}) + closeScope(c) + fixupTypeOf(c, prev, t) + result = t.typ + if result.kind == tyFromExpr: + result.flags.incl tfNonConstExpr + +proc semTypeOf2(c: PContext; n: PNode; prev: PType): PType = + openScope(c) + var m = BiggestInt 1 # typeOfIter + if n.len == 3: + let mode = semConstExpr(c, n[2]) + if mode.kind != nkIntLit: + localError(c.config, n.info, "typeof: cannot evaluate 'mode' parameter at compile-time") + 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 inc c.inTypeContext if c.config.cmd == cmdIdeTools: suggestExpr(c, n) case n.kind - of nkEmpty: discard + of nkEmpty: result = n.typ of nkTypeOfExpr: - # for ``type(countup(1,3))``, see ``tests/ttoseq``. + # for ``typeof(countup(1,3))``, see ``tests/ttoseq``. checkSonsLen(n, 1, c.config) - let typExpr = semExprWithType(c, n.sons[0], {efInTypeof}) - fixupTypeOf(c, prev, typExpr) - result = typExpr.typ + result = semTypeOf(c, n[0], prev) if result.kind == tyTypeDesc: result.flags.incl tfExplicit of nkPar: - if sonsLen(n) == 1: result = semTypeNode(c, n.sons[0], prev) + if n.len == 1: result = semTypeNode(c, n[0], prev) else: result = semAnonTuple(c, n, prev) 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]) @@ -1382,27 +2002,27 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = elif ident != nil and ident.id == ord(wDotDot): result = semRangeAux(c, n, prev) elif n[0].kind == nkNilLit and n.len == 2: - result = semTypeNode(c, n.sons[1], prev) - if result.skipTypes({tyGenericInst, tyAlias, tySink}).kind in NilableTypes+GenericTypes: + result = semTypeNode(c, n[1], prev) + if result.skipTypes({tyGenericInst, tyAlias, tySink, tyOwned}).kind in NilableTypes+GenericTypes: if tfNotNil in result.flags: - result = freshType(result, prev) + result = freshType(c, result, prev) result.flags.excl(tfNotNil) else: localError(c.config, n.info, errGenerated, "invalid type") elif n[0].kind notin nkIdentKinds: result = semTypeExpr(c, n, prev) else: - let op = considerQuotedIdent(c, n.sons[0]) - if op.id in {ord(wAnd), ord(wOr)} or op.s == "|": + let op = considerQuotedIdent(c, n[0]) + if op.id == ord(wAnd) or op.id == ord(wOr) or op.s == "|": checkSonsLen(n, 3, c.config) var - t1 = semTypeNode(c, n.sons[1], nil) - t2 = semTypeNode(c, n.sons[2], nil) + t1 = semTypeNode(c, n[1], nil) + t2 = semTypeNode(c, n[2], nil) if t1 == nil: - localError(c.config, n.sons[1].info, errTypeExpected) + localError(c.config, n[1].info, errTypeExpected) result = newOrPrevType(tyError, prev, c) elif t2 == nil: - localError(c.config, n.sons[2].info, errTypeExpected) + localError(c.config, n[2].info, errTypeExpected) result = newOrPrevType(tyError, prev, c) else: result = if op.id == ord(wAnd): makeAndType(c, t1, t2) @@ -1410,17 +2030,50 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = elif op.id == ord(wNot): case n.len of 3: - result = semTypeNode(c, n.sons[1], prev) - if result.skipTypes({tyGenericInst, tyAlias, tySink}).kind in NilableTypes+GenericTypes+{tyForward} and - n.sons[2].kind == nkNilLit: - result = freshType(result, prev) + result = semTypeNode(c, n[1], prev) + if result.kind == tyTypeDesc and tfUnresolved notin result.flags: + result = result.base + if n[2].kind != nkNilLit: + localError(c.config, n.info, + "Invalid syntax. When used with a type, 'not' can be followed only by 'nil'") + if notnil notin c.features and strictNotNil notin c.features: + localError(c.config, n.info, + "enable the 'not nil' annotation with {.experimental: \"notnil\".} or " & + " the `strict not nil` annotation with {.experimental: \"strictNotNil\".} " & + " the \"notnil\" one is going to be deprecated, so please use \"strictNotNil\"") + let resolvedType = result.skipTypes({tyGenericInst, tyAlias, tySink, tyOwned}) + case resolvedType.kind + of tyGenericParam, tyTypeDesc, tyFromExpr: + # XXX: This is a really inappropraite hack, but it solves + # https://github.com/nim-lang/Nim/issues/4907 for now. + # + # A proper solution is to introduce a new type kind such + # as `tyNotNil[tyRef[SomeGenericParam]]`. This will allow + # semtypinst to replace the generic param correctly in + # situations like the following: + # + # type Foo[T] = object + # bar: ref T not nil + # baz: ref T + # + # The root of the problem is that `T` here must have a specific + # ID that is bound to a concrete type during instantiation. + # The use of `freshType` below breaks this. Another hack would + # be to reuse the same ID for the not nil type, but this will + # fail if the `T` parameter is referenced multiple times as in + # the example above. + # + # I suggest revisiting this once the language decides on whether + # `not nil` should be the default. We can then map nilable refs + # to other types such as `Option[T]`. + result = makeTypeFromExpr(c, newTree(nkStmtListType, n.copyTree)) + of NilableTypes + {tyGenericInvocation, tyForward}: + result = freshType(c, result, prev) result.flags.incl(tfNotNil) - if notnil notin c.features: - localError(c.config, n.info, "enable the 'not nil' annotation with {.experimental: \"notnil\".}") else: localError(c.config, n.info, errGenerated, "invalid type") of 2: - let negated = semTypeNode(c, n.sons[1], prev) + let negated = semTypeNode(c, n[1], prev) result = makeNotType(c, negated) else: localError(c.config, n.info, errGenerated, "invalid type") @@ -1430,52 +2083,72 @@ 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) - let typExpr = semExprWithType(c, n.sons[1], {efInTypeof}) - fixupTypeOf(c, prev, typExpr) - result = typExpr.typ + 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.kind = nkStmtListType - result = semTypeNode(c, whenResult, prev) + if whenResult.kind == nkStmtList: whenResult.transitionSonsKind(nkStmtListType) + if whenResult.kind == nkWhenStmt: + result = whenResult.typ + else: + result = semTypeNode(c, whenResult, prev) of nkBracketExpr: checkMinSonsLen(n, 2, c.config) - var head = n.sons[0] + var head = n[0] var s = if head.kind notin nkCallKinds: semTypeIdent(c, head) else: symFromExpectedTypeNode(c, semExpr(c, head)) case s.magic of mArray: result = semArray(c, n, prev) of mOpenArray: result = semContainer(c, n, tyOpenArray, "openarray", prev) + of mUncheckedArray: result = semContainer(c, n, tyUncheckedArray, "UncheckedArray", prev) of mRange: result = semRange(c, n, prev) of mSet: result = semSet(c, n, prev) of mOrdinal: result = semOrdinal(c, n, prev) - of mSeq: result = semContainer(c, n, tySequence, "seq", prev) - of mOpt: result = semContainer(c, n, tyOpt, "opt", prev) + of mIterableType: result = semIterableType(c, n, prev) + of mSeq: + result = semContainer(c, n, tySequence, "seq", prev) + if optSeqDestructors in c.config.globalOptions: + incl result.flags, tfHasAsgn of mVarargs: result = semVarargs(c, n, prev) - of mTypeDesc: result = makeTypeDesc(c, semTypeNode(c, n[1], nil)) + of mTypeDesc, mType, mTypeOf: + result = makeTypeDesc(c, semTypeNode(c, n[1], nil)) + result.flags.incl tfExplicit + of mStatic: + result = semStaticType(c, n[1], prev) of mExpr: - result = semTypeNode(c, n.sons[0], nil) + result = semTypeNode(c, n[0], nil) if result != nil: - result = copyType(result, getCurrOwner(c), false) - for i in countup(1, n.len - 1): - result.rawAddSon(semTypeNode(c, n.sons[i], nil)) + let old = result + 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)) of mDistinct: result = newOrPrevType(tyDistinct, prev, c) - addSonSkipIntLit(result, semTypeNode(c, n[1], nil)) + addSonSkipIntLit(result, semTypeNode(c, n[1], nil), c.idgen) of mVar: result = newOrPrevType(tyVar, prev, c) - var base = semTypeNode(c, n.sons[1], nil) + var base = semTypeNode(c, n[1], nil) if base.kind in {tyVar, tyLent}: localError(c.config, n.info, "type 'var var' is not allowed") - base = base.sons[0] - addSonSkipIntLit(result, base) + base = base[0] + addSonSkipIntLit(result, base, c.idgen) 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) @@ -1505,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 @@ -1513,76 +2186,91 @@ 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: if s.typ.kind notin {tyBool, tyChar, tyInt..tyInt64, tyFloat..tyFloat128, tyUInt..tyUInt64}: - prev.id = s.typ.id + prev.itemId = s.typ.itemId result = prev of nkSym: let s = getGenSym(c, n.sym) - if s.kind == skType and s.typ != nil: - var t = s.typ + if s.typ != nil and (s.kind == skType or s.typ.kind == tyTypeDesc): + var t = + if s.kind == skType: + s.typ + else: + 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) result = prev - markUsed(c.config, n.info, n.sym, c.graph.usageSym) - styleCheckUse(n.info, n.sym) + markUsed(c, n.info, n.sym) + onUse(n.info, n.sym) else: - if s.kind != skError: localError(c.config, n.info, errTypeExpected) + if s.kind != skError: + if s.typ == nil: + localError(c.config, n.info, "type expected, but symbol '$1' has no type." % [s.name.s]) + else: + localError(c.config, n.info, "type expected, but got symbol '$1' of kind '$2'" % + [s.name.s, s.kind.toHumanStr]) result = newOrPrevType(tyError, prev, c) - of nkObjectTy: result = semObjectNode(c, n, prev) + 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 = semVarType(c, n, prev) + 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 = newOrPrevType(tyStatic, prev, c) - var base = semTypeNode(c, n.sons[0], nil).skipTypes({tyTypeDesc}) - result.rawAddSon(base) - result.flags.incl tfHasStatic - of nkIteratorTy: - if n.sonsLen == 0: + of nkStaticTy: result = semStaticType(c, n[0], prev) + 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 - result.addSonSkipIntLit(child) - else: - result = semProcTypeWithScope(c, n, prev, skIterator) - 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.sonsLen == 0: - result = newConstraint(c, tyProc) + 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, skProc) + let symKind = if n.kind == nkIteratorTy: skIterator else: skProc + result = semProcTypeWithScope(c, n, prev, symKind) + if result == nil: + localError(c.config, n.info, "type expected, but got: " & renderTree(n)) + result = newOrPrevType(tyError, prev, c) + + if n.kind == nkIteratorTy and result.kind == tyProc: + result.flags.incl(tfIterator) + if result.callConv == ccClosure and c.config.selectedGC in {gcArc, gcOrc, gcAtomicArc}: + 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, errTypeExpected) - 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 - if c.inTypeContext == 0: instAllTypeBoundOp(c, n.info) - -when false: - proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = - result = semTypeNodeInner(c, n, prev) - instAllTypeBoundOp(c, n.info) proc setMagicType(conf: ConfigRef; m: PSym, kind: TTypeKind, size: int) = # source : https://en.wikipedia.org/wiki/Data_structure_alignment#x86 @@ -1595,160 +2283,180 @@ proc setMagicType(conf: ConfigRef; m: PSym, kind: TTypeKind, size: int) = # FIXME: proper support for clongdouble should be added. # long double size can be 8, 10, 12, 16 bytes depending on platform & compiler - if conf.target.targetCPU == cpuI386 and size == 8: - #on Linux/BSD i386, double are aligned to 4bytes (except with -malign-double) - if kind in {tyFloat64, tyFloat} and - conf.target.targetOS in {osLinux, osAndroid, osNetbsd, osFreebsd, osOpenbsd, osDragonfly}: - m.typ.align = 4 - # on i386, all known compiler, 64bits ints are aligned to 4bytes (except with -malign-double) - elif kind in {tyInt, tyUInt, tyInt64, tyUInt64}: - m.typ.align = 4 - else: - discard + if kind in {tyFloat64, tyFloat, tyInt, tyUInt, tyInt64, tyUInt64} and size == 8: + m.typ.align = int16(conf.floatInt64Align) + +proc setMagicIntegral(conf: ConfigRef; m: PSym, kind: TTypeKind, size: int) = + setMagicType(conf, m, kind, size) + incl m.typ.flags, tfCheckedForDestructor proc processMagicType(c: PContext, m: PSym) = case m.magic - of mInt: setMagicType(c.config, m, tyInt, c.config.target.intSize) - of mInt8: setMagicType(c.config, m, tyInt8, 1) - of mInt16: setMagicType(c.config, m, tyInt16, 2) - of mInt32: setMagicType(c.config, m, tyInt32, 4) - of mInt64: setMagicType(c.config, m, tyInt64, 8) - of mUInt: setMagicType(c.config, m, tyUInt, c.config.target.intSize) - of mUInt8: setMagicType(c.config, m, tyUInt8, 1) - of mUInt16: setMagicType(c.config, m, tyUInt16, 2) - of mUInt32: setMagicType(c.config, m, tyUInt32, 4) - of mUInt64: setMagicType(c.config, m, tyUInt64, 8) - of mFloat: setMagicType(c.config, m, tyFloat, c.config.target.floatSize) - of mFloat32: setMagicType(c.config, m, tyFloat32, 4) - of mFloat64: setMagicType(c.config, m, tyFloat64, 8) - of mFloat128: setMagicType(c.config, m, tyFloat128, 16) - of mBool: setMagicType(c.config, m, tyBool, 1) - of mChar: setMagicType(c.config, m, tyChar, 1) + of mInt: setMagicIntegral(c.config, m, tyInt, c.config.target.intSize) + of mInt8: setMagicIntegral(c.config, m, tyInt8, 1) + of mInt16: setMagicIntegral(c.config, m, tyInt16, 2) + of mInt32: setMagicIntegral(c.config, m, tyInt32, 4) + of mInt64: setMagicIntegral(c.config, m, tyInt64, 8) + of mUInt: setMagicIntegral(c.config, m, tyUInt, c.config.target.intSize) + of mUInt8: setMagicIntegral(c.config, m, tyUInt8, 1) + of mUInt16: setMagicIntegral(c.config, m, tyUInt16, 2) + of mUInt32: setMagicIntegral(c.config, m, tyUInt32, 4) + of mUInt64: setMagicIntegral(c.config, m, tyUInt64, 8) + of mFloat: setMagicIntegral(c.config, m, tyFloat, c.config.target.floatSize) + of mFloat32: setMagicIntegral(c.config, m, tyFloat32, 4) + of mFloat64: setMagicIntegral(c.config, m, tyFloat64, 8) + of mFloat128: setMagicIntegral(c.config, m, tyFloat128, 16) + of mBool: setMagicIntegral(c.config, m, tyBool, 1) + of mChar: setMagicIntegral(c.config, m, tyChar, 1) of mString: - setMagicType(c.config, m, tyString, c.config.target.ptrSize) + setMagicType(c.config, m, tyString, szUncomputedSize) rawAddSon(m.typ, getSysType(c.graph, m.info, tyChar)) + if optSeqDestructors in c.config.globalOptions: + incl m.typ.flags, tfHasAsgn of mCstring: - setMagicType(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: setMagicType(c.config, m, tyPointer, c.config.target.ptrSize) - of mEmptySet: - setMagicType(c.config, m, tySet, 1) - rawAddSon(m.typ, newTypeS(tyEmpty, c)) - of mIntSetBaseType: setMagicType(c.config, m, tyRange, c.config.target.intSize) + of mPointer: setMagicIntegral(c.config, m, tyPointer, c.config.target.ptrSize) of mNil: setMagicType(c.config, m, tyNil, c.config.target.ptrSize) of mExpr: if m.name.s == "auto": - setMagicType(c.config, m, tyAnything, 0) + setMagicIntegral(c.config, m, tyAnything, 0) else: - setMagicType(c.config, m, tyExpr, 0) - if m.name.s == "expr": m.typ.flags.incl tfOldSchoolExprStmt + setMagicIntegral(c.config, m, tyUntyped, 0) of mStmt: - setMagicType(c.config, m, tyStmt, 0) - if m.name.s == "stmt": m.typ.flags.incl tfOldSchoolExprStmt - of mTypeDesc: - setMagicType(c.config, m, tyTypeDesc, 0) + setMagicIntegral(c.config, m, tyTyped, 0) + of mTypeDesc, mType: + setMagicIntegral(c.config, m, tyTypeDesc, 0) + rawAddSon(m.typ, newTypeS(tyNone, c)) + of mStatic: + setMagicType(c.config, m, tyStatic, 0) rawAddSon(m.typ, newTypeS(tyNone, c)) of mVoidType: - setMagicType(c.config, m, tyVoid, 0) + setMagicIntegral(c.config, m, tyVoid, 0) of mArray: - setMagicType(c.config, m, tyArray, 0) + setMagicType(c.config, m, tyArray, szUncomputedSize) of mOpenArray: - setMagicType(c.config, m, tyOpenArray, 0) + setMagicType(c.config, m, tyOpenArray, szUncomputedSize) of mVarargs: - setMagicType(c.config, m, tyVarargs, 0) + setMagicType(c.config, m, tyVarargs, szUncomputedSize) of mRange: - setMagicType(c.config, m, tyRange, 0) + setMagicIntegral(c.config, m, tyRange, szUncomputedSize) rawAddSon(m.typ, newTypeS(tyNone, c)) of mSet: - setMagicType(c.config, m, tySet, 0) + setMagicIntegral(c.config, m, tySet, szUncomputedSize) + of mUncheckedArray: + setMagicIntegral(c.config, m, tyUncheckedArray, szUncomputedSize) of mSeq: - setMagicType(c.config, m, tySequence, 0) - of mOpt: - setMagicType(c.config, m, tyOpt, 0) + setMagicType(c.config, m, tySequence, szUncomputedSize) + if optSeqDestructors in c.config.globalOptions: + incl m.typ.flags, tfHasAsgn + 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: - setMagicType(c.config, m, tyOrdinal, 0) + 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 of mException: discard of mBuiltinType: case m.name.s of "lent": setMagicType(c.config, m, tyLent, c.config.target.ptrSize) - of "sink": setMagicType(c.config, m, tySink, 0) + of "sink": setMagicType(c.config, m, tySink, szUncomputedSize) + of "owned": + setMagicType(c.config, m, tyOwned, c.config.target.ptrSize) + incl m.typ.flags, tfHasOwned else: localError(c.config, m.info, errTypeExpected) else: localError(c.config, m.info, errTypeExpected) 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 = + + template addSym(result: PNode, s: PSym): untyped = + if father != nil: addSonSkipIntLit(father, s.typ, c.idgen) + if sfGenSym notin s.flags: addDecl(c, s) + result.add newSymNode(s) + result = copyNode(n) if n.kind != nkGenericParams: illFormedAst(n, c.config) return - for i in countup(0, sonsLen(n)-1): - var a = n.sons[i] - if a.kind != nkIdentDefs: illFormedAst(n, c.config) - let L = a.len - var def = a[^1] - let constraint = a[^2] - var typ: PType + for i in 0..<n.len: + var a = n[i] + case a.kind + of nkSym: result.addSym(a.sym) + of nkIdentDefs: + var def = a[^1] + let constraint = a[^2] + 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.elementType.kind == tyNone: + typ = newTypeS(tyTypeDesc, c, newTypeS(tyNone, c)) + incl typ.flags, tfCheckedForDestructor + else: + typ = semGenericConstraints(c, typ) - if constraint.kind != nkEmpty: - typ = semTypeNode(c, constraint, nil) - if typ.kind != tyStatic or typ.len == 0: - if typ.kind == tyTypeDesc: - if typ.sons[0].kind == tyNone: - typ = newTypeWithSons(c, tyTypeDesc, @[newTypeS(tyNone, c)]) + if def.kind != nkEmpty: + def = semConstExpr(c, def) + if typ == nil: + if def.typ.kind != tyTypeDesc: + typ = newTypeS(tyStatic, c, def.typ) else: - typ = semGenericConstraints(c, typ) + # the following line fixes ``TV2*[T:SomeNumber=TR] = array[0..1, T]`` + # from manyloc/named_argument_bug/triengine: + def.typ = def.typ.skipTypes({tyTypeDesc}) + if not containsGenericType(def.typ): + def = fitNode(c, typ, def, def.info) - if def.kind != nkEmpty: - def = semConstExpr(c, def) if typ == nil: - if def.typ.kind != tyTypeDesc: - typ = newTypeWithSons(c, tyStatic, @[def.typ]) - else: - # the following line fixes ``TV2*[T:SomeNumber=TR] = array[0..1, T]`` - # from manyloc/named_argument_bug/triengine: - def.typ = def.typ.skipTypes({tyTypeDesc}) - if not containsGenericType(def.typ): - def = fitNode(c, typ, def, def.info) + typ = newTypeS(tyGenericParam, c) + if father == nil: typ.flags.incl tfWildcard - if typ == nil: - typ = newTypeS(tyGenericParam, c) - if father == nil: typ.flags.incl tfWildcard - - typ.flags.incl tfGenericTypeParam - - for j in countup(0, L-3): - let finalType = if j == 0: typ - else: copyType(typ, typ.owner, false) - # it's important the we create an unique - # type for each generic param. the index - # of the parameter will be stored in the - # attached symbol. - var paramName = a.sons[j] - var covarianceFlag = tfUnresolved - - if paramName.safeLen == 2: - if not nimEnableCovariance or paramName[0].ident.s == "in": - if father == nil or sfImportc notin father.sym.flags: - localError(c.config, paramName.info, errInOutFlagNotExtern % $paramName[0]) - covarianceFlag = if paramName[0].ident.s == "in": tfContravariant - else: tfCovariant - if father != nil: father.flags.incl tfCovariant - paramName = paramName[1] - - var s = if finalType.kind == tyStatic or tfWildcard in typ.flags: - newSymG(skGenericParam, paramName, c).linkTo(finalType) - else: - newSymG(skType, paramName, c).linkTo(finalType) + typ.flags.incl tfGenericTypeParam - if covarianceFlag != tfUnresolved: s.typ.flags.incl(covarianceFlag) - if def.kind != nkEmpty: s.ast = def - if father != nil: addSonSkipIntLit(father, s.typ) - s.position = result.len - addSon(result, newSymNode(s)) - if sfGenSym notin s.flags: addDecl(c, s) + for j in 0..<a.len-2: + var finalType: PType + if j == 0: + finalType = typ + else: + 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 + # of the parameter will be stored in the + # attached symbol. + var paramName = a[j] + var covarianceFlag = tfUnresolved + + if paramName.safeLen == 2: + if not nimEnableCovariance or paramName[0].ident.s == "in": + if father == nil or sfImportc notin father.sym.flags: + localError(c.config, paramName.info, errInOutFlagNotExtern % $paramName[0]) + covarianceFlag = if paramName[0].ident.s == "in": tfContravariant + else: tfCovariant + if father != nil: father.flags.incl tfCovariant + paramName = paramName[1] + + var s = if finalType.kind == tyStatic or tfWildcard in typ.flags: + newSymG(skGenericParam, paramName, c).linkTo(finalType) + else: + newSymG(skType, paramName, c).linkTo(finalType) + if covarianceFlag != tfUnresolved: s.typ.flags.incl(covarianceFlag) + if def.kind != nkEmpty: s.ast = def + s.position = result.len + result.addSym(s) + else: + illFormedAst(n, c.config) diff --git a/compiler/semtypinst.nim b/compiler/semtypinst.nim index a24972d04..759e8e6ab 100644 --- a/compiler/semtypinst.nim +++ b/compiler/semtypinst.nim @@ -9,110 +9,104 @@ # This module does the instantiation of generic types. +import std / tables + import ast, astalgo, msgs, types, magicsys, semdata, renderer, options, - lineinfos + lineinfos, modulegraphs + +when defined(nimPreviewSlimSystem): + import std/assertions -const - tfInstClearedFlags = {tfHasMeta, tfUnresolved} +const tfInstClearedFlags = {tfHasMeta, tfUnresolved} proc checkPartialConstructedType(conf: ConfigRef; info: TLineInfo, t: PType) = - if tfAcyclic in t.flags and skipTypes(t, abstractInst).kind != tyObject: - localError(conf, info, "invalid pragma: acyclic") - elif t.kind in {tyVar, tyLent} and t.sons[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 tfAcyclic in t.flags and skipTypes(t, abstractInst).kind != tyObject: - localError(conf, info, "invalid pragma: acyclic") - elif t.kind in {tyVar, tyLent} and t.sons[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: - localError(conf, info, "illegal recursion in type '" & typeToString(t) & "'") - when false: - if t.kind == tyObject and t.sons[0] != nil: - if t.sons[0].kind != tyObject or tfFinal in t.sons[0].flags: - localError(info, errInheritanceOnlyWithNonFinalObjects) + elif computeSize(conf, t) == szIllegalRecursion or isTupleRecursive(t): + localError(conf, info, "illegal recursion in type '" & typeToString(t) & "'") -proc searchInstTypes*(key: PType): PType = - let genericTyp = key.sons[0] +proc searchInstTypes*(g: ModuleGraph; key: PType): PType = + result = nil + let genericTyp = key[0] if not (genericTyp.kind == tyGenericBody and - key.sons[0] == genericTyp and genericTyp.sym != nil): return + genericTyp.sym != nil): return - if genericTyp.sym.typeInstCache == nil: - return - - for inst in genericTyp.sym.typeInstCache: + for inst in typeInstCacheItems(g, genericTyp.sym): if inst.id == key.id: return inst - if inst.sons.len < key.sons.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.sons[j], key.sons[j], - flags = {ExactGenericParams}): + if not compareTypes(inst[j], key[j], + flags = {ExactGenericParams, PickyCAliases}): break matchType return inst -proc cacheTypeInst*(inst: PType) = - # XXX: add to module's generics - # update the refcount - let gt = inst.sons[0] - let t = if gt.kind == tyGenericBody: gt.lastSon else: gt - if t.kind in {tyStatic, tyGenericParam} + tyTypeClasses: +proc cacheTypeInst(c: PContext; inst: PType) = + let gt = inst[0] + let t = if gt.kind == tyGenericBody: gt.typeBodyImpl else: gt + if t.kind in {tyStatic, tyError, tyGenericParam} + tyTypeClasses: return - gt.sym.typeInstCache.safeAdd(inst) - + addToGenericCache(c, gt.sym, inst) type - LayeredIdTable* = object - topLayer*: TIdTable - nextLayer*: ptr LayeredIdTable + LayeredIdTable* {.acyclic.} = ref object + topLayer*: TypeMapping + nextLayer*: LayeredIdTable TReplTypeVars* = object c*: PContext - typeMap*: ptr LayeredIdTable # map PType to PType - symMap*: TIdTable # map PSym to PSym - localCache*: TIdTable # local cache for remembering alraedy replaced + typeMap*: LayeredIdTable # map PType to PType + 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 allowMetaTypes*: bool # allow types such as seq[Number] # i.e. the result contains unresolved generics - skipTypedesc*: bool # wether we should skip typeDescs + skipTypedesc*: bool # whether we should skip typeDescs + isReturnType*: bool owner*: PSym # where this instantiation comes from 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 = - copyIdTable(result.topLayer, pt) +proc initLayeredTypeMap*(pt: sink TypeMapping): LayeredIdTable = + result = LayeredIdTable() + result.topLayer = pt proc newTypeMapLayer*(cl: var TReplTypeVars): LayeredIdTable = - result.nextLayer = cl.typeMap - initIdTable(result.topLayer) + result = LayeredIdTable(nextLayer: cl.typeMap, topLayer: initTable[ItemId, PType]()) -proc lookup(typeMap: ptr LayeredIdTable, key: PType): 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: ptr LayeredIdTable, key, value: PType) = - idTablePut(typeMap.topLayer, key, value) +template put(typeMap: LayeredIdTable, key, value: PType) = + typeMap.topLayer[key.itemId] = value -template checkMetaInvariants(cl: TReplTypeVars, t: PType) = +template checkMetaInvariants(cl: TReplTypeVars, t: PType) = # noop code when false: if t != nil and tfHasMeta in t.flags and cl.allowMetaTypes == false: @@ -124,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 @@ -144,69 +205,117 @@ proc isTypeParam(n: PNode): bool = (n.sym.kind == skGenericParam or (n.sym.kind == skType and sfFromGeneric in n.sym.flags)) -proc hasGenericArguments*(n: PNode): bool = - if n.kind == nkSym: - return n.sym.kind == skGenericParam or - tfInferrableStatic in n.sym.typ.flags or - (n.sym.kind == skType and - n.sym.typ.flags * {tfGenericTypeParam, tfImplicitTypeParam} != {}) - else: +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: - if hasGenericArguments(n.sons[i]): return true - return false - -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.sons[0] = newSymNode(n.sons[0].sym.owner) - return cl.c.semOverloadedCall(cl.c, n, n, {skProc, skFunc}, {}) - - for i in 0 ..< n.safeLen: - n.sons[i] = reResolveCallsWithTypedescParams(cl, n[i]) - - return n - -proc replaceTypeVarsN(cl: var TReplTypeVars, n: PNode; start=0): PNode = + n[i] = reResolveCallsWithTypedescParams(cl, n[i]) + + return n + +proc replaceObjBranches(cl: TReplTypeVars, n: PNode): PNode = + result = n + case n.kind + of nkNone..nkNilLit: + discard + of nkRecWhen: + var branch: PNode = nil # the branch to take + for i in 0..<n.len: + var it = n[i] + if it == nil: illFormedAst(n, cl.c.config) + case it.kind + of nkElifBranch: + checkSonsLen(it, 2, cl.c.config) + var cond = 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] + of nkElse: + checkSonsLen(it, 1, cl.c.config) + if branch == nil: branch = it[0] + else: illFormedAst(n, cl.c.config) + if branch != nil: + result = replaceObjBranches(cl, branch) + else: + result = newNodeI(nkRecList, n.info) + else: + for i in 0..<n.len: + n[i] = replaceObjBranches(cl, n[i]) + +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 of nkNone..pred(nkSym), succ(nkSym)..nkNilLit: 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 = newNode(nkRecList, n.info) + result = newNodeI(nkRecList, n.info) of nkRecWhen: var branch: PNode = nil # the branch to take - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] + for i in 0..<n.len: + var it = n[i] if it == nil: illFormedAst(n, cl.c.config) case it.kind of nkElifBranch: checkSonsLen(it, 2, cl.c.config) - var cond = prepareNode(cl, it.sons[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.sons[1] + var cond = prepareNode(cl, it[0]) + 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.sons[0] + if branch == nil: branch = it[0] else: illFormedAst(n, cl.c.config) if branch != nil: result = replaceTypeVarsN(cl, branch) @@ -214,33 +323,69 @@ 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) + else: cl.c.semExpr(cl.c, n, {}, expectedType) + if not cl.allowMetaTypes and expectedType != nil: + assert result.kind notin nkCallKinds else: - var length = sonsLen(n) - if length > 0: - newSons(result, length) + if n.len > 0: + newSons(result, n.len) if start > 0: - result.sons[0] = n.sons[0] - for i in countup(start, length - 1): - result.sons[i] = replaceTypeVarsN(cl, n.sons[i]) + result[0] = n[0] + 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: return s + + # XXX: Bound symbols in default parameter expressions may reach here. + # We cannot process them, because `sym.n` may point to a proc body with + # cyclic references that will lead to an infinite recursion. + # Perhaps we should not use a black-list here, but a whitelist instead + # (e.g. skGenericParam and skType). + # Note: `s.magic` may be `mType` in an example such as: + # proc foo[T](a: T, b = myDefault(type(a))) + if s.kind in routineKinds+{skLet, skConst, skVar} or s.magic != mNone: + return s + #result = PSym(idTableGet(cl.symMap, s)) #if result == nil: - result = copySym(s, false) + #[ + + We cannot naively check for symbol recursions, because otherwise + object types A, B whould share their fields! + + import tables + + type + Table[S, T] = object + x: S + y: T + + G[T] = object + inodes: Table[int, T] # A + rnodes: Table[T, int] # B + + var g: G[string] + + ]# + 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.ast = replaceTypeVarsN(cl, s.ast) + 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 @@ -255,89 +400,102 @@ proc lookupTypeVar(cl: var TReplTypeVars, t: PType): PType = proc instCopyType*(cl: var TReplTypeVars, t: PType): PType = # XXX: relying on allowMetaTypes is a kludge - result = copyType(t, t.owner, cl.allowMetaTypes) + if cl.allowMetaTypes: + result = t.exactReplica + else: + result = copyType(t, cl.c.idgen, t.owner) + copyTypeProps(cl.c.graph, cl.c.idgen.module, result, t) + #cl.typeMap.topLayer.idTablePut(result, t) + if cl.allowMetaTypes: return result.flags.incl tfFromGeneric if not (t.kind in tyMetaTypes or (t.kind == tyStatic and t.n == nil)): result.flags.excl tfInstClearedFlags + else: + result.flags.excl tfHasAsgn when false: if newDestructors: result.assignment = nil - #result.destructor = nil + result.destructor = nil result.sink = nil -template typeBound(c, newty, oldty, field, info) = - let opr = newty.field - if opr != nil and sfFromGeneric notin opr.flags: - # '=' needs to be instantiated for generics when the type is constructed: - newty.field = c.instTypeBoundOp(c, opr, oldty, info, attachedAsgn, 1) - proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = # tyGenericInvocation[A, tyGenericInvocation[A, B]] # is difficult to handle: - const eqFlags = eqTypeFlags + {tfGcSafe} - var body = t.sons[0] - if body.kind != tyGenericBody: internalError(cl.c.config, cl.info, "no generic body") - var header: PType = t + 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(t) + result = searchInstTypes(cl.c.graph, t) - if result != nil and eqFlags*result.flags == eqFlags*t.flags: return - for i in countup(1, sonsLen(t) - 1): - var x = t.sons[i] + if result != nil and sameFlags(result, t): + when defined(reportCacheHits): + echo "Generic instantiation cached ", typeToString(result), " for ", typeToString(t) + return + for i in FirstGenericParamAt..<t.kidsLen: + var x = t[i] if x.kind in {tyGenericParam}: x = lookupTypeVar(cl, x) if x != nil: if header == t: header = instCopyType(cl, t) - header.sons[i] = x + header[i] = x propagateToOwner(header, x) else: propagateToOwner(header, x) if header != t: # search again after first pass: - result = searchInstTypes(header) - if result != nil and eqFlags*result.flags == eqFlags*t.flags: return + result = searchInstTypes(cl.c.graph, header) + if result != nil and sameFlags(result, t): + when defined(reportCacheHits): + echo "Generic instantiation cached ", typeToString(result), " for ", + typeToString(t), " header ", typeToString(header) + return else: header = instCopyType(cl, t) - result = newType(tyGenericInst, t.sons[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.sons[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(result) + cacheTypeInst(cl.c, result) else: - idTablePut(cl.localCache, t, result) + cl.localCache[t.itemId] = result let oldSkipTypedesc = cl.skipTypedesc cl.skipTypedesc = true - var typeMapLayer = newTypeMapLayer(cl) - cl.typeMap = addr(typeMapLayer) + cl.typeMap = newTypeMapLayer(cl) - for i in countup(1, sonsLen(t) - 1): - var x = replaceTypeVarsT(cl, t.sons[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.sons[i] = x + header[i] = x propagateToOwner(header, x) - cl.typeMap.put(body.sons[i-1], x) + cl.typeMap.put(body[i-1], x) - for i in countup(1, sonsLen(t) - 1): + 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.sons[i]) + rawAddSon(result, header[i], propagateHasAsgn = false) + + if body.kind == tyError: + return - let bbody = lastSon body + let bbody = last body var newbody = replaceTypeVarsT(cl, bbody) - let bodyIsNew = newbody != bbody cl.skipTypedesc = oldSkipTypedesc newbody.flags = newbody.flags + (t.flags + body.flags - tfInstClearedFlags) result.flags = result.flags + newbody.flags - tfInstClearedFlags @@ -350,67 +508,75 @@ 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) - let dc = newbody.deepCopy - if cl.allowMetaTypes == false: - if dc != nil and sfFromGeneric notin newbody.deepCopy.flags: + if not cl.allowMetaTypes: + let dc = cl.c.graph.getAttachedOp(newbody, attachedDeepCopy) + if dc != nil and sfFromGeneric notin dc.flags: # 'deepCopy' needs to be instantiated for # generics *when the type is constructed*: - newbody.deepCopy = cl.c.instTypeBoundOp(cl.c, dc, result, cl.info, - attachedDeepCopy, 1) - if bodyIsNew and newbody.typeInst == nil: - #doassert newbody.typeInst == nil + cl.c.graph.setAttachedOp(cl.c.module.position, newbody, attachedDeepCopy, + cl.c.instTypeBoundOp(cl.c, dc, result, cl.info, attachedDeepCopy, 1)) + if newbody.typeInst == nil: + # doAssert newbody.typeInst == nil newbody.typeInst = result if tfRefsAnonObj in newbody.flags and newbody.kind != tyGenericInst: # can come here for tyGenericInst too, see tests/metatype/ttypeor.nim # need to look into this issue later assert newbody.kind in {tyRef, tyPtr} - assert newbody.lastSon.typeInst == nil - newbody.lastSon.typeInst = result - if destructor in cl.c.features: - cl.c.typesWithOps.add((newbody, result)) - else: - typeBound(cl.c, newbody, result, assignment, cl.info) - let methods = skipTypes(bbody, abstractPtrs).methods - for col, meth in items(methods): - # we instantiate the known methods belonging to that type, this causes - # them to be registered and that's enough, so we 'discard' the result. - discard cl.c.instTypeBoundOp(cl.c, meth, result, cl.info, - attachedAsgn, col) + if newbody.last.typeInst != nil: + #internalError(cl.c.config, cl.info, "ref already has a 'typeInst' field") + discard + else: + 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] + # sigmatch: Formal myseq[=destroy.T] real myseq[system.int] + #echo "DESTROY: adding ", typeToString(newbody), " for ", typeToString(result, preferDesc) + let mm = skipTypes(bbody, abstractPtrs) + if tfFromGeneric notin mm.flags: + # bug #5479, prevent endless recursions here: + incl mm.flags, tfFromGeneric + for col, meth in methodsForGeneric(cl.c.graph, mm): + # we instantiate the known methods belonging to that type, this causes + # them to be registered and that's enough, so we 'discard' the result. + discard cl.c.instTypeBoundOp(cl.c, meth, result, cl.info, + attachedAsgn, col) + excl mm.flags, tfFromGeneric proc eraseVoidParams*(t: PType) = # transform '(): void' into '()' because old parts of the compiler really # don't deal with '(): void': - if t.sons[0] != nil and t.sons[0].kind == tyVoid: - t.sons[0] = nil + if t.returnType != nil and t.returnType.kind == tyVoid: + t.setReturnType nil - for i in 1 ..< t.sonsLen: + for i in FirstParamAt..<t.signatureLen: # don't touch any memory unless necessary - if t.sons[i].kind == tyVoid: + if t[i].kind == tyVoid: var pos = i - for j in i+1 ..< t.sonsLen: - if t.sons[j].kind != tyVoid: - t.sons[pos] = t.sons[j] - t.n.sons[pos] = t.n.sons[j] + 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 - return + break -proc skipIntLiteralParams*(t: PType) = - for i in 0 ..< t.sonsLen: - let p = t.sons[i] +proc skipIntLiteralParams*(t: PType; idgen: IdGenerator) = + for i, p in t.ikids: if p == nil: continue - let skipped = p.skipIntLit + let skipped = p.skipIntLit(idgen) if skipped != p: - t.sons[i] = skipped - if i > 0: t.n.sons[i].sym.typ = skipped + t[i] = skipped + if i > 0: t.n[i].sym.typ = skipped # when the typeof operator is used on a static input # param, the results gets infected with static as well: - if t.sons[0] != nil and t.sons[0].kind == tyStatic: - t.sons[0] = t.sons[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 @@ -428,33 +594,54 @@ 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} + 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: - localError(cl.c.config, cl.info, "cannot instantiate: '" & typeToString(t) & "'") + if cl.allowMetaTypes: return + localError( + cl.c.config, + cl.info, + "cannot instantiate: '" & + typeToString(t, preferDesc) & + "'; Maybe generic arguments are missing?") result = errorType(cl.c) #result = replaceTypeVarsT(cl, lastSon(t)) @@ -467,46 +654,76 @@ 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 of tyInt, tyFloat: - result = skipIntLit(t) + result = skipIntLit(t, cl.c.idgen) of tyTypeDesc: let lookup = cl.typeMap.lookup(t) if lookup != nil: result = lookup - if tfUnresolved in t.flags or cl.skipTypedesc: result = result.base - elif t.sons[0].kind != tyNone: - result = makeTypeDesc(cl.c, replaceTypeVarsT(cl, t.sons[0])) - - of tyUserTypeClass, tyStatic: + if result.kind != tyTypeDesc: + result = makeTypeDesc(cl.c, result) + elif tfUnresolved in t.flags or cl.skipTypedesc: + result = result.base + elif t.elementType.kind != tyNone: + result = makeTypeDesc(cl.c, replaceTypeVarsT(cl, t.elementType)) + + 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.sonsLen: - result.sons[i] = replaceTypeVarsT(cl, result.sons[i]) - propagateToOwner(result, result.lastSon) + cl.localCache[t.itemId] = result + for i in FirstGenericParamAt..<result.kidsLen: + result[i] = replaceTypeVarsT(cl, result[i]) + propagateToOwner(result, result.last) else: if containsGenericType(t): @@ -515,91 +732,135 @@ 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) - - for i in countup(0, sonsLen(result) - 1): - if result.sons[i] != nil: - var r = replaceTypeVarsT(cl, result.sons[i]) + cl.localCache[t.itemId] = result + + 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, resulti) if result.kind == tyObject: # carefully coded to not skip the precious tyGenericInst: - let r2 = r.skipTypes({tyAlias, tySink}) + let r2 = r.skipTypes({tyAlias, tySink, tyOwned}) if r2.kind in {tyPtr, tyRef}: r = skipTypes(r2, {tyPtr, tyRef}) - result.sons[i] = r + result[i] = r if result.kind != tyArray or i != 0: propagateToOwner(result, r) # bug #4677: Do not instantiate effect lists result.n = replaceTypeVarsN(cl, result.n, ord(result.kind==tyProc)) case result.kind of tyArray: - let idx = result.sons[0] + let idx = result.indexType internalAssert cl.c.config, idx.kind != tyStatic of tyObject, tyTuple: propagateFieldFlags(result, result.n) + if result.kind == tyObject and cl.c.computeRequiresInit(cl.c, result): + result.flags.incl tfRequiresInit of tyProc: eraseVoidParams(result) - skipIntLiteralParams(result) + skipIntLiteralParams(result, cl.c.idgen) + + of tyRange: + result.setIndexType result.indexType.skipTypes({tyStatic, tyDistinct}) else: discard + else: + # If this type doesn't refer to a generic type we may still want to run it + # trough replaceObjBranches in order to resolve any pending nkRecWhen nodes + result = t + + # Slow path, we have some work to do + if t.kind == tyRef and t.hasElementType and t.elementType.kind == tyObject and t.elementType.n != nil: + discard replaceObjBranches(cl, t.elementType.n) -proc instAllTypeBoundOp*(c: PContext, info: TLineInfo) = - if destructor notin c.features: return - var i = 0 - while i < c.typesWithOps.len: - let (newty, oldty) = c.typesWithOps[i] - typeBound(c, newty, oldty, destructor, info) - typeBound(c, newty, oldty, sink, info) - typeBound(c, newty, oldty, assignment, info) - inc i - setLen(c.typesWithOps, 0) - -proc initTypeVars*(p: PContext, typeMap: ptr LayeredIdTable, info: TLineInfo; + elif result.n != nil and t.kind == tyObject: + # Invalidate the type size as we may alter its structure + result.size = -1 + result.n = replaceObjBranches(cl, result.n) + +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, addr(typeMap), n.info, owner) + 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 replaceTypesForLambda*(p: PContext, pt: TIdTable, n: PNode; - original, new: PSym): PNode = +proc prepareTypesInBody*(p: PContext, pt: TypeMapping, n: PNode; + owner: PSym = nil): PNode = var typeMap = initLayeredTypeMap(pt) - var cl = initTypeVars(p, addr(typeMap), n.info, original) - idTablePut(cl.symMap, original, new) + var cl = initTypeVars(p, typeMap, n.info, owner) pushInfoContext(p.config, n.info) - result = replaceTypeVarsN(cl, n) + result = prepareNode(cl, n) popInfoContext(p.config) -proc generateTypeInstance*(p: PContext, pt: TIdTable, info: TLineInfo, +when false: + # deadcode + proc replaceTypesForLambda*(p: PContext, pt: TIdTable, n: PNode; + original, new: PSym): PNode = + var typeMap = initLayeredTypeMap(pt) + var cl = initTypeVars(p, typeMap, n.info, original) + idTablePut(cl.symMap, original, new) + pushInfoContext(p.config, n.info) + result = replaceTypeVarsN(cl, n) + popInfoContext(p.config) + +proc recomputeFieldPositions*(t: PType; obj: PNode; currPosition: var int) = + if t != nil and t.baseClass != nil: + let b = skipTypes(t.baseClass, skipPtrs) + recomputeFieldPositions(b, b.n, currPosition) + case obj.kind + of nkRecList: + for i in 0..<obj.len: recomputeFieldPositions(nil, obj[i], currPosition) + of nkRecCase: + recomputeFieldPositions(nil, obj[0], currPosition) + for i in 1..<obj.len: + recomputeFieldPositions(nil, lastSon(obj[i]), currPosition) + of nkSym: + obj.sym.position = currPosition + inc currPosition + else: discard "cannot happen" + +proc generateTypeInstance*(p: PContext, pt: TypeMapping, info: TLineInfo, t: PType): PType = + # Given `t` like Foo[T] + # pt: Table with type mappings: T -> int + # Desired result: Foo[int] + # proc (x: T = 0); T -> int ----> proc (x: int = 0) var typeMap = initLayeredTypeMap(pt) - var cl = initTypeVars(p, addr(typeMap), info, nil) + var cl = initTypeVars(p, typeMap, info, nil) pushInfoContext(p.config, info) result = replaceTypeVarsT(cl, t) popInfoContext(p.config) + let objType = result.skipTypes(abstractInst) + if objType.kind == tyObject: + 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, addr(typeMap), info, nil) + var cl = initTypeVars(p, typeMap, info, nil) cl.allowMetaTypes = true pushInfoContext(p.config, info) 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/service.nim b/compiler/service.nim deleted file mode 100644 index 0e82c03f8..000000000 --- a/compiler/service.nim +++ /dev/null @@ -1,68 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2015 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Implements the "compiler as a service" feature. - -import - times, commands, options, msgs, nimconf, - extccomp, strutils, os, platform, parseopt, idents, lineinfos - -when useCaas: - import net - -# We cache modules and the dependency graph. However, we don't check for -# file changes but expect the client to tell us about them, otherwise the -# repeated hash calculations may turn out to be too slow. - -var - curCaasCmd* = "" - lastCaasCmd* = "" - # in caas mode, the list of defines and options will be given at start-up? - # it's enough to check that the previous compilation command is the same? - -proc serve*(cache: IdentCache; action: proc (cache: IdentCache){.nimcall.}; config: ConfigRef) = - template execute(cmd) = - curCaasCmd = cmd - processCmdLine(passCmd2, cmd, config) - action(cache) - config.errorCounter = 0 - - let typ = getConfigVar(config, "server.type") - case typ - of "stdin": - while true: - var line = stdin.readLine.string - if line == "quit": quit() - execute line - echo "" - flushFile(stdout) - - of "tcp", "": - when useCaas: - var server = newSocket() - let p = getConfigVar(config, "server.port") - let port = if p.len > 0: parseInt(p).Port else: 6000.Port - server.bindAddr(port, getConfigVar(config, "server.address")) - var inp = "".TaintedString - server.listen() - var stdoutSocket = newSocket() - config.writelnHook = proc (line: string) = - stdoutSocket.send(line & "\c\L") - - while true: - accept(server, stdoutSocket) - stdoutSocket.readLine(inp) - execute inp.string - stdoutSocket.send("\c\L") - stdoutSocket.close() - else: - msgQuit "server.type not supported; compiler built without caas support" - else: - echo "Invalid server.type:", typ - msgQuit 1 diff --git a/compiler/sighashes.nim b/compiler/sighashes.nim index 0bf2b8459..d8dfe1828 100644 --- a/compiler/sighashes.nim +++ b/compiler/sighashes.nim @@ -9,88 +9,43 @@ ## Computes hash values for routine (proc, method etc) signatures. -import ast, md5, tables, ropes -from hashes import Hash -from astalgo import debug +import ast, ropes, modulegraphs, options, msgs, pathutils +from std/hashes import Hash +import std/tables import types -from strutils import startsWith, contains - -when false: - type - SigHash* = uint32 ## a hash good enough for a filename or a proc signature - - proc sdbmHash(hash: SigHash, c: char): SigHash {.inline.} = - return SigHash(c) + (hash shl 6) + (hash shl 16) - hash - - template `&=`*(x: var SigHash, c: char) = x = sdbmHash(x, c) - template `&=`*(x: var SigHash, s: string) = - for c in s: x = sdbmHash(x, c) - -else: - type - SigHash* = distinct Md5Digest - - const - cb64 = [ - "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", - "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", - "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", - "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", - "0", "1", "2", "3", "4", "5", "6", "7", "8", "9a", - "9b", "9c"] - - proc toBase64a(s: cstring, len: int): string = - ## encodes `s` into base64 representation. - result = newStringOfCap(((len + 2) div 3) * 4) - result.add '_' - var i = 0 - while i < len - 2: - let a = ord(s[i]) - let b = ord(s[i+1]) - let c = ord(s[i+2]) - result.add cb64[a shr 2] - result.add cb64[((a and 3) shl 4) or ((b and 0xF0) shr 4)] - result.add cb64[((b and 0x0F) shl 2) or ((c and 0xC0) shr 6)] - result.add cb64[c and 0x3F] - inc(i, 3) - if i < len-1: - let a = ord(s[i]) - let b = ord(s[i+1]) - result.add cb64[a shr 2] - result.add cb64[((a and 3) shl 4) or ((b and 0xF0) shr 4)] - result.add cb64[((b and 0x0F) shl 2)] - elif i < len: - let a = ord(s[i]) - result.add cb64[a shr 2] - result.add cb64[(a and 3) shl 4] - - proc `$`*(u: SigHash): string = - toBase64a(cast[cstring](unsafeAddr u), sizeof(u)) - 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, i: BiggestInt) = - md5Update(c, cast[cstring](unsafeAddr i), sizeof(i)) - - template lowlevel(v) = - md5Update(c, cast[cstring](unsafeAddr(v)), sizeof(v)) - - proc `==`*(a, b: SigHash): bool = - # {.borrow.} - result = equalMem(unsafeAddr a, unsafeAddr b, sizeof(a)) - - proc hash*(u: SigHash): Hash = - result = 0 - for x in 0..3: - result = (result shl 8) or u.MD5Digest[x].int +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) = + # 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) = + md5Update(c, cast[cstring](unsafeAddr f), sizeof(f)) +proc `&=`(c: var MD5Context, s: SigHash) = + md5Update(c, cast[cstring](unsafeAddr s), sizeof(s)) +template lowlevel(v) = + md5Update(c, cast[cstring](unsafeAddr(v)), sizeof(v)) + + type ConsiderFlag* = enum CoProc CoType CoOwnerSig CoIgnoreRange + CoConsiderOwned + 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" @@ -100,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) = +proc hashTree(c: var MD5Context, n: PNode; flags: set[ConsiderFlag]; conf: ConfigRef) = if n == nil: c &= "\255" return @@ -128,6 +88,8 @@ proc hashTree(c: var MD5Context, n: PNode) = c &= n.ident.s of nkSym: hashSym(c, n.sym) + if CoHashTypeInsideNode in flags and n.sym.typ != nil: + hashType(c, n.sym.typ, flags, conf) of nkCharLit..nkUInt64Lit: let v = n.intVal lowlevel v @@ -137,20 +99,24 @@ proc hashTree(c: var MD5Context, n: PNode) = of nkStrLit..nkTripleStrLit: c &= n.strVal else: - for i in 0..<n.len: hashTree(c, n.sons[i]) + 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 countup(0, sonsLen(t) - 1): - c.hashType t.sons[i], flags + for a in t.kids: + c.hashType a, flags, conf of tyDistinct: - if CoType in flags: - c.hashType t.lastSon, flags + if CoDistinct in flags: + if t.sym != nil: c.hashSym(t.sym) + if t.sym == nil or tfFromGeneric in t.flags: + c.hashType t.elementType, flags, conf + elif CoType in flags or t.sym == nil: + c.hashType t.elementType, flags, conf else: c.hashSym(t.sym) of tyGenericInst: @@ -159,12 +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 - 2: - c.hashType t.sons[i], flags + c.hashType normalizedType.genericHead, flags, conf + for _, a in normalizedType.genericInstParams: + c.hashType a, flags, conf else: - c.hashType t.lastSon, flags - of tyAlias, tySink, tyUserTypeClasses: - c.hashType t.lastSon, flags + c.hashType t.skipModifier, flags, conf + of tyAlias, tySink, tyUserTypeClasses, tyInferred: + c.hashType t.skipModifier, flags, conf + of tyOwned: + if CoConsiderOwned in flags: + c &= char(t.kind) + 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``: @@ -173,67 +144,86 @@ proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]) = c.hashSym(t.sym) of tyObject, tyEnum: if t.typeInst != nil: - assert t.typeInst.kind == tyGenericInst - for i in countup(0, sonsLen(t.typeInst) - 2): - c.hashType t.typeInst.sons[i], flags + # prevent against infinite recursions here, see bug #8883: + let inst = t.typeInst + t.typeInst = nil + assert inst.kind == tyGenericInst + c.hashType inst.genericHead, flags, conf + for _, a in inst.genericInstParams: + c.hashType a, flags, conf + t.typeInst = inst return c &= char(t.kind) # Every cyclic type in Nim need to be constructed via some 't.sym', so this # is actually safe without an infinite recursion check: if t.sym != nil: - #if "Future:" in t.sym.name.s and t.typeInst == nil: - # writeStackTrace() - # echo "yes ", t.sym.name.s - # #quit 1 - if CoOwnerSig in flags: - c.hashTypeSym(t.sym) + if {sfCompilerProc} * t.sym.flags != {}: + doAssert t.sym.loc.snippet != "" + # The user has set a specific name for this type + c &= t.sym.loc.snippet + elif CoOwnerSig in flags: + c.hashTypeSym(t.sym, conf) else: c.hashSym(t.sym) - if {sfAnon, sfGenSym} * t.sym.flags != {}: - # generated object names can be identical, so we need to - # disambiguate furthermore by hashing the field types and names: - # mild hack to prevent endless recursions (makes nimforum compile again): - let oldFlags = t.sym.flags - t.sym.flags = t.sym.flags - {sfAnon, sfGenSym} - let n = t.n - for i in 0 ..< n.len: - assert n[i].kind == nkSym - let s = n[i].sym - c.hashSym s - c.hashType s.typ, flags - t.sym.flags = oldFlags + + 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 = 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 + # type name. + c &= ".empty" else: c &= t.id - if t.len > 0 and t.sons[0] != nil: - hashType c, t.sons[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(sonsLen(t.n) == sonsLen(t)) - for i in countup(0, sonsLen(t.n) - 1): - assert(t.n.sons[i].kind == nkSym) - c &= t.n.sons[i].sym.name.s + for i in 0..<t.n.len: + assert(t.n[i].kind == nkSym) + c &= t.n[i].sym.name.s c &= ':' - c.hashType(t.sons[i], flags+{CoIgnoreRange}) + c.hashType(t.n[i].sym.typ, flags+{CoIgnoreRange}, conf) c &= ',' else: - for i in countup(0, sonsLen(t) - 1): c.hashType t.sons[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.sons[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.sons[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 ") @@ -243,22 +233,27 @@ 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.sons[0], flags) + c.hashType(t.returnType, flags, conf) else: - for i in 0..<t.len: c.hashType(t.sons[i], flags) + for a in t.signature: c.hashType(a, flags, conf) c &= char(t.callConv) - if CoType notin flags: - if tfNoSideEffect in t.flags: c &= ".noSideEffect" - if tfThread in t.flags: c &= ".thread" + # 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 + # function which changes its purity and suddenly the cached pointer is danglign) + # IMHO anything that doesn't affect the overload resolution shouldn't be part of the mangling... + # if CoType notin flags: + # if tfNoSideEffect in t.flags: c &= ".noSideEffect" + # if tfThread in t.flags: c &= ".thread" if tfVarargs in t.flags: c &= ".varargs" of tyArray: c &= char(t.kind) - for i in 0..<t.len: c.hashType(t.sons[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.sons[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): @@ -275,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} - md5Final c, result.Md5Digest + 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 @@ -302,10 +299,11 @@ proc hashProc*(s: PSym): SigHash = # hash, we also hash the line information. This is pretty bad, but the best # solution for now: #c &= s.info.line - md5Final c, result.Md5Digest + 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 @@ -318,10 +316,11 @@ proc hashNonProc*(s: PSym): SigHash = # might cause: if s.kind == skParam: c &= s.position - md5Final c, result.Md5Digest + 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 @@ -331,15 +330,90 @@ proc hashOwner*(s: PSym): SigHash = c &= "." c &= m.name.s - md5Final c, result.Md5Digest + md5Final c, result.MD5Digest + +proc sigHash*(s: PSym; conf: ConfigRef): SigHash = + if s.kind in routineKinds and s.typ != nil: + result = hashProc(s, conf) + else: + result = hashNonProc(s) + +proc symBodyDigest*(graph: ModuleGraph, sym: PSym): SigHash + +proc hashBodyTree(graph: ModuleGraph, c: var MD5Context, n: PNode) + +proc hashVarSymBody(graph: ModuleGraph, c: var MD5Context, s: PSym) = + assert: s.kind in {skParam, skResult, skVar, skLet, skConst, skForVar} + if sfGlobal notin s.flags: + c &= char(s.kind) + c &= s.name.s + else: + 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 in {nkIdentDefs, nkConstDef}: + hashBodyTree(graph, c, s.ast[^1]) + else: + hashBodyTree(graph, c, s.ast) + +proc hashBodyTree(graph: ModuleGraph, c: var MD5Context, n: PNode) = + # hash Nim tree recursing into simply + if n == nil: + c &= "nil" + return + c &= char(n.kind) + case n.kind + of nkEmpty, nkNilLit, nkType: discard + of nkIdent: + c &= n.ident.s + of nkSym: + if n.sym.kind in skProcKinds: + c &= symBodyDigest(graph, n.sym) + elif n.sym.kind in {skParam, skResult, skVar, skLet, skConst, skForVar}: + hashVarSymBody(graph, c, n.sym) + else: + c &= hashNonProc(n.sym) + of nkProcDef, nkFuncDef, nkTemplateDef, nkMacroDef: + discard # we track usage of proc symbols not their definition + of nkCharLit..nkUInt64Lit: + c &= n.intVal + of nkFloatLit..nkFloat64Lit: + c &= n.floatVal + of nkStrLit..nkTripleStrLit: + c &= n.strVal + else: + for i in 0..<n.len: + hashBodyTree(graph, c, n[i]) + +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 = default(MD5Context) + md5Init(c) + 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 + + if sym.ast != nil: + md5Init(c) + c.md5Update(cast[cstring](result.addr), sizeof(result)) + hashBodyTree(graph, c, getBody(graph, sym)) + c.md5Final(result.MD5Digest) + 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 9a3c75261..6ea2c7bb5 100644 --- a/compiler/sigmatch.nim +++ b/compiler/sigmatch.nim @@ -11,20 +11,33 @@ ## the call to overloaded procs, generic procs and operators. import - intsets, ast, astalgo, semdata, types, msgs, renderer, lookups, semtypinst, - magicsys, condsyms, idents, lexer, options, parampatterns, strutils, trees, - linter, lineinfos + ast, astalgo, semdata, types, msgs, renderer, lookups, semtypinst, + magicsys, idents, lexer, options, parampatterns, trees, + linter, lineinfos, lowerings, modulegraphs, concepts -when defined(booting) or defined(nimsuggest): - import docgen +import std/[intsets, strutils, tables] + +when defined(nimPreviewSlimSystem): + import std/assertions type + MismatchKind* = enum + kUnknown, kAlreadyGiven, kUnknownNamedParam, kTypeMismatch, kVarNeeded, + kMissingParam, kExtraArg, kPositionalAlreadyGiven, + kGenericParamTypeMismatch, kMissingGenericParam, kExtraGenericParam + + MismatchInfo* = object + kind*: MismatchKind # reason for mismatch + arg*: int # position of provided arguments that mismatches + formal*: PSym # parameter that mismatches against provided argument + # its position can differ from `arg` because of varargs + TCandidateState* = enum csEmpty, csMatch, csNoMatch CandidateError* = object sym*: PSym - unmatchedVarParam*, firstMismatch*: int + firstMismatch*: MismatchInfo diagnostics*: seq[string] enabled*: bool @@ -43,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 @@ -56,7 +69,6 @@ type # a distrinct type typedescMatched*: bool isNoCall*: bool # misused for generic type instantiations C[T] - mutabilityProblem*: uint8 # tyVar mismatch inferredTypes: seq[PType] # inferred types during the current signature # matching. they will be reset if the matching # is not successful. may replace the bindings @@ -69,171 +81,290 @@ 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 - firstMismatch*: int # position of the first type mismatch for - # better error messages + # to prefer closest father object type + inheritancePenalty: int + firstMismatch*: MismatchInfo # mismatch info for better error messages diagnosticsEnabled*: bool TTypeRelFlag* = enum 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*(conf: ConfigRef; info: TLineInfo, s: PSym; usageSym: var PSym) - -template hasFauxMatch*(c: TCandidate): bool = c.fauxMatch != tyNone +proc markUsed*(c: PContext; info: TLineInfo, s: PSym; checkStyle = true) +proc markOwnerModuleAsUsed*(c: PContext; s: PSym) 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.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.} = - idTablePut(c.bindings, key, val.skipIntLit) + ## Given: proc foo[T](x: T); foo(4) + ## key: 'T' + ## val: 'int' (typeof(4)) + when false: + let old = idTableGet(c.bindings, key) + if old != nil: + echo "Putting ", typeToString(key), " ", typeToString(val), " and old is ", typeToString(old) + if typeToString(old) == "float32": + writeStackTrace() + if c.c.module.name.s == "temp3": + echo "binding ", key, " -> ", val + idTablePut(c.bindings, key, val.skipIntLit(c.c.idgen)) + +proc typeRel*(c: var TCandidate, f, aOrig: PType, + flags: TTypeRelFlags = {}): TTypeRelation + +proc matchGenericParam(m: var TCandidate, formal: PType, n: PNode) = + var arg = n.typ + if m.c.inGenericContext > 0: + # don't match yet-unresolved generic instantiations + while arg != nil and arg.kind == tyGenericParam: + arg = idTableGet(m.bindings, arg) + if arg == nil or arg.containsUnresolvedType: + m.state = csNoMatch + return + # fix up the type to get ready to match formal: + var formalBase = formal + while formalBase.kind == tyGenericParam and + formalBase.genericParamHasConstraints: + formalBase = formalBase.genericConstraint + if formalBase.kind == tyStatic and arg.kind != tyStatic: + # maybe call `paramTypesMatch` here, for now be conservative + if n.kind in nkSymChoices: n.flags.excl nfSem + let evaluated = m.c.semTryConstExpr(m.c, n, formalBase.skipTypes({tyStatic})) + if evaluated != nil: + arg = newTypeS(tyStatic, m.c, son = evaluated.typ) + arg.n = evaluated + elif formalBase.kind == tyTypeDesc: + if arg.kind != tyTypeDesc: + arg = makeTypeDesc(m.c, arg) + else: + arg = arg.skipTypes({tyTypeDesc}) + let tm = typeRel(m, formal, arg) + if tm in {isNone, isConvertible}: + m.state = csNoMatch + m.firstMismatch.kind = kGenericParamTypeMismatch + return -proc initCandidate*(ctx: PContext, c: var TCandidate, callee: PSym, +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(sonsLen(typeParams), sonsLen(binding)-1): - var formalTypeParam = typeParams.sons[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) + 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 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 in {isNone, isInferred, isInferredConvertible}: + if winner == 1: return 0 + winner = -1 + result = winner 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, - tyOpenArray, tyVarargs, tySet, tyRange, tySequence, tyGenericBody, - tyLent: - 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: - let branchSum = branch.sumGeneric + for branch in t.kids: + let branchSum = sumGeneric(branch) if branchSum > maxBranch: maxBranch = branchSum - inc result, maxBranch + 1 + inc result, maxBranch break - of tyVar: - t = t.sons[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.sons[i] != nil: - result += t.sons[i].sumGeneric + 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 t.sons[0].sumGeneric + 1 - of tyGenericParam, tyExpr, tyStmt: 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 - -#var ggDebug: bool + 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.sons[i].sumGeneric - let y = b.sons[i].sumGeneric - #if ggDebug: - #echo "came herA ", typeToString(a.sons[i]), " ", x - #echo "came herB ", typeToString(b.sons[i]), " ", y + 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 @@ -248,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.sons[i].sumGeneric - for i in 1 ..< b.len: y += b.sons[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) = @@ -261,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 @@ -272,19 +412,22 @@ 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 - # prefer more specialized generic over more general generic: - result = complexDisambiguation(a.callee, b.callee) - # only as a last resort, consider scoping: + 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 + # only as a last resort, consider scoping: result = a.calleeScope - b.calleeScope proc argTypeToString(arg: PNode; prefer: TPreferedDesc): string = if arg.kind in nkSymChoices: result = typeToString(arg[0].typ, prefer) - for i in 1 ..< arg.len: + for i in 1..<arg.len: result.add(" | ") result.add typeToString(arg[i].typ, prefer) elif arg.typ == nil: @@ -292,129 +435,144 @@ proc argTypeToString(arg: PNode; prefer: TPreferedDesc): string = else: result = arg.typ.typeToString(prefer) -proc describeArgs*(c: PContext, n: PNode, startIdx = 1; - prefer: TPreferedDesc = preferName): string = +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.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) + +proc describeArg*(c: PContext, n: PNode, i: int, startIdx = 1; prefer = preferName): string = result = "" - for i in countup(startIdx, n.len - 1): - var arg = n.sons[i] - if n.sons[i].kind == nkExprEqExpr: - add(result, renderTree(n.sons[i].sons[0])) - add(result, ": ") - if arg.typ.isNil and arg.kind notin {nkStmtList, nkDo}: - # XXX we really need to 'tryExpr' here! - arg = c.semOperand(c, n.sons[i].sons[1]) - n.sons[i].typ = arg.typ - n.sons[i].sons[1] = arg - else: - if arg.typ.isNil and arg.kind notin {nkStmtList, nkDo, nkElse, - nkOfBranch, nkElifBranch, - nkExceptBranch}: - arg = c.semOperand(c, n.sons[i]) - n.sons[i] = arg - if arg.typ != nil and arg.typ.kind == tyError: return - add(result, argTypeToString(arg, prefer)) - if i != sonsLen(n) - 1: add(result, ", ") - -proc typeRelImpl*(c: var TCandidate, f, aOrig: PType, - flags: TTypeRelFlags = {}): TTypeRelation - -const traceTypeRel = false - -when traceTypeRel: - var nextTypeRel = 0 - -template typeRel*(c: var TCandidate, f, aOrig: PType, - flags: TTypeRelFlags = {}): TTypeRelation = - when traceTypeRel: - var enteringAt = nextTypeRel - if mdbg: - inc nextTypeRel - echo "----- TYPE REL ", enteringAt - debug f - debug aOrig - # writeStackTrace() - - let r = typeRelImpl(c, f, aOrig, flags) - - when traceTypeRel: - if enteringAt != nextTypeRel: - echo "----- TYPE REL ", enteringAt, " RESULT: ", r - - r - -proc concreteType(c: TCandidate, t: PType): PType = + 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 = case t.kind - of tyNil: - result = nil # what should it be? of tyTypeDesc: if c.isNoCall: result = t else: result = nil of tySequence, tySet: - if t.sons[0].kind == tyEmpty: result = nil + if t.elementType.kind == tyEmpty: result = nil else: result = t - of tyGenericParam, tyAnything: + 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: # proc sort[T](cmp: proc(a, b: T): int = cmp) if result.kind != tyGenericParam: break of tyGenericInvocation: - result = t - doAssert(false, "cannot resolve type: " & typeToString(t)) + result = nil + of tyOwned: + # bug #11257: the comparison system.`==`[T: proc](x, y: T) works + # better without the 'owned' type: + 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 - isIntLit(ab) and ab.n.intVal >= firstOrd(nil, f) and - ab.n.intVal <= lastOrd(nil, f): + 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 - # not depent on the target integer size configurations! + # not depend on the target integer size configurations! # 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 == 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 a.sons[0].kind in {tyInt..tyInt64, - tyUInt8..tyUInt32} and - a.n[0].intVal >= firstOrd(nil, f) and - a.n[1].intVal <= lastOrd(nil, f): + 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..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 depent on the target integer size configurations! + # not depend on the target integer size configurations! result = isConvertible else: result = isNone - #elif f.kind == tyInt and k in {tyInt..tyInt32}: result = isIntConv - #elif f.kind == tyUInt and k in {tyUInt..tyUInt32}: result = isIntConv -proc isConvertibleToRange(f, a: PType): bool = - # be less picky for tyRange, as that it is used for array indexing: +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 - of tyInt, tyInt64: result = true - of tyInt8: result = a.kind in {tyInt8, tyInt} - of tyInt16: result = a.kind in {tyInt8, tyInt16, tyInt} - of tyInt32: result = a.kind in {tyInt8, tyInt16, tyInt32, tyInt} - of tyUInt, tyUInt64: result = true - of tyUInt8: result = a.kind in {tyUInt8, tyUInt} - of tyUInt16: result = a.kind in {tyUInt8, tyUInt16, tyUInt} - of tyUInt32: result = a.kind in {tyUInt8, tyUInt16, tyUInt32, tyUInt} + of tyInt8: result = isIntLit(a) or a.kind in {tyInt8} + 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: 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 .. 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} and - a.kind in {tyFloat..tyFloat128}: - result = true + 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: @@ -431,13 +589,52 @@ 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 countup(1, sonsLen(fGenericOrigin) - 1): - let x = PType(idTableGet(c.bindings, fGenericOrigin.sons[i])) - if x == nil: - put(c, fGenericOrigin.sons[i], last.sons[i]) + if fGenericOrigin != nil and last.kind == tyGenericInst and + 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]) proc isObjectSubtype(c: var TCandidate; a, f, fGenericOrigin: PType): int = var t = a @@ -445,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.sons[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) @@ -467,22 +665,25 @@ proc skipToObject(t: PType; skipped: var SkippedPtr): PType = while r != nil: case r.kind of tyGenericInvocation: - r = r.sons[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: - 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 = nil): bool = +proc isGenericSubtype(c: var TCandidate; a, f: PType, d: var int, fGenericOrigin: PType): bool = assert f.kind in {tyGenericInst, tyGenericInvocation, tyGenericBody} var askip = skippedNone var fskip = skippedNone @@ -494,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.sons[0] + t = t.baseClass if t == nil: break last = t t = t.skipToObject(askip) @@ -503,32 +704,39 @@ 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 sonsLen(a) == sonsLen(f): + elif sameTupleLengths(a, f): result = isEqual let firstField = if f.kind == tyTuple: 0 else: 1 - for i in countup(firstField, sonsLen(f) - 1): - var m = typeRel(c, f.sons[i], a.sons[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 countup(0, sonsLen(f.n) - 1): + for i in 0..<f.n.len: # check field names: - if f.n.sons[i].kind != nkSym: return isNone - elif a.n.sons[i].kind != nkSym: return isNone + if f.n[i].kind != nkSym: return isNone + elif a.n[i].kind != nkSym: return isNone else: - var x = f.n.sons[i].sym - var y = a.n.sons[i].sym - if f.kind == tyObject and typeRel(c, x.typ, y.typ) < isSubtype: + var x = f.n[i].sym + var y = a.n[i].sym + if f.kind == tyObject and typeRel(c, x.typ, y.typ, flags) < isSubtype: return isNone if x.name.id != y.name.id: return isNone @@ -536,13 +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} or a.kind in {tyVar, tyLent}) + 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: @@ -559,17 +770,20 @@ 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: if f.isMetaType: # We are matching a generic proc (as proc param) # to another generic type appearing in the proc - # signature. There is a change that the target + # signature. There is a chance that the target # type is already fully-determined, so we are # going to try resolve it - f = generateTypeInstance(c.c, c.bindings, c.call.info, f) + if c.call != nil: + f = generateTypeInstance(c.c, c.bindings, c.call.info, f) + else: + f = nil if f == nil or f.isMetaType: # no luck resolving the type, so the inference fails return isBothMetaConvertible @@ -578,12 +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) - if result <= isSubtype or inconsistentVarTypes(f, a): + if result <= isSubrange or inconsistentVarTypes(f, a): result = isNone #if result == isEqual: @@ -592,72 +808,67 @@ proc procParamTypeRel(c: var TCandidate, f, a: PType): TTypeRelation = proc procTypeRel(c: var TCandidate, f, a: PType): TTypeRelation = case a.kind of tyProc: - if sonsLen(f) != sonsLen(a): 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 # Note: We have to do unification for the parameters before the # return type! - for i in 1 ..< f.sonsLen: - checkParam(f.sons[i], a.sons[i]) + for i in 1..<f.len: + checkParam(f[i], a[i]) - if f.sons[0] != nil: - if a.sons[0] != nil: - checkParam(f.sons[0], a.sons[0]) + if f[0] != nil: + if a[0] != nil: + checkParam(f[0], a[0]) else: return isNone - elif a.sons[0] != nil: + 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 == ccDefault: - 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): + if not c.c.graph.compatibleProps(c.c.graph, f, a): return isNone of tyNil: result = f.allowsNil - else: discard + else: result = isNone proc typeRangeRel(f, a: PType): TTypeRelation {.noinline.} = - let - a0 = firstOrd(nil, a) - a1 = lastOrd(nil, a) - f0 = firstOrd(nil, f) - f1 = lastOrd(nil, f) - if a0 == f0 and a1 == f1: - result = isEqual - elif a0 >= f0 and a1 <= f1: - result = isConvertible - elif a0 <= f1 and f0 <= a1: - # X..Y and C..D overlap iff (X <= D and C <= Y) - result = isConvertible + template checkRange[T](a0, a1, f0, f1: T): TTypeRelation = + if a0 == f0 and a1 == f1: + isEqual + elif a0 >= f0 and a1 <= f1: + isConvertible + elif a0 <= f1 and f0 <= a1: + # X..Y and C..D overlap iff (X <= D and C <= Y) + isConvertible + else: + isNone + + if f.isOrdinalType: + checkRange(firstOrd(nil, a), lastOrd(nil, a), firstOrd(nil, f), lastOrd(nil, f)) else: - result = isNone + checkRange(firstFloat(a), lastFloat(a), firstFloat(f), lastFloat(f)) + proc matchUserTypeClass*(m: var TCandidate; ff, a: PType): PType = var c = m.c typeClass = ff.skipTypes({tyUserTypeClassInst}) body = typeClass.n[3] - matchedConceptContext: TMatchedConcept + matchedConceptContext = TMatchedConcept() prevMatchedConcept = c.matchedConcept prevCandidateType = typeClass[0][0] @@ -670,27 +881,27 @@ proc matchUserTypeClass*(m: var TCandidate; ff, a: PType): PType = openScope(c) matchedConceptContext.candidateType = a - typeClass[0].sons[0] = a + typeClass[0][0] = a c.matchedConcept = addr(matchedConceptContext) defer: c.matchedConcept = prevMatchedConcept - typeClass[0].sons[0] = prevCandidateType + 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): + for i in 1..<(ff.len - 1): var - typeParamName = ff.base.sons[i-1].sym.name - typ = ff.sons[i] - param: PSym - alreadyBound = PType(idTableGet(m.bindings, typ)) + typeParamName = ff.base[i-1].sym.name + typ = ff[i] + param: PSym = nil + alreadyBound = idTableGet(m.bindings, typ) if alreadyBound != nil: typ = alreadyBound template paramSym(kind): untyped = - newSym(kind, typeParamName, typeClass.sym, typeClass.sym.info, {}) + newSym(kind, typeParamName, c.idgen, typeClass.sym, typeClass.sym.info, {}) block addTypeParam: for prev in typeParams: @@ -703,27 +914,29 @@ proc matchUserTypeClass*(m: var TCandidate; ff, a: PType): PType = of tyStatic: param = paramSym skConst param.typ = typ.exactReplica + #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, 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) - typeParams.safeAdd((param, typ)) + typeParams.add((param, typ)) addDecl(c, param) var - oldWriteHook: type(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 @@ -736,7 +949,7 @@ proc matchUserTypeClass*(m: var TCandidate; ff, a: PType): PType = diagnostics = @[] flags = {efExplain} m.c.config.writelnHook = proc (s: string) = - if errorPrefix == nil: errorPrefix = typeClass.sym.name.s & ":" + if errorPrefix.len == 0: errorPrefix = typeClass.sym.name.s & ":" let msg = s.replace("Error:", errorPrefix) if oldWriteHook != nil: oldWriteHook msg diagnostics.add msg @@ -746,7 +959,7 @@ proc matchUserTypeClass*(m: var TCandidate; ff, a: PType): PType = if collectDiagnostics: m.c.config.writelnHook = oldWriteHook for msg in diagnostics: - m.diagnostics.safeAdd msg + m.diagnostics.add msg m.diagnosticsEnabled = true if checkedBody == nil: return nil @@ -760,7 +973,8 @@ proc matchUserTypeClass*(m: var TCandidate; ff, a: PType): PType = if ff.kind == tyUserTypeClassInst: result = generateTypeInstance(c, m.bindings, typeClass.sym.info, ff) else: - result = copyType(ff, ff.owner, true) + result = ff.exactReplica + #copyType(ff, c.idgen, ff.owner) result.n = checkedBody @@ -783,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)]) @@ -792,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 = @@ -815,9 +1033,6 @@ proc inferStaticParam*(c: var TCandidate, lhs: PNode, rhs: BiggestInt): bool = # if lhs.kind in nkCallKinds and lhs[0].kind == nkSym: case lhs[0].sym.magic - of mUnaryLt: - return inferStaticParam(c, lhs[1], rhs + 1) - of mAddI, mAddU, mInc, mSucc: if lhs[1].kind == nkIntLit: return inferStaticParam(c, lhs[2], rhs - lhs[1].intVal) @@ -853,16 +1068,21 @@ proc inferStaticParam*(c: var TCandidate, lhs: PNode, rhs: BiggestInt): bool = if lhs[2].kind == nkIntLit: return inferStaticParam(c, lhs[1], rhs shl lhs[2].intVal) + of mAshrI: + if lhs[2].kind == nkIntLit: + return inferStaticParam(c, lhs[1], ashr(rhs, lhs[2].intVal)) + of mUnaryMinusI: return inferStaticParam(c, lhs[1], -rhs) - of mUnaryPlusI, mToInt, mToBiggestInt: + of mUnaryPlusI: return inferStaticParam(c, lhs[1], rhs) 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: @@ -885,14 +1105,15 @@ proc inferStaticsInRange(c: var TCandidate, allowUnresolved = true) let upperBound = tryResolvingStaticExpr(c, inferred.n[1], allowUnresolved = true) - template doInferStatic(e: PNode, r: BiggestInt) = + template doInferStatic(e: PNode, r: Int128) = var exp = e var rhs = r - if inferStaticParam(c, exp, rhs): + if inferStaticParam(c, exp, toInt64(rhs)): return isGeneric 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: @@ -901,29 +1122,42 @@ proc inferStaticsInRange(c: var TCandidate, return isNone doInferStatic(upperBound, lengthOrd(c.c.config, concrete) + lowerBound.intVal - 1) elif upperBound.kind == nkIntLit: - doInferStatic(lowerBound, upperBound.intVal + 1 - lengthOrd(c.c.config, concrete)) + 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}: + 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 assert f.kind == a.kind template baseTypesCheck(lhs, rhs: PType): bool = - lhs.kind notin {tyPtr, tyRef, tyVar, tyLent} and + lhs.kind notin {tyPtr, tyRef, tyVar, tyLent, tyOwned} and typeRel(c, lhs, rhs, {trNoCovariance}) == isSubtype case f.kind - of tyRef, tyPtr: + of tyRef, tyPtr, tyOwned: return baseTypesCheck(f.base, a.base) of tyGenericInst: let body = f.base return body == a.base and - a.sonsLen == 3 and - tfWeakCovariant notin body.sons[0].flags and - baseTypesCheck(f.sons[1], a.sons[1]) + a.len == 3 and + tfWeakCovariant notin body[0].flags and + baseTypesCheck(f[1], a[1]) else: return false @@ -947,8 +1181,11 @@ when false: of tyFloat64: greater({tyFloat128}) else: discard -proc typeRelImpl(c: var TCandidate, f, aOrig: PType, - flags: TTypeRelFlags = {}): TTypeRelation = +template skipOwned(a) = + if a.kind == tyOwned: a = a.skipTypes({tyOwned, tyGenericInst}) + +proc typeRel(c: var TCandidate, f, aOrig: PType, + flags: TTypeRelFlags = {}): TTypeRelation = # typeRel can be used to establish various relationships between types: # # 1) When used with concrete types, it will check for type equivalence @@ -959,8 +1196,8 @@ proc typeRelImpl(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. @@ -968,7 +1205,12 @@ proc typeRelImpl(c: var TCandidate, f, aOrig: PType, result = isNone assert(f != nil) - if f.kind == tyExpr: + when declared(deallocatedRefId): + let corrupt = deallocatedRefId(cast[pointer](f)) + if corrupt != 0: + c.c.config.quitOrRaise "it's corrupt " & $corrupt + + if f.kind == tyUntyped: if aOrig != nil: put(c, f, aOrig) return isGeneric @@ -978,7 +1220,8 @@ proc typeRelImpl(c: var TCandidate, f, aOrig: PType, useTypeLoweringRuleInTypeClass = c.c.matchedConcept != nil and not c.isNoCall and f.kind != tyTypeDesc and - tfExplicit notin aOrig.flags + tfExplicit notin aOrig.flags and + tfConceptMatchedTypeSym notin aOrig.flags aOrig = if useTypeLoweringRuleInTypeClass: aOrig.skipTypes({tyTypeDesc}) @@ -988,13 +1231,13 @@ proc typeRelImpl(c: var TCandidate, f, aOrig: PType, if aOrig.kind == tyInferred: let prev = aOrig.previouslyInferred if prev != nil: - return typeRel(c, f, prev) + return typeRel(c, f, prev, flags) else: var candidate = f 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 @@ -1009,44 +1252,49 @@ proc typeRelImpl(c: var TCandidate, f, aOrig: PType, else: discard - result = typeRel(c, aOrig.base, candidate) + result = typeRel(c, aOrig.base, candidate, flags) if result != isNone: - c.inferredTypes.safeAdd aOrig - aOrig.sons.add candidate + c.inferredTypes.add aOrig + aOrig.add candidate result = isEqual return template doBind: bool = trDontBind notin flags - # var and static arguments match regular modifier-free types - var a = maybeSkipDistinct(c, aOrig.skipTypes({tyStatic, tyVar, tyLent}), c.calleeSym) + # var, sink and static arguments match regular modifier-free types + var a = maybeSkipDistinct(c, aOrig.skipTypes({tyStatic, tyVar, tyLent, tySink}), c.calleeSym) # XXX: Theoretically, maybeSkipDistinct could be called before we even # start the param matching process. This could be done in `prepareOperand` # for example, but unfortunately `prepareOperand` is not called in certain # situation when nkDotExpr are rotated to nkDotCalls if aOrig.kind in {tyAlias, tySink}: - return typeRel(c, f, lastSon(aOrig)) + return typeRel(c, f, skipModifier(aOrig), flags) if a.kind == tyGenericInst and - skipTypes(f, {tyVar, tyLent}).kind notin { + skipTypes(f, {tyStatic, tyVar, tyLent, tySink}).kind notin { tyGenericBody, tyGenericInvocation, tyGenericInst, tyGenericParam} + tyTypeClasses: - return typeRel(c, f, lastSon(a)) + return typeRel(c, f, skipModifier(a), flags) if a.isResolvedUserTypeClass: - return typeRel(c, f, a.lastSon) + return typeRel(c, f, a.skipModifier, flags) template bindingRet(res) = if doBind: - let bound = aOrig.skipTypes({tyRange}).skipIntLit + let bound = aOrig.skipTypes({tyRange}).skipIntLit(c.c.idgen) put(c, f, bound) 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) + 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: @@ -1056,23 +1304,23 @@ proc typeRelImpl(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 - + 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: @@ -1080,18 +1328,16 @@ proc typeRelImpl(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) + 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: - return if f.kind == tyAnything: isGeneric - else: isNone - + 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' @@ -1100,6 +1346,17 @@ proc typeRelImpl(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 @@ -1112,60 +1369,74 @@ proc typeRelImpl(c: var TCandidate, f, aOrig: PType, of tyRange: if a.kind == f.kind: if f.base.kind == tyNone: return isGeneric - result = typeRel(c, base(f), base(a)) + result = typeRel(c, base(f), base(a), flags) # bugfix: accept integer conversions here #if result < isGeneric: result = isNone 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.sons[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: - if skipTypes(f, {tyRange}).kind == a.kind: + let f = skipTypes(f, {tyRange}) + if f.kind == a.kind and (f.kind != tyEnum or sameEnumTypes(f, a)): result = isIntConv - elif isConvertibleToRange(skipTypes(f, {tyRange}), 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) - 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.sons[0] - var aRange = a.sons[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.sons[0]) + if typeRel(c, fRange, aRange) == isNone: + return isNone + put(c, fRange, a.indexType) fRange = a else: fRange = prev - let ff = f.sons[1].skipTypes({tyTypeDesc}) + let ff = f[1].skipTypes({tyTypeDesc}) # This typeDesc rule is wrong, see bug #7331 - let aa = a.sons[1] #.skipTypes({tyTypeDesc}) + let aa = a[1] #.skipTypes({tyTypeDesc}) - if f.sons[0].kind != tyGenericParam and aa.kind == tyEmpty: + if f.indexType.kind != tyGenericParam and aa.kind == tyEmpty: result = isGeneric else: - result = typeRel(c, ff, aa) - + result = typeRel(c, ff, aa, flags) if result < isGeneric: if nimEnableCovariance and trNoCovariance notin flags and @@ -1176,27 +1447,28 @@ proc typeRelImpl(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 tyOpenArray, tyVarargs: - # varargs[expr] is special too but handled earlier. So we only need to - # handle varargs[stmt] which is the same as varargs[typed]: + # 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) - if tfOldSchoolExprStmt in f.sons[0].flags: - if f.sons[0].kind == tyExpr: return - elif f.sons[0].kind == tyStmt: return + return typeRel(c, f.base, a.elementType, flags) + if f[0].kind == tyTyped: return template matchArrayOrSeq(aBase: PType) = let ff = f.base let aa = aBase - let baseRel = typeRel(c, ff, aa) + let baseRel = typeRel(c, ff, aa, flags) if baseRel >= isGeneric: result = isConvertible elif nimEnableCovariance and @@ -1207,33 +1479,32 @@ proc typeRelImpl(c: var TCandidate, f, aOrig: PType, case a.kind of tyOpenArray, tyVarargs: - result = typeRel(c, base(f), base(a)) + result = typeRel(c, base(f), base(a), flags) if result < isGeneric: result = isNone of tyArray: - if (f.sons[0].kind != tyGenericParam) and (a.sons[1].kind == tyEmpty): + if (f[0].kind != tyGenericParam) and (a.elementType.kind == tyEmpty): return isSubtype - matchArrayOrSeq(a.sons[1]) + matchArrayOrSeq(a.elementType) of tySequence: - if (f.sons[0].kind != tyGenericParam) and (a.sons[0].kind == tyEmpty): + if (f[0].kind != tyGenericParam) and (a.elementType.kind == tyEmpty): return isConvertible - matchArrayOrSeq(a.sons[0]) + matchArrayOrSeq(a.elementType) of tyString: if f.kind == tyOpenArray: - if f.sons[0].kind == tyChar: + if f[0].kind == tyChar: result = isConvertible - elif f.sons[0].kind == tyGenericParam and a.len > 0 and - typeRel(c, base(f), base(a)) >= isGeneric: + elif f[0].kind == tyGenericParam and a.len > 0 and + typeRel(c, base(f), base(a), flags) >= isGeneric: result = isConvertible else: discard - of tySequence: - case a.kind - of tySequence: - if (f.sons[0].kind != tyGenericParam) and (a.sons[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.sons[0] - let aa = a.sons[0] - result = typeRel(c, ff, aa) + let ff = f[0] + let aa = a.elementType + result = typeRel(c, ff, aa, flags) if result < isGeneric: if nimEnableCovariance and trNoCovariance notin flags and @@ -1242,17 +1513,15 @@ proc typeRelImpl(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 = f.allowsNil - else: discard + elif a.kind == tyNil: + result = isNone of tyOrdinal: if isOrdinalType(a): - var x = if a.kind == tyOrdinal: a.sons[0] else: a - if f.sons[0].kind == tyNone: + var x = if a.kind == tyOrdinal: a.elementType else: a + if f[0].kind == tyNone: result = isGeneric else: - result = typeRel(c, f.sons[0], x) + result = typeRel(c, f[0], x, flags) if result < isGeneric: result = isNone elif a.kind == tyGenericParam: result = isGeneric @@ -1260,53 +1529,71 @@ proc typeRelImpl(c: var TCandidate, f, aOrig: PType, #internalError("forward type in typeRel()") result = isNone of tyNil: + 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}) if a.kind == tyDistinct: if sameDistinctTypes(f, a): result = isEqual - elif f.base.kind == tyAnything: result = isGeneric - elif c.coerceDistincts: result = typeRel(c, f.base, a) - elif a.kind == tyNil and f.base.kind in NilableTypes: - result = f.allowsNil - elif c.coerceDistincts: result = typeRel(c, f.base, a) + #elif f.base.kind == tyAnything: result = isGeneric # issue 4435 + elif c.coerceDistincts: result = typeRel(c, f.base, a, flags) + elif c.coerceDistincts: result = typeRel(c, f.base, a, flags) of tySet: if a.kind == tySet: - if f.sons[0].kind != tyGenericParam and a.sons[0].kind == tyEmpty: + if f[0].kind != tyGenericParam and a[0].kind == tyEmpty: result = isSubtype else: - result = typeRel(c, f.sons[0], a.sons[0]) - if result <= isConvertible: - result = isNone # BUGFIX! + result = typeRel(c, f[0], a[0], flags) + 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: + 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-2: - if typeRel(c, f.sons[i], a.sons[i]) == isNone: return isNone - result = typeRel(c, f.lastSon, a.lastSon, flags + {trNoCovariance}) + for i in 0..<f.len-1: + if typeRel(c, f[i], a[i], flags) == isNone: return isNone + result = typeRel(c, f.elementType, a.elementType, flags + {trNoCovariance}) subtypeCheck() - if result <= isConvertible: result = isNone + if result <= isIntConv: result = isNone elif tfNotNil in f.flags and tfNotNil notin a.flags: result = isNilConversion elif a.kind == tyNil: result = f.allowsNil else: discard of tyProc: + skipOwned(a) result = procTypeRel(c, f, a) if result != isNone and tfNotNil in f.flags and tfNotNil notin a.flags: result = isNilConversion + of tyOwned: + case a.kind + of tyOwned: + result = typeRel(c, skipModifier(f), skipModifier(a), flags) + of tyNil: result = f.allowsNil + else: discard of tyPointer: + skipOwned(a) case a.kind of tyPointer: if tfNotNil in f.flags and tfNotNil notin a.flags: @@ -1315,26 +1602,25 @@ proc typeRelImpl(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 tyNil: result = f.allowsNil + 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: @@ -1342,64 +1628,81 @@ proc typeRelImpl(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.sons[0].skipTypes(abstractInst) - if pointsTo.kind == tyChar: result = isConvertible - elif pointsTo.kind == tyArray and firstOrd(nil, pointsTo.sons[0]) == 0 and - skipTypes(pointsTo.sons[0], {tyRange}).kind in {tyInt..tyInt64} and - pointsTo.sons[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) - + 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 - var m = c if a.kind == tyGenericInst: if roota.base == rootf.base: let nextFlags = flags + {trNoCovariance} var hasCovariance = false - for i in 1 .. rootf.sonsLen-2: - let ff = rootf.sons[i] - let aa = roota.sons[i] - result = typeRel(c, ff, aa, nextFlags) - if result notin {isEqual, isGeneric}: + # YYYY + result = isEqual + + for i in 1..<rootf.len-1: + let ff = rootf[i] + let aa = roota[i] + let res = typeRel(c, ff, aa, nextFlags) + if res != isNone and res != isEqual: result = isGeneric + if res notin {isEqual, isGeneric}: if trNoCovariance notin flags and ff.kind == aa.kind: - let paramFlags = rootf.base.sons[i-1].flags + let paramFlags = rootf.base[i-1].flags hasCovariance = if tfCovariant in paramFlags: if tfWeakCovariant in paramFlags: isCovariantPtr(c, ff, aa) else: - ff.kind notin {tyRef, tyPtr} and result == isSubtype + ff.kind notin {tyRef, tyPtr} and res == isSubtype else: tfContravariant in paramFlags and - typeRel(c, aa, ff) == isSubtype + typeRel(c, aa, ff, flags) == isSubtype if hasCovariance: continue return isNone if prev == nil: put(c, f, a) - result = isGeneric else: - let fKind = rootf.lastSon.kind + let fKind = rootf.last.kind if fKind in {tyAnd, tyOr}: - result = typeRel(c, lastSon(f), a) + 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: @@ -1409,61 +1712,69 @@ proc typeRelImpl(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 - return typeRel(c, f, baseType) + 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: - result = typeRel(c, lastSon(f), a) + 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.kind == tyGenericInst and a.sons[0] == f: + 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) - + 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.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: + 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) - return typeRel(c, inst, a) - - var depth = 0 - if x.kind == tyGenericInvocation or f.sons[0].kind != tyGenericBody: - #InternalError("typeRel: tyGenericInvocation -> tyGenericInvocation") - # simply no match for now: - discard - elif x.kind == tyGenericInst and - ((f.sons[0] == x.sons[0]) or isGenericSubType(c, x, f, depth)) and - (sonsLen(x) - 1 == sonsLen(f)): - for i in countup(1, sonsLen(f) - 1): - if x.sons[i].kind == tyGenericParam: + 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 + elif x.kind == tyGenericInst and f[0] == x[0] and + x.len - 1 == f.len: + for i in 1..<f.len: + if x[i].kind == tyGenericParam: internalError(c.c.graph.config, "wrong instantiated type!") - elif typeRel(c, f.sons[i], x.sons[i]) <= isSubtype: + elif typeRel(c, f[i], x[i], flags) <= isSubtype: # Workaround for regression #4589 - if f.sons[i].kind != tyTypeDesc: return - c.inheritancePenalty += depth + if f[i].kind != tyTypeDesc: return result = isGeneric + elif x.kind == tyGenericInst and concpt.kind == tyConcept: + result = if concepts.conceptMatch(c.c, concpt, x, c.bindings, f): isGeneric + else: isNone else: - let genericBody = f.sons[0] + let genericBody = f[0] 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) - result = typeRel(c, genericBody, x) + 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 # piece of code: @@ -1475,90 +1786,99 @@ proc typeRelImpl(c: var TCandidate, f, aOrig: PType, # var it1 = internalFind(root, 312) # cannot instantiate: 'D' # # we steal the generic parameters from the tyGenericBody: - for i in countup(1, sonsLen(f) - 1): - let x = PType(idTableGet(c.bindings, genericBody.sons[i-1])) + for i in 1..<f.len: + let x = idTableGet(c.bindings, genericBody[i-1]) if x == nil: - discard "maybe fine (for eg. a==tyNil)" + discard "maybe fine (for e.g. a==tyNil)" elif x.kind in {tyGenericInvocation, tyGenericParam}: internalError(c.c.graph.config, "wrong instantiated type!") else: - put(c, f.sons[i], x) + let key = f[i] + 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 # crossing path with metatypes/aliases, so we need to separate them # by checking sym.id - let genericSubtype = isGenericSubType(c, x, f, depth, f) + let genericSubtype = isGenericSubtype(c, x, f, depth, f) if not (genericSubtype and aobj.sym.id != fobj.sym.id) and aOrig.kind != tyGenericBody: 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: - let x = typeRel(c, branch, aOrig) + 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 - let x = typeRel(c, branch, aOrig) - maxInheritance = max(maxInheritance, c.inheritancePenalty) - - # 'or' implies maximum matching result: - if x > result: result = x - if result >= isSubtype: + var minInheritance = maxInheritancePenalty + for branch in f.kids: + c.inheritancePenalty = -1 + let x = typeRel(c, branch, aOrig, flags) + 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) != 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.sons[0].kind - let effectiveArgType = a.skipTypes({tyRange, tyGenericInst, - tyBuiltInTypeClass, tyAlias, tySink}) - 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) + result = typeRel(c, f.last, a, flags) else: considerPreviousT: if aOrig == f: return isEqual @@ -1567,31 +1887,41 @@ proc typeRelImpl(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.sonsLen-2: - let ff = rootf.sons[i] - let aa = roota.sons[i] - result = typeRel(c, ff, aa) + for i in 1..<rootf.len-1: + let ff = rootf[i] + let aa = roota[i] + result = typeRel(c, ff, aa, flags) if result == isNone: return if ff.kind == tyRange and result != isEqual: return isNone else: - result = typeRel(c, rootf.lastSon, a) + result = typeRel(c, rootf.last, a, flags) if result != isNone: put(c, f, a) result = isGeneric - of tyGenericParam: - var x = PType(idTableGet(c.bindings, f)) + let doBindGP = doBind or trBindGenericParam in flags + var x = idTableGet(c.bindings, f) if x == nil: - if c.callee.kind == tyGenericBody and - f.kind == tyGenericParam and not c.typedescMatched: + if c.callee.kind == tyGenericBody and not c.typedescMatched: # XXX: The fact that generic types currently use tyGenericParam for # their parameters is really a misnomer. tyGenericParam means "match # any value" and what we need is "match any type", which can be encoded @@ -1600,48 +1930,60 @@ proc typeRelImpl(c: var TCandidate, f, aOrig: PType, if tfWildcard in a.flags: result = isGeneric elif a.kind == tyTypeDesc: - if f.sonsLen == 0: + if f.len == 0: result = isGeneric else: - internalAssert c.c.graph.config, a.sons != nil and a.sons.len > 0 + internalAssert c.c.graph.config, a.len > 0 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) + result = typeRel(c, f.base, aa, flags) if result > isGeneric: result = isGeneric + elif c.isNoCall: + if doBindGP: + let concrete = concreteType(c, a, f) + if concrete == nil: return isNone + put(c, f, concrete) + result = isGeneric else: result = isNone else: - if f.sonsLen > 0 and f.sons[0].kind != tyNone: - let oldInheritancePenalty = c.inheritancePenalty - result = typeRel(c, f.lastSon, a, flags + {trDontBind}) - if doBind and result notin {isNone, isGeneric}: - let concrete = concreteType(c, a) + # check if 'T' has a constraint as in 'proc p[T: Constraint](x: T)' + if f.len > 0 and f[0].kind != tyNone: + 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: + # proc p[T](x: T) + # p(int) + result = isNone else: result = isGeneric if result == isGeneric: var concrete = a if tfWildcard in a.flags: - a.sym.kind = skType + a.sym.transitionGenericParamToType() a.flags.excl tfWildcard - else: - concrete = concreteType(c, a) + 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 - if doBind: + if doBindGP: put(c, f, concrete) elif result > isGeneric: result = isGeneric @@ -1650,117 +1992,167 @@ proc typeRelImpl(c: var TCandidate, f, aOrig: PType, elif x.kind == tyGenericParam: result = isGeneric else: - # Special type binding rule for numeric types. - # See section "Generic type inference for numeric types" of the - # manual for further details: - when false: - let rebinding = maxNumericType(x.skipTypes({tyRange}), a) - if rebinding != nil: - put(c, f, rebinding) - result = isGeneric - else: - discard - result = typeRel(c, x, a) # check if it fits + # 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: - result = typeRel(c, f.lastSon, a) - if result != isNone and f.n != nil: - if not exprStructuralEquivalent(f.n, aOrig.n): - result = isNone + 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: + 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 = typeRel(c, f.lastSon, aOrig.n.typ) + result = if f.base.kind != tyNone: + 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) + result = typeRel(c, prev.last, a, flags) if result != isNone and prev.n != nil: if not exprStructuralEquivalent(prev.n, aOrig.n): result = isNone else: result = isNone else: # XXX endless recursion? - #result = typeRel(c, prev, aOrig) + #result = typeRel(c, prev, aOrig, flags) result = isNone - of tyInferred: let prev = f.previouslyInferred if prev != nil: - result = typeRel(c, prev, a) + result = typeRel(c, prev, a, flags) else: - result = typeRel(c, f.base, a) + result = typeRel(c, f.base, a, flags) if result != isNone: - c.inferredTypes.safeAdd f - f.sons.add a - + 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: return isNone - - if f.base.kind == tyNone: + 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 + else: + result = isNone + elif f.base.kind == tyNone: result = isGeneric else: - result = typeRel(c, f.base, a.base) + result = typeRel(c, f.base, a.base, flags) if result != isNone: put(c, f, a) else: if tfUnresolved in f.flags: - result = typeRel(c, prev.base, a) + result = typeRel(c, prev.base, a, flags) elif a.kind == tyTypeDesc: - result = typeRel(c, prev.base, a.base) + result = typeRel(c, prev.base, a.base, flags) else: result = isNone - - of tyStmt: - if aOrig != nil and tfOldSchoolExprStmt notin f.flags: + 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) + result = typeRel(c, reevaluated.base, a, flags) of tyStatic: - result = typeRel(c, a, reevaluated.typ.base) - 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: - localError(c.c.graph.config, f.n.info, "type expected") - result = isNone - + # bug #14136: other types are just like 'tyStatic' here: + 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 else: internalError c.c.graph.config, " unknown type kind " & $f.kind +when false: + var nowDebug = false + var dbgCount = 0 + + proc typeRel(c: var TCandidate, f, aOrig: PType, + flags: TTypeRelFlags = {}): TTypeRelation = + if nowDebug: + echo f, " <- ", aOrig + inc dbgCount + if dbgCount == 2: + writeStackTrace() + result = typeRelImpl(c, f, aOrig, flags) + if nowDebug: + echo f, " <- ", aOrig, " res ", result + proc cmpTypes*(c: PContext, f, a: PType): TTypeRelation = - var m: TCandidate - initCandidate(c, m, f) + var m = newCandidate(c, f) result = typeRel(m, f, a) 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: @@ -1771,42 +2163,166 @@ 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: - result.typ = getInstantiatedType(c, arg, m, f) + if not m.matchedErrorType: + result.typ = getInstantiatedType(c, arg, m, f).skipTypes({tySink}) else: result.typ = errorType(c) else: - result.typ = f + 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") - addSon(result, c.graph.emptyNode) - addSon(result, arg) + result.add c.graph.emptyNode + 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 countup(0, len(c.converters) - 1): - var src = c.converters[i].typ.sons[1] - var dest = c.converters[i].typ.sons[0] + for i in 0..<c.converters.len: + 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: let srca = typeRel(m, src, a) - if srca notin {isEqual, isGeneric}: continue + if srca notin {isEqual, isGeneric, isSubtype}: continue + + # What's done below matches the logic in ``matchesAux`` + 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 isLValue(c, arg): + continue let destIsGeneric = containsGenericType(dest) if destIsGeneric: dest = generateTypeInstance(c, m.bindings, arg, dest) let fdest = typeRel(m, f, dest) - if fdest in {isEqual, isGeneric}: - markUsed(c.config, arg.info, c.converters[i], c.graph.usageSym) + if fdest in {isEqual, isGeneric} and not (dest.kind == tyLent and f.kind in {tyVar}): + markUsed(c, arg.info, c.converters[i]) var s = newSymNode(c.converters[i]) s.typ = c.converters[i].typ s.info = arg.info result = newNodeIT(nkHiddenCallConv, arg.info, dest) - addSon(result, s) - addSon(result, copyTree(arg)) + result.add s + # We build the call expression by ourselves in order to avoid passing this + # expression trough the semantic check phase once again so let's make sure + # it is correct + var param: PNode = nil + 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.firstParamType) + param.add copyTree(arg) + else: + param = copyTree(arg) + result.add param + + if dest.kind in {tyVar, tyLent}: + dest.flags.incl tfVarIsPtr + result = newDeref(result) + inc(m.convMatches) - m.genericConverter = srca == isGeneric or destIsGeneric + if not m.genericConverter: + m.genericConverter = srca == isGeneric or destIsGeneric return result proc localConvMatch(c: PContext, m: var TCandidate, f, a: PType, @@ -1821,13 +2337,18 @@ proc localConvMatch(c: PContext, m: var TCandidate, f, a: PType, var call = newNodeI(nkCall, arg.info) call.add(f.n.copyTree) call.add(arg.copyTree) - result = c.semExpr(c, call) + # XXX: This would be much nicer if we don't use `semTryExpr` and + # instead we directly search for overloads with `resolveOverloads`: + result = c.semTryExpr(c, call, {efNoSem2Check}) + if result != nil: if result.typ == nil: return nil + # bug #13378, ensure we produce a real generic instantiation: + result = c.semExpr(c, call, {efNoSem2Check}) # resulting type must be consistent with the other arguments: - var r = typeRel(m, f.sons[0], result.typ) + var r = typeRel(m, f[0], result.typ) if r < isGeneric: return nil - if result.kind == nkCall: result.kind = nkHiddenCallConv + if result.kind == nkCall: result.transitionSonsKind(nkHiddenCallConv) inc(m.convMatches) if r == isGeneric: result.typ = getInstantiatedType(c, arg, m, base(f)) @@ -1845,24 +2366,26 @@ 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.sons[0] == nil) or - (t.kind == tyBuiltInTypeClass and t.sons[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 # make sure that static types enter here - # XXX: weaken tyGenericParam and call it tyGenericPlaceholder + # Zahary: weaken tyGenericParam and call it tyGenericPlaceholder # and finally start using tyTypedesc for generic types properly. + # Araq: This would only shift the problems around, in 'proc p[T](x: T)' + # the T is NOT a typedesc. if a.kind == tyGenericParam and tfWildcard in a.flags: a.assignType(f) # put(m.bindings, f, a) @@ -1873,13 +2396,19 @@ 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: - arg.typ = newTypeS(tyStatic, c) - arg.typ.sons = @[evaluated.typ] - arg.typ.n = evaluated - a = arg.typ + # 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, son = evaluated.typ) + typ.n = evaluated + arg = copyTree(arg) # fix #12864 + arg.typ = typ + a = typ else: if m.callee.kind == tyGenericBody: if f.kind == tyStatic and typeRel(m, f.base, a) != isNone: @@ -1888,6 +2417,7 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, result.typ.n = arg return + let oldInheritancePenalty = m.inheritancePenalty var r = typeRel(m, f, a) # This special typing rule for macros and templates is not documented @@ -1898,7 +2428,7 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, # XXX: duplicating this is ugly, but we cannot (!) move this # directly into typeRel using return-like templates incMatches(m, r) - if f.kind == tyStmt: + if f.kind == tyTyped: return arg elif f.kind == tyTypeDesc: return arg @@ -1907,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: @@ -1947,29 +2499,24 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, result = implicitConv(nkHiddenSubConv, f, arg, m, c) of isSubrange: inc(m.subtypeMatches) - if f.kind == tyVar: + if f.kind in {tyVar}: 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 > 0: + 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 @@ -1977,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: @@ -1987,19 +2536,24 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, of isEqual: inc(m.exactMatches) result = arg - if skipTypes(f, abstractVar-{tyTypeDesc}).kind in {tyTuple}: + 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 = p.emptyNode, name = p.emptyNode, pattern = p.emptyNode, + params = nkFormalParams.newTree(p.emptyNode), name = p.emptyNode, pattern = p.emptyNode, genericParams = p.emptyNode, pragmas = p.emptyNode, exceptions = p.emptyNode), {}) if f.kind == tyBuiltInTypeClass: inc m.genericMatches @@ -2011,121 +2565,177 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, # constructor in a call: if result == nil and f.kind == tyVarargs: 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) - if r >= isGeneric: + case r + of isGeneric: + inc(m.convMatches) + result = copyTree(arg) + result.typ = getInstantiatedType(c, arg, m, base(f)) + m.baseTypeMatch = true + of isFromIntLit: + inc(m.intConvMatches, 256) + result = implicitConv(nkHiddenStdConv, f[0], arg, m, c) + m.baseTypeMatch = true + of isEqual: inc(m.convMatches) result = copyTree(arg) - if r == isGeneric: - result.typ = getInstantiatedType(c, arg, m, base(f)) m.baseTypeMatch = true - # bug #4799, varargs accepting subtype relation object - elif r == isSubtype: + of isSubtype: # bug #4799, varargs accepting subtype relation object inc(m.subtypeMatches) - if f.kind == tyTypeDesc: + if base(f).kind == tyTypeDesc: result = arg else: - result = implicitConv(nkHiddenSubConv, f, arg, m, c) + result = implicitConv(nkHiddenSubConv, base(f), arg, m, c) m.baseTypeMatch = true else: 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, y, z: TCandidate - initCandidate(c, x, m.callee) - initCandidate(c, y, m.callee) - initCandidate(c, z, 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.sons[i].sym.kind in {skProc, skFunc, skMethod, skConverter, - skIterator, skMacro, skTemplate}: - copyCandidate(z, m) - z.callee = arg.sons[i].typ - if tfUnresolved in z.callee.flags: continue - z.calleeSym = arg.sons[i].sym - #if arg.sons[i].sym.name.s == "cmp": - # ggDebug = true - # echo "CALLLEEEEEEEE A ", typeToString(z.callee) - # 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.sons[i].typ) - incMatches(z, r, 2) - #if arg.sons[i].sym.name.s == "cmp": # and arg.info.line == 606: - # echo "M ", r, " ", arg.info, " ", typeToString(arg.sons[i].sym.typ) - # writeMatches(z) - 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 == tyExpr' should match - # anyway: - if f.kind in {tyExpr, tyStmt}: 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.config, arg.info, arg.sons[best].sym, m.c.graph.usageSym) - styleCheckUse(arg.info, arg.sons[best].sym) - result = paramTypesMatchAux(m, f, arg.sons[best].typ, arg.sons[best], - argOrig) + markUsed(m.c, arg.info, arg[best].sym) + onUse(arg.info, arg[best].sym) + result = paramTypesMatchAux(m, f, arg[best].typ, arg[best], argOrig) + when false: + if m.calleeSym != nil and m.calleeSym.name.s == "[]": + echo m.c.config $ arg.info, " for ", m.calleeSym.name.s, " ", m.c.config $ m.calleeSym.info + writeMatches(m) proc setSon(father: PNode, at: int, son: PNode) = let oldLen = father.len if oldLen <= at: setLen(father.sons, at + 1) - father.sons[at] = son + father[at] = son # insert potential 'void' parameters: - #for i in oldLen ..< at: - # father.sons[i] = newNodeIT(nkEmpty, son.info, getSysType(tyVoid)) + #for i in oldLen..<at: + # father[i] = newNodeIT(nkEmpty, son.info, getSysType(tyVoid)) # we are allowed to modify the calling node in the 'prepare*' procs: proc prepareOperand(c: PContext; formal: PType; a: PNode): PNode = - if formal.kind == tyExpr and formal.len != 1: - # {tyTypeDesc, tyExpr, tyStmt, tyProxy}: + if formal.kind == tyUntyped and formal.len != 1: + # {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 == tyStmt: {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: @@ -2135,15 +2745,15 @@ proc prepareOperand(c: PContext; a: PNode): PNode = considerGenSyms(c, result) proc prepareNamedParam(a: PNode; c: PContext) = - if a.sons[0].kind != nkIdent: - var info = a.sons[0].info - a.sons[0] = newIdentNode(considerQuotedIdent(c, a.sons[0]), info) + if a[0].kind != nkIdent: + var info = a[0].info + a[0] = newIdentNode(considerQuotedIdent(c, a[0]), info) 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})) + {tyVar, tyLent, tyOrdinal}), c.idgen) proc arrayConstr(c: PContext, info: TLineInfo): PType = result = newTypeS(tyArray, c) @@ -2152,87 +2762,121 @@ proc arrayConstr(c: PContext, info: TLineInfo): PType = proc incrIndexType(t: PType) = assert t.kind == tyArray - inc t.sons[0].n.sons[1].intVal + inc t.indexType.n[1].intVal template isVarargsUntyped(x): untyped = - x.kind == tyVarargs and x.sons[0].kind == tyExpr and - tfOldSchoolExprStmt notin x.sons[0].flags + 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() = + c.mergeShadowScope #merge so that we don't have to resem for later overloads + m.state = csNoMatch + m.firstMismatch.arg = a + m.firstMismatch.formal = formal + return -proc matchesAux(c: PContext, n, nOrig: PNode, - m: var TCandidate, marker: var IntSet) = 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) else: - m.state = csNoMatch - return - if formal.typ.kind == tyVar: - if not n.isLValue: - m.state = csNoMatch - m.mutabilityProblem = uint8(f-1) - return - - var - # iterates over formal parameters - f = if m.callee.kind != tyGenericBody: 1 - else: 0 - # iterates over the actual given arguments - a = 1 + noMatch() + + if formal.typ.kind in {tyVar}: + let argConverter = if arg.kind == nkHiddenDeref: arg[0] else: arg + if argConverter.kind == nkHiddenCallConv: + if argConverter.typ.kind notin {tyVar}: + m.firstMismatch.kind = kVarNeeded + noMatch() + elif not (isLValue(c, n, isOutParam(formal.typ))): + m.firstMismatch.kind = kVarNeeded + noMatch() m.state = csMatch # until proven otherwise - m.call = newNodeI(n.kind, n.info) - m.call.typ = base(m.callee) # may be nil - var formalLen = m.callee.n.len - addSon(m.call, copyTree(n.sons[0])) - var container: PNode = nil # constructed container - var formal: PSym = if formalLen > 1: m.callee.n.sons[1].sym else: nil + m.firstMismatch = MismatchInfo() + m.call = newNodeIT(n.kind, n.info, m.callee.base) + m.call.add n[0] + var + a = 1 # iterates over the actual given arguments + f = if m.callee.kind != tyGenericBody: 1 + else: 0 # iterates over formal parameters + 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 + if a >= formalLen-1 and f < formalLen and m.callee.n[f].typ.isVarargsUntyped: - formal = m.callee.n.sons[f].sym + formal = m.callee.n[f].sym incl(marker, formal.position) - if container.isNil: - container = newNodeIT(nkArgList, n.sons[a].info, arrayConstr(c, n.info)) - setSon(m.call, formal.position + 1, container) + + if n[a].kind == nkHiddenStdConv: + doAssert n[a][0].kind == nkEmpty and + n[a][1].kind in {nkBracket, nkArgList} + # Steal the container and pass it along + setSon(m.call, formal.position + 1, n[a][1]) else: - incrIndexType(container.typ) - addSon(container, n.sons[a]) - elif n.sons[a].kind == nkExprEqExpr: + if container.isNil: + container = newNodeIT(nkArgList, n[a].info, arrayConstr(c, n.info)) + setSon(m.call, formal.position + 1, container) + else: + incrIndexType(container.typ) + container.add n[a] + elif n[a].kind == nkExprEqExpr: # named param + m.firstMismatch.kind = kUnknownNamedParam # check if m.callee has such a param: - prepareNamedParam(n.sons[a], c) - if n.sons[a].sons[0].kind != nkIdent: - localError(c.config, n.sons[a].info, "named parameter has to be an identifier") - m.state = csNoMatch - return - formal = getSymFromList(m.callee.n, n.sons[a].sons[0].ident, 1) + prepareNamedParam(n[a], c) + if n[a][0].kind != nkIdent: + localError(c.config, n[a].info, "named parameter has to be an identifier") + noMatch() + formal = getNamedParamFromList(m.callee.n, n[a][0].ident) if formal == nil: # no error message! - m.state = csNoMatch - return + noMatch() if containsOrIncl(marker, formal.position): + m.firstMismatch.kind = kAlreadyGiven # already in namedParams, so no match # we used to produce 'errCannotBindXTwice' here but see # bug #3836 of why that is not sound (other overload with # different parameter names could match later on): - when false: localError(n.sons[a].info, errCannotBindXTwice, formal.name.s) - m.state = csNoMatch - return + when false: localError(n[a].info, errCannotBindXTwice, formal.name.s) + noMatch() m.baseTypeMatch = false - n.sons[a].sons[1] = prepareOperand(c, formal.typ, n.sons[a].sons[1]) - n.sons[a].typ = n.sons[a].sons[1].typ - var arg = paramTypesMatch(m, formal.typ, n.sons[a].typ, - n.sons[a].sons[1], n.sons[a].sons[1]) + m.typedescMatched = false + n[a][1] = prepareOperand(c, formal.typ, n[a][1]) + n[a].typ = n[a][1].typ + arg = paramTypesMatch(m, formal.typ, n[a].typ, + n[a][1], n[a][1]) + m.firstMismatch.kind = kTypeMismatch if arg == nil: - m.state = csNoMatch - return - checkConstraint(n.sons[a].sons[1]) + noMatch() + checkConstraint(n[a][1]) if m.baseTypeMatch: #assert(container == nil) - container = newNodeIT(nkBracket, n.sons[a].info, arrayConstr(c, arg)) - addSon(container, arg) + container = newNodeIT(nkBracket, n[a].info, arrayConstr(c, arg)) + container.add arg setSon(m.call, formal.position + 1, container) if f != formalLen - 1: container = nil else: @@ -2245,84 +2889,108 @@ proc matchesAux(c: PContext, n, nOrig: PNode, if tfVarargs in m.callee.flags: # is ok... but don't increment any counters... # we have no formal here to snoop at: - n.sons[a] = prepareOperand(c, n.sons[a]) - if skipTypes(n.sons[a].typ, abstractVar-{tyTypeDesc}).kind==tyString: - addSon(m.call, implicitConv(nkHiddenStdConv, - getSysType(c.graph, n.sons[a].info, tyCString), - copyTree(n.sons[a]), m, c)) + 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), + copyTree(n[a]), m, c) else: - addSon(m.call, copyTree(n.sons[a])) + m.call.add copyTree(n[a]) elif formal != nil and formal.typ.kind == tyVarargs: + m.firstMismatch.kind = kTypeMismatch # beware of the side-effects in 'prepareOperand'! So only do it for # varargs matching. See tests/metatype/tstatic_overloading. m.baseTypeMatch = false + m.typedescMatched = false incl(marker, formal.position) - n.sons[a] = prepareOperand(c, formal.typ, n.sons[a]) - var arg = paramTypesMatch(m, formal.typ, n.sons[a].typ, - n.sons[a], nOrig.sons[a]) + n[a] = prepareOperand(c, formal.typ, n[a]) + arg = paramTypesMatch(m, formal.typ, n[a].typ, + n[a], nOrig[a]) if arg != nil and m.baseTypeMatch and container != nil: - addSon(container, arg) + container.add arg incrIndexType(container.typ) - checkConstraint(n.sons[a]) + checkConstraint(n[a]) else: - m.state = csNoMatch - return + noMatch() else: - m.state = csNoMatch - return + m.firstMismatch.kind = kExtraArg + noMatch() else: - if m.callee.n.sons[f].kind != nkSym: - internalError(c.config, n.sons[a].info, "matches") - return - formal = m.callee.n.sons[f].sym + 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: - # already in namedParams: (see above remark) - when false: localError(n.sons[a].info, errCannotBindXTwice, formal.name.s) - m.state = csNoMatch - return + m.firstMismatch.kind = kPositionalAlreadyGiven + # positional param already in namedParams: (see above remark) + when false: localError(n[a].info, errCannotBindXTwice, formal.name.s) + noMatch() if formal.typ.isVarargsUntyped: if container.isNil: - container = newNodeIT(nkArgList, n.sons[a].info, arrayConstr(c, n.info)) + container = newNodeIT(nkArgList, n[a].info, arrayConstr(c, n.info)) setSon(m.call, formal.position + 1, container) else: incrIndexType(container.typ) - addSon(container, n.sons[a]) + container.add n[a] else: m.baseTypeMatch = false - n.sons[a] = prepareOperand(c, formal.typ, n.sons[a]) - var arg = paramTypesMatch(m, formal.typ, n.sons[a].typ, - n.sons[a], nOrig.sons[a]) + m.typedescMatched = false + n[a] = prepareOperand(c, formal.typ, n[a]) + arg = paramTypesMatch(m, formal.typ, n[a].typ, + n[a], nOrig[a]) if arg == nil: - m.state = csNoMatch - m.firstMismatch = f - return - if m.baseTypeMatch: + noMatch() + 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: - container = newNodeIT(nkBracket, n.sons[a].info, arrayConstr(c, arg)) + container = newNodeIT(nkBracket, n[a].info, arrayConstr(c, arg)) container.typ.flags.incl tfVarargs else: incrIndexType(container.typ) - addSon(container, arg) + container.add arg setSon(m.call, formal.position + 1, implicitConv(nkHiddenStdConv, formal.typ, container, m, c)) #if f != formalLen - 1: container = nil # pick the formal from the end, so that 'x, y, varargs, z' works: f = max(f, formalLen - n.len + a + 1) - else: + elif formal.typ.kind != tyVarargs or container == nil: setSon(m.call, formal.position + 1, arg) - inc(f) + inc f container = nil - checkConstraint(n.sons[a]) - inc(a) + else: + # we end up here if the argument can be converted into the varargs + # formal (e.g. seq[T] -> varargs[T]) but we have already instantiated + # a container + #assert arg.kind == nkHiddenStdConv # for 'nim check' + # this assertion can be off + localError(c.config, n[a].info, "cannot convert $1 to $2" % [ + typeToString(n[a].typ), typeToString(formal.typ) ]) + noMatch() + checkConstraint(n[a]) + + if m.state == csMatch and not (m.calleeSym != nil and m.calleeSym.kind in {skTemplate, skMacro}): + c.mergeShadowScope + else: + c.closeShadowScope -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.sons[i] = prepareOperand(c, n.sons[i]) + inc a + # for some edge cases (see tdont_return_unowned_from_owned test case) + m.firstMismatch.arg = a + m.firstMismatch.formal = formal proc partialMatch*(c: PContext, n, nOrig: PNode, m: var TCandidate) = # for 'suggest' support: @@ -2333,42 +3001,67 @@ proc matches*(c: PContext, n, nOrig: PNode, m: var TCandidate) = if m.magic in {mArrGet, mArrPut}: m.state = csMatch m.call = n + # Note the following doesn't work as it would produce ambiguities. + # Instead we patch system.nim, see bug #8049. + when false: + 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 # check that every formal parameter got a value: - var f = 1 - while f < sonsLen(m.callee.n): - var formal = m.callee.n.sons[f].sym + for f in 1..<m.callee.n.len: + let formal = m.callee.n[f].sym if not containsOrIncl(marker, formal.position): if formal.ast == nil: if formal.typ.kind == tyVarargs: - var container = newNodeIT(nkBracket, n.info, arrayConstr(c, n.info)) + # For consistency with what happens in `matchesAux` select the + # container node kind accordingly + let cnKind = if formal.typ.isVarargsUntyped: nkArgList else: nkBracket + var container = newNodeIT(cnKind, n.info, arrayConstr(c, n.info)) setSon(m.call, formal.position + 1, implicitConv(nkHiddenStdConv, formal.typ, container, m, c)) else: # no default value m.state = csNoMatch - m.firstMismatch = f + m.firstMismatch.kind = kMissingParam + m.firstMismatch.formal = formal break else: - # use default value: - var def = copyTree(formal.ast) - if def.kind == nkNilLit: - def = implicitConv(nkHiddenStdConv, formal.typ, def, m, c) + # 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: + 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) + if defaultValue.kind == nkNilLit: + defaultValue = implicitConv(nkHiddenStdConv, formal.typ, defaultValue, m, c) + # proc foo(x: T = 0.0) + # foo() if {tfImplicitTypeParam, tfGenericTypeParam} * formal.typ.flags != {}: - put(m, formal.typ, def.typ) - setSon(m.call, formal.position + 1, def) - inc(f) + let existing = idTableGet(m.bindings, formal.typ) + if existing == nil or existing.kind == tyTypeDesc: + # see bug #11600: + put(m, formal.typ, defaultValue.typ) + defaultValue.flags.incl nfDefaultParam + setSon(m.call, formal.position + 1, defaultValue) # forget all inferred types if the overload matching failed if m.state == csNoMatch: for t in m.inferredTypes: - if t.sonsLen > 1: t.sons.setLen 1 + if t.len > 1: t.newSons 1 proc argtypeMatches*(c: PContext, f, a: PType, fromHlo = false): bool = - var m: TCandidate - initCandidate(c, m, f) + var m = newCandidate(c, f) let res = paramTypesMatch(m, f, a, c.graph.emptyNode, nil) #instantiateGenericConverters(c, res, m) # XXX this is used by patterns.nim too; I think it's better to not @@ -2379,20 +3072,21 @@ 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] + proc instTypeBoundOp*(c: PContext; dc: PSym; t: PType; info: TLineInfo; - op: TTypeAttachedOp; col: int): PSym {.procvar.} = - var m: TCandidate - initCandidate(c, m, dc.typ) + 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 & "'") return nil - var f = dc.typ.sons[col] + 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 == 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) @@ -2405,7 +3099,7 @@ when not declared(tests): template tests(s: untyped) = discard tests: - var dummyOwner = newSym(skModule, getIdent("test_module"), nil, UnknownLineInfo()) + var dummyOwner = newSym(skModule, getIdent("test_module"), nil, unknownLineInfo) proc `|` (t1, t2: PType): PType = result = newType(tyOr, dummyOwner) @@ -2428,9 +3122,9 @@ tests: proc array(x: int, t: PType): PType = result = newType(tyArray, dummyOwner) - var n = newNodeI(nkRange, UnknownLineInfo()) - addSon(n, newIntNode(nkIntLit, 0)) - addSon(n, newIntNode(nkIntLit, x)) + var n = newNodeI(nkRange, unknownLineInfo) + n.add newIntNode(nkIntLit, 0) + n.add newIntNode(nkIntLit, x) let range = newType(tyRange, dummyOwner) result.rawAddSon(range) @@ -2446,19 +3140,18 @@ tests: number = int | float var TFoo = newType(tyObject, dummyOwner) - TFoo.sym = newSym(skType, getIdent"TFoo", dummyOwner, UnknownLineInfo()) + TFoo.sym = newSym(skType, getIdent"TFoo", dummyOwner, unknownLineInfo) var T1 = newType(tyGenericParam, dummyOwner) - T1.sym = newSym(skType, getIdent"T1", dummyOwner, UnknownLineInfo()) + T1.sym = newSym(skType, getIdent"T1", dummyOwner, unknownLineInfo) T1.sym.position = 0 var T2 = newType(tyGenericParam, dummyOwner) - T2.sym = newSym(skType, getIdent"T2", dummyOwner, UnknownLineInfo()) + T2.sym = newSym(skType, getIdent"T2", dummyOwner, unknownLineInfo) T2.sym.position = 1 setup: - var c: TCandidate - initCandidate(nil, c, nil) + var c = newCandidate(nil, nil) template yes(x, y) = test astToStr(x) & " is " & astToStr(y): @@ -2520,4 +3213,3 @@ tests: yes int, ordinal no string, ordinal - diff --git a/compiler/sinkparameter_inference.nim b/compiler/sinkparameter_inference.nim new file mode 100644 index 000000000..09d54ec79 --- /dev/null +++ b/compiler/sinkparameter_inference.nim @@ -0,0 +1,68 @@ +# +# +# The Nim Compiler +# (c) Copyright 2020 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +proc checkForSink*(config: ConfigRef; idgen: IdGenerator; owner: PSym; arg: PNode) = + #[ Patterns we seek to detect: + + someLocation = p # ---> p: sink T + passToSink(p) # p: sink + ObjConstr(fieldName: p) + [p, q] # array construction + + # Open question: + var local = p # sink parameter? + passToSink(local) + ]# + case arg.kind + of nkSym: + if arg.sym.kind == skParam and + arg.sym.owner == owner and + owner.typ != nil and owner.typ.kind == tyProc and + arg.sym.typ.hasDestructor and + arg.sym.typ.kind notin {tyVar, tySink, tyOwned}: + # Watch out: cannot do this inference for procs with forward + # declarations. + if sfWasForwarded notin owner.flags: + let argType = arg.sym.typ + + let sinkType = newType(tySink, idgen, owner) + sinkType.size = argType.size + sinkType.align = argType.align + sinkType.paddingAtEnd = argType.paddingAtEnd + sinkType.add argType + + arg.sym.typ = sinkType + owner.typ[arg.sym.position+1] = sinkType + + #message(config, arg.info, warnUser, + # ("turned '$1' to a sink parameter") % [$arg]) + #echo config $ arg.info, " turned into a sink parameter ", arg.sym.name.s + elif sfWasForwarded notin arg.sym.flags: + # we only report every potential 'sink' parameter only once: + incl arg.sym.flags, sfWasForwarded + message(config, arg.info, hintPerformance, + "could not turn '$1' to a sink parameter" % [arg.sym.name.s]) + #echo config $ arg.info, " candidate for a sink parameter here" + of nkStmtList, nkStmtListExpr, nkBlockStmt, nkBlockExpr: + if not isEmptyType(arg.typ): + checkForSink(config, idgen, owner, arg.lastSon) + of nkIfStmt, nkIfExpr, nkWhen: + for branch in arg: + let value = branch.lastSon + if not isEmptyType(value.typ): + checkForSink(config, idgen, owner, value) + of nkCaseStmt: + for i in 1..<arg.len: + let value = arg[i].lastSon + if not isEmptyType(value.typ): + checkForSink(config, idgen, owner, value) + of nkTryStmt: + checkForSink(config, idgen, owner, arg[0]) + else: + discard "nothing to do" diff --git a/compiler/sizealignoffsetimpl.nim b/compiler/sizealignoffsetimpl.nim new file mode 100644 index 000000000..1dd481ec0 --- /dev/null +++ b/compiler/sizealignoffsetimpl.nim @@ -0,0 +1,525 @@ +# +# +# The Nim Compiler +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# +## code owner: Arne Döring +## e-mail: arne.doering@gmx.net +## included from types.nim + +proc align(address, alignment: BiggestInt): BiggestInt = + result = (address + (alignment - 1)) and not (alignment - 1) + +proc align(address, alignment: int32): int32 = + result = (address + (alignment - 1)) and not (alignment - 1) + +const + ## a size is considered "unknown" when it is an imported type from C + ## or C++. + szUnknownSize* = -3 + szIllegalRecursion* = -2 + szUncomputedSize* = -1 + szTooBigSize* = -4 + +type IllegalTypeRecursionError = object of ValueError + +proc raiseIllegalTypeRecursion() = + raise newException(IllegalTypeRecursionError, "illegal type recursion") + +type + OffsetAccum* = object + maxAlign*: int32 + offset*: int32 + +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: int32): int32 = + if unlikely(a == szIllegalRecursion or b == szIllegalRecursion): raiseIllegalTypeRecursion() + if a == szUnknownSize or b == szUnknownSize: + szUnknownSize + else: + max(a, b) + +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 + else: + arg.maxAlign = max(value, arg.maxAlign) + arg.offset = align(arg.offset, value) + +proc mergeBranch(arg: var OffsetAccum; value: OffsetAccum) = + if value.maxAlign == szUnknownSize or arg.maxAlign == szUnknownSize or + value.offset == szUnknownSize or arg.offset == szUnknownSize: + arg.maxAlign = szUnknownSize + arg.offset = szUnknownSize + else: + arg.offset = max(arg.offset, value.offset) + arg.maxAlign = max(arg.maxAlign, value.maxAlign) + +proc finish(arg: var OffsetAccum): int32 = + if arg.maxAlign == szUnknownSize or arg.offset == szUnknownSize: + result = szUnknownSize + arg.offset = szUnknownSize + else: + result = align(arg.offset, arg.maxAlign) - arg.offset + arg.offset += result + +proc computeSizeAlign*(conf: ConfigRef; typ: PType) + +proc computeSubObjectAlign(conf: ConfigRef; n: PNode): BiggestInt = + ## returns object alignment + case n.kind + of nkRecCase: + assert(n[0].kind == nkSym) + result = computeSubObjectAlign(conf, n[0]) + for i in 1..<n.len: + let child = n[i] + case child.kind + of nkOfBranch, nkElse: + let align = computeSubObjectAlign(conf, child.lastSon) + if align < 0: + return align + result = max(result, align) + else: + internalError(conf, "computeSubObjectAlign") + of nkRecList: + result = 1 + for i, child in n.sons: + let align = computeSubObjectAlign(conf, n[i]) + if align < 0: + return align + result = max(result, align) + of nkSym: + computeSizeAlign(conf, n.sym.typ) + result = n.sym.typ.align + else: + result = 1 + + +proc setOffsetsToUnknown(n: PNode) = + if n.kind == nkSym and n.sym.kind == skField: + n.sym.offset = szUnknownSize + else: + for i in 0..<n.safeLen: + setOffsetsToUnknown(n[i]) + +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 + if n.typ != nil and n.typ.size == szIllegalRecursion: + raiseIllegalTypeRecursion() + case n.kind + of nkRecCase: + assert(n[0].kind == nkSym) + computeObjectOffsetsFoldFunction(conf, n[0], packed, accum) + 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 = 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.maxAlign = szUnknownSize + else: + # the union needs to be aligned first, before the offsets can be assigned + accum.align(maxChildAlign) + let accumRoot = accum # copy, because each branch should start af the same offset + for i in 1..<n.len: + var branchAccum = OffsetAccum(offset: accumRoot.offset, maxAlign: 1) + computeObjectOffsetsFoldFunction(conf, n[i].lastSon, packed, branchAccum) + discard finish(branchAccum) + accum.mergeBranch(branchAccum) + of nkRecList: + for i, child in n.sons: + computeObjectOffsetsFoldFunction(conf, child, packed, accum) + of nkSym: + 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.int32 + align = if packed: 1 else: n.sym.typ.align.int32 + accum.align(align) + if n.sym.alignment > 0: + accum.align(n.sym.alignment.int32) + n.sym.offset = accum.offset + accum.inc(size) + else: + accum.maxAlign = szUnknownSize + accum.offset = szUnknownSize + +proc computeUnionObjectOffsetsFoldFunction(conf: ConfigRef; n: PNode; packed: bool; accum: var OffsetAccum) = + ## ``accum.offset`` will the offset from the larget member of the union. + case n.kind + of nkRecCase: + accum.offset = szUnknownSize + accum.maxAlign = szUnknownSize + localError(conf, n.info, "Illegal use of ``case`` in union type.") + of nkRecList: + let accumRoot = accum # copy, because each branch should start af the same offset + for child in n.sons: + var branchAccum = OffsetAccum(offset: accumRoot.offset, maxAlign: 1) + computeUnionObjectOffsetsFoldFunction(conf, child, packed, branchAccum) + discard finish(branchAccum) + accum.mergeBranch(branchAccum) + of nkSym: + 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.int32 + align = if packed: 1 else: n.sym.typ.align.int32 + accum.align(align) + if n.sym.alignment > 0: + accum.align(n.sym.alignment.int32) + n.sym.offset = accum.offset + accum.inc(size) + else: + accum.maxAlign = szUnknownSize + 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 + let hasAlign = typ.align != szUncomputedSize + + if hasSize and hasAlign: + # nothing to do, size and align already computed + return + + # This function can only calculate both, size and align at the same time. + # If one of them is already set this value is stored here and reapplied + let revertSize = typ.size + let revertAlign = typ.align + defer: + if hasSize: + typ.size = revertSize + if hasAlign: + typ.align = revertAlign + + if typ.size == szIllegalRecursion or typ.align == szIllegalRecursion: + # we are already computing the size of the type + # --> illegal recursion in type + return + + # mark computation in progress + typ.size = szIllegalRecursion + typ.align = szIllegalRecursion + typ.paddingAtEnd = 0 + + var tk = typ.kind + case tk + of tyProc: + if typ.callConv == ccClosure: + typ.size = 2 * conf.target.ptrSize + else: + typ.size = conf.target.ptrSize + typ.align = int16(conf.target.ptrSize) + of tyNil: + typ.size = conf.target.ptrSize + typ.align = int16(conf.target.ptrSize) + of tyString: + if optSeqDestructors in conf.globalOptions: + typ.size = conf.target.ptrSize * 2 + else: + typ.size = conf.target.ptrSize + typ.align = int16(conf.target.ptrSize) + 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 + typ.align = szIllegalRecursion + typ.paddingAtEnd = szIllegalRecursion + return + typ.align = int16(conf.target.ptrSize) + if typ.kind == tySequence and optSeqDestructors in conf.globalOptions: + typ.size = conf.target.ptrSize * 2 + else: + typ.size = conf.target.ptrSize + + of tyArray: + 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 + else: + typ.size = toInt64Checked(len * int32(elemSize), szTooBigSize) + typ.align = typ.elementType.align + + of tyUncheckedArray: + let base = typ.last + computeSizeAlign(conf, base) + typ.size = 0 + typ.align = base.align + + of tyEnum: + if firstOrd(conf, typ) < Zero: + typ.size = 4 # use signed int32 + typ.align = 4 + else: + let lastOrd = toInt64(lastOrd(conf, typ)) # BUGFIX: use lastOrd! + if lastOrd < `shl`(1, 8): + typ.size = 1 + typ.align = 1 + elif lastOrd < `shl`(1, 16): + typ.size = 2 + typ.align = 2 + elif lastOrd < `shl`(BiggestInt(1), 32): + typ.size = 4 + typ.align = 4 + else: + typ.size = 8 + typ.align = int16(conf.floatInt64Align) + of tySet: + if typ.elementType.kind == tyGenericParam: + typ.size = szUncomputedSize + typ.align = szUncomputedSize + else: + let length = toInt64(lengthOrd(conf, typ.elementType)) + if length <= 8: + typ.size = 1 + typ.align = 1 + elif length <= 16: + typ.size = 2 + typ.align = 2 + elif length <= 32: + typ.size = 4 + typ.align = 4 + elif length <= 64: + typ.size = 8 + typ.align = int16(conf.floatInt64Align) + elif align(length, 8) mod 8 == 0: + typ.size = align(length, 8) div 8 + typ.align = 1 + else: + typ.size = align(length, 8) div 8 + 1 + typ.align = 1 + of tyRange: + 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, 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(int32(child.size)) + typ.paddingAtEnd = int16(accum.finish()) + typ.size = if accum.offset == 0: 1 else: accum.offset + typ.align = int16(accum.maxAlign) + except IllegalTypeRecursionError: + typ.paddingAtEnd = szIllegalRecursion + typ.size = szIllegalRecursion + typ.align = szIllegalRecursion + + of tyObject: + try: + var accum = + if typ.baseClass != nil: + # compute header size + var st = typ.baseClass + while st.kind in skipPtrs: + st = st.skipModifier + computeSizeAlign(conf, st) + if conf.backend == backendCpp: + OffsetAccum( + offset: int32(st.size) - int32(st.paddingAtEnd), + maxAlign: st.align + ) + else: + OffsetAccum( + offset: int32(st.size), + maxAlign: st.align + ) + elif isObjectWithTypeFieldPredicate(typ): + # this branch is taken for RootObj + OffsetAccum( + offset: conf.target.intSize.int32, + maxAlign: conf.target.intSize.int32 + ) + else: + OffsetAccum(maxAlign: 1) + if tfUnion in typ.flags: + if accum.offset != 0: + let info = if typ.sym != nil: typ.sym.info else: unknownLineInfo + localError(conf, info, "union type may not have an object header") + accum = OffsetAccum(offset: szUnknownSize, maxAlign: szUnknownSize) + else: + 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 + typ.sym.flags * {sfCompilerProc, sfImportc} == {sfImportc} and + tfCompleteStruct notin typ.flags: + typ.size = szUnknownSize + typ.align = szUnknownSize + typ.paddingAtEnd = szUnknownSize + else: + typ.size = if accum.offset == 0: 1 else: accum.offset + typ.align = int16(accum.maxAlign) + typ.paddingAtEnd = paddingAtEnd + except IllegalTypeRecursionError: + typ.size = szIllegalRecursion + typ.align = szIllegalRecursion + typ.paddingAtEnd = szIllegalRecursion + of tyInferred: + 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.skipModifier) + typ.size = typ.skipModifier.size + typ.align = typ.skipModifier.align + typ.paddingAtEnd = typ.last.paddingAtEnd + + of tyTypeClasses: + if typ.isResolvedUserTypeClass: + 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 tyTypeDesc: + computeSizeAlign(conf, typ.base) + typ.size = typ.base.size + typ.align = typ.base.align + typ.paddingAtEnd = typ.base.paddingAtEnd + + of tyForward: + typ.size = szUnknownSize + typ.align = szUnknownSize + typ.paddingAtEnd = szUnknownSize + + of tyStatic: + if typ.n != nil: + 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 + typ.paddingAtEnd = szUnknownSize + +template foldSizeOf*(conf: ConfigRef; n: PNode; fallback: PNode): PNode = + let config = conf + let node = n + let typ = node[1].typ + computeSizeAlign(config, typ) + let size = typ.size + if size >= 0: + let res = newIntNode(nkIntLit, size) + res.info = node.info + res.typ = node.typ + res + else: + fallback + +template foldAlignOf*(conf: ConfigRef; n: PNode; fallback: PNode): PNode = + let config = conf + let node = n + let typ = node[1].typ + computeSizeAlign(config, typ) + let align = typ.align + if align >= 0: + let res = newIntNode(nkIntLit, align) + res.info = node.info + res.typ = node.typ + res + else: + fallback + +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 = n + var dotExpr: PNode + block findDotExpr: + if node[1].kind == nkDotExpr: + dotExpr = node[1] + 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 + let value = dotExpr[0] + let member = dotExpr[1] + computeSizeAlign(config, value.typ) + let offset = member.sym.offset + if offset >= 0: + let tmp = newIntNode(nkIntLit, offset) + tmp.info = node.info + tmp.typ = node.typ + tmp + else: + fallback diff --git a/compiler/sourcemap.nim b/compiler/sourcemap.nim new file mode 100644 index 000000000..1395168cd --- /dev/null +++ b/compiler/sourcemap.nim @@ -0,0 +1,206 @@ +import std/[strutils, strscans, parseutils, assertions] + +type + 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 + +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 +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 = "" + 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: + 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 new file mode 100644 index 000000000..58d5a4928 --- /dev/null +++ b/compiler/spawn.nim @@ -0,0 +1,445 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## This module implements threadpool's ``spawn``. + +import ast, types, idents, magicsys, msgs, options, modulegraphs, + lowerings, liftdestructors, renderer +from trees import getMagic, getRoot + +proc callProc(a: PNode): PNode = + result = newNodeI(nkCall, a.info) + result.add a + result.typ = a.typ.returnType + +# we have 4 cases to consider: +# - a void proc --> nothing to do +# - a proc returning GC'ed memory --> requires a flowVar +# - a proc returning non GC'ed memory --> pass as hidden 'var' parameter +# - not in a parallel environment --> requires a flowVar for memory safety +type + TSpawnResult* = enum + srVoid, srFlowVar, srByVar + TFlowVarKind = enum + fvInvalid # invalid type T for 'FlowVar[T]' + fvGC # FlowVar of a GC'ed type + fvBlob # FlowVar of a blob type + +proc spawnResult*(t: PType; inParallel: bool): TSpawnResult = + if t.isEmptyType: srVoid + elif inParallel and not containsGarbageCollectedRef(t): srByVar + else: srFlowVar + +proc flowVarKind(c: ConfigRef, t: PType): TFlowVarKind = + if c.selectedGC in {gcArc, gcOrc, gcAtomicArc}: fvBlob + elif t.skipTypes(abstractInst).kind in {tyRef, tyString, tySequence}: fvGC + elif containsGarbageCollectedRef(t): fvInvalid + else: fvBlob + +proc typeNeedsNoDeepCopy(t: PType): bool = + var t = t.skipTypes(abstractInst) + # for the tconvexhull example (and others) we're a bit lax here and pretend + # seqs and strings are *by value* only and 'shallow' doesn't exist! + if t.kind == tyString: return true + # 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.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), idgen, owner, varSection.info, + owner.options) + result.typ = typ + incl(result.flags, sfFromGeneric) + + var vpart = newNodeI(nkIdentDefs, varSection.info, 3) + vpart[0] = newSymNode(result) + vpart[1] = newNodeI(nkEmpty, varSection.info) + vpart[2] = if varInit.isNil: v else: vpart[1] + varSection.add vpart + if varInit != nil: + if g.config.selectedGC in {gcArc, gcOrc, gcAtomicArc}: + # inject destructors pass will do its own analysis + varInit.add newFastMoveStmt(g, newSymNode(result), v) + else: + if useShallowCopy and typeNeedsNoDeepCopy(typ) or optTinyRtti in g.config.globalOptions: + varInit.add newFastMoveStmt(g, newSymNode(result), v) + else: + let deepCopyCall = newNodeI(nkCall, varInit.info, 3) + deepCopyCall[0] = newSymNode(getSysMagic(g, varSection.info, "deepCopy", mDeepCopy)) + deepCopyCall[1] = newSymNode(result) + deepCopyCall[2] = v + varInit.add deepCopyCall + +discard """ +We generate roughly this: + +proc f_wrapper(thread, args) = + barrierEnter(args.barrier) # for parallel statement + var a = args.a # thread transfer; deepCopy or shallowCopy or no copy + # depending on whether we're in a 'parallel' statement + var b = args.b + var fv = args.fv + + fv.owner = thread # optional + nimArgsPassingDone() # signal parent that the work is done + # + args.fv.blob = f(a, b, ...) + nimFlowVarSignal(args.fv) + + # - or - + f(a, b, ...) + barrierLeave(args.barrier) # for parallel statement + +stmtList: + var scratchObj + scratchObj.a = a + scratchObj.b = b + + nimSpawn(f_wrapper, addr scratchObj) + scratchObj.fv # optional + +""" + +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 = nil + if barrier != nil: + var varSection2 = newNodeI(nkVarSection, barrier.info) + threadLocalBarrier = addLocalVar(g, varSection2, nil, idgen, result, + barrier.typ, barrier) + body.add varSection2 + body.add callCodegenProc(g, "barrierEnter", threadLocalBarrier.info, + threadLocalBarrier.newSymNode) + var threadLocalProm: PSym = nil + if spawnKind == srByVar: + threadLocalProm = addLocalVar(g, varSection, nil, idgen, result, fv.typ, fv) + elif fv != nil: + internalAssert g.config, fv.typ.kind == tyGenericInst + threadLocalProm = addLocalVar(g, varSection, nil, idgen, result, fv.typ, fv) + body.add varSection + body.add varInit + if fv != nil and spawnKind != srByVar: + # generate: + # fv.owner = threadParam + body.add newAsgnStmt(indirectAccess(threadLocalProm.newSymNode, + "owner", fv.info, g.cache), threadParam.newSymNode) + + body.add callCodegenProc(g, "nimArgsPassingDone", threadParam.info, + threadParam.newSymNode) + if spawnKind == srByVar: + body.add newAsgnStmt(genDeref(threadLocalProm.newSymNode), call) + elif fv != nil: + 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.firstGenericParam)) + body.add newAsgnStmt(indirectAccess(threadLocalProm.newSymNode, + if fk == fvGC: "data" else: "blob", fv.info, g.cache), call) + if fk == fvGC: + let incRefCall = newNodeI(nkCall, fv.info, 2) + incRefCall[0] = newSymNode(getSysMagic(g, fv.info, "GCref", mGCref)) + incRefCall[1] = indirectAccess(threadLocalProm.newSymNode, + "data", fv.info, g.cache) + body.add incRefCall + 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, + castExpr) + else: + body.add call + if barrier != nil: + body.add callCodegenProc(g, "barrierLeave", threadLocalBarrier.info, + threadLocalBarrier.newSymNode) + + var params = newNodeI(nkFormalParams, f.info) + params.add newNodeI(nkEmpty, f.info) + params.add threadParam.newSymNode + params.add argsParam.newSymNode + + var t = newType(tyProc, idgen, threadParam.owner) + t.rawAddSon nil + t.rawAddSon threadParam.typ + t.rawAddSon argsParam.typ + t.n = newNodeI(nkFormalParams, f.info) + t.n.add newNodeI(nkEffectList, f.info) + t.n.add threadParam.newSymNode + t.n.add argsParam.newSymNode + + let emptyNode = newNodeI(nkEmpty, f.info) + result.ast = newProcNode(nkProcDef, f.info, body = body, + params = params, name = newSymNode(result), pattern = emptyNode, + genericParams = emptyNode, pragmas = emptyNode, + exceptions = emptyNode) + result.typ = t + +proc createCastExpr(argsParam: PSym; objType: PType; idgen: IdGenerator): PNode = + result = newNodeI(nkCast, argsParam.info) + result.add newNodeI(nkEmpty, argsParam.info) + result.add newSymNode(argsParam) + result.typ = newType(tyPtr, idgen, objType.owner) + result.typ.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, + varSection, varInit, result: PNode) = + let formals = n[0].typ.n + let tmpName = getIdent(g.cache, genPrefix) + for i in 1..<n.len: + # we pick n's type here, which hopefully is 'tyArray' and not + # 'tyOpenArray': + var argType = n[i].typ.skipTypes(abstractInst) + if i < formals.len: + if formals[i].typ.kind in {tyVar, tyLent}: + localError(g.config, n[i].info, "'spawn'ed function cannot have a 'var' parameter") + + 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, idgen, objType.owner, n.info, g.config.options) + field.typ = argType + discard objType.addField(field, g.cache, idgen) + result.add newFastAsgnStmt(newDotExpr(scratchObj, field), n[i]) + + let temp = addLocalVar(g, varSection, varInit, idgen, owner, argType, + indirectAccess(castExpr, field, n.info)) + call.add(newSymNode(temp)) + +proc setupArgsForParallelism(g: ModuleGraph; n: PNode; objType: PType; + idgen: IdGenerator; + owner: PSym; scratchObj: PSym; + castExpr, call, + varSection, varInit, result: PNode) = + let formals = n[0].typ.n + let tmpName = getIdent(g.cache, genPrefix) + # we need to copy the foreign scratch object fields into local variables + # for correctness: These are called 'threadLocal' here. + for i in 1..<n.len: + 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, idgen, objType.owner, n.info, g.config.options) + + if argType.kind in {tyVarargs, tyOpenArray}: + # important special case: we always create a zero-copy slice: + let slice = newNodeI(nkCall, n.info, 4) + slice.typ = n.typ + slice[0] = newSymNode(createMagic(g, idgen, "slice", mSlice)) + slice[0].typ = getSysType(g, n.info, tyInt) # fake type + var fieldB = newSym(skField, tmpName, idgen, objType.owner, n.info, g.config.options) + fieldB.typ = getSysType(g, n.info, tyInt) + discard objType.addField(fieldB, g.cache, idgen) + + if getMagic(n) == mSlice: + let a = genAddrOf(n[1], idgen) + field.typ = a.typ + discard objType.addField(field, g.cache, idgen) + result.add newFastAsgnStmt(newDotExpr(scratchObj, field), a) + + var fieldA = newSym(skField, tmpName, idgen, objType.owner, n.info, g.config.options) + fieldA.typ = getSysType(g, n.info, tyInt) + discard objType.addField(fieldA, g.cache, idgen) + result.add newFastAsgnStmt(newDotExpr(scratchObj, fieldA), n[2]) + result.add newFastAsgnStmt(newDotExpr(scratchObj, fieldB), n[3]) + + let threadLocal = addLocalVar(g, varSection, nil, idgen, owner, fieldA.typ, + indirectAccess(castExpr, fieldA, n.info), + useShallowCopy=true) + slice[2] = threadLocal.newSymNode + else: + let a = genAddrOf(n, idgen) + field.typ = a.typ + discard objType.addField(field, g.cache, idgen) + result.add newFastAsgnStmt(newDotExpr(scratchObj, field), a) + result.add newFastAsgnStmt(newDotExpr(scratchObj, fieldB), genHigh(g, n)) + + slice[2] = newIntLit(g, n.info, 0) + # the array itself does not need to go through a thread local variable: + slice[1] = genDeref(indirectAccess(castExpr, field, n.info)) + + let threadLocal = addLocalVar(g, varSection, nil, idgen, owner, fieldB.typ, + indirectAccess(castExpr, fieldB, n.info), + useShallowCopy=true) + slice[3] = threadLocal.newSymNode + call.add slice + elif (let size = computeSize(g.config, argType); size < 0 or size > 16) and + n.getRoot != nil: + # it is more efficient to pass a pointer instead: + let a = genAddrOf(n, idgen) + field.typ = a.typ + 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), + useShallowCopy=true) + call.add(genDeref(threadLocal.newSymNode)) + else: + # boring case + field.typ = argType + discard objType.addField(field, g.cache, idgen) + result.add newFastAsgnStmt(newDotExpr(scratchObj, field), n) + let threadLocal = addLocalVar(g, varSection, varInit, + idgen, owner, field.typ, + indirectAccess(castExpr, field, n.info), + useShallowCopy=true) + call.add(threadLocal.newSymNode) + +proc wrapProcForSpawn*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; spawnExpr: PNode; retType: PType; + 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] + let spawnKind = spawnResult(retType, barrier!=nil) + case spawnKind + of srVoid: + internalAssert g.config, dest == nil + result = newNodeI(nkStmtList, n.info) + of srFlowVar: + internalAssert g.config, dest == nil + result = newNodeIT(nkStmtListExpr, n.info, retType) + of srByVar: + if dest == nil: localError(g.config, n.info, "'spawn' must not be discarded") + result = newNodeI(nkStmtList, n.info) + + if n.kind notin nkCallKinds: + 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 == {}: + localError(g.config, n.info, "'spawn' takes a GC safe call expression") + + var fn = n[0] + let + name = (if fn.kind == nkSym: fn.sym.name.s else: genPrefix) & "Wrapper" + 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: + let ptrType = getSysType(g, n.info, tyPointer) + threadParam.typ = ptrType + argsParam.typ = ptrType + argsParam.position = 1 + + var objType = createObj(g, idgen, owner, n.info) + incl(objType.flags, tfFinal) + let castExpr = createCastExpr(argsParam, objType, idgen) + + var scratchObj = newSym(skVar, getIdent(g.cache, "scratch"), idgen, owner, n.info, g.config.options) + block: + scratchObj.typ = objType + incl(scratchObj.flags, sfFromGeneric) + var varSectionB = newNodeI(nkVarSection, n.info) + varSectionB.addVar(scratchObj.newSymNode) + result.add varSectionB + + var call = newNodeIT(nkCall, n.info, n.typ) + # templates and macros are in fact valid here due to the nature of + # the transformation: + if fn.kind == nkClosure or (fn.typ != nil and fn.typ.callConv == ccClosure): + localError(g.config, n.info, "closure in spawn environment is not allowed") + if not (fn.kind == nkSym and fn.sym.kind in {skProc, skTemplate, skMacro, + skFunc, skMethod, skConverter}): + # for indirect calls we pass the function pointer in the scratchObj + var argType = n[0].typ.skipTypes(abstractInst) + var field = newSym(skField, getIdent(g.cache, "fn"), idgen, owner, n.info, g.config.options) + field.typ = argType + 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") + + call.add(fn) + var varSection = newNodeI(nkVarSection, n.info) + var varInit = newNodeI(nkStmtList, n.info) + if barrier.isNil: + setupArgsForConcurrency(g, n, objType, idgen, wrapperProc, scratchObj, castExpr, call, + varSection, varInit, result) + else: + setupArgsForParallelism(g, n, objType, idgen, wrapperProc, scratchObj, castExpr, call, + varSection, varInit, result) + + var barrierAsExpr: PNode = nil + if barrier != nil: + let typ = newType(tyPtr, idgen, owner) + typ.rawAddSon(magicsys.getCompilerProc(g, "Barrier").typ) + var field = newSym(skField, getIdent(g.cache, "barrier"), idgen, owner, n.info, g.config.options) + field.typ = typ + 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"), idgen, owner, n.info, g.config.options) + field.typ = retType + 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: + let castExpr = castToVoidPointer(g, n, fvField) + result.add callCodegenProc(g, "nimFlowVarCreateSemaphore", fvField.info, castExpr) + + elif spawnKind == srByVar: + var field = newSym(skField, getIdent(g.cache, "fv"), idgen, owner, n.info, g.config.options) + field.typ = newType(tyPtr, idgen, objType.owner) + field.typ.rawAddSon(retType) + discard objType.addField(field, g.cache, idgen) + fvAsExpr = indirectAccess(castExpr, field, n.info) + result.add newFastAsgnStmt(newDotExpr(scratchObj, field), genAddrOf(dest, idgen)) + + createTypeBoundOps(g, nil, objType, n.info, idgen) + createWrapperProc(g, fn, threadParam, argsParam, + varSection, varInit, call, + barrierAsExpr, fvAsExpr, idgen, spawnKind, wrapperProc) + result.add callCodegenProc(g, "nimSpawn" & $spawnExpr.len, wrapperProc.info, + wrapperProc.newSymNode, genAddrOf(scratchObj.newSymNode, idgen), nil, spawnExpr) + + if spawnKind == srFlowVar: result.add fvField diff --git a/compiler/suggest.nim b/compiler/suggest.nim index a21d64338..a5213086b 100644 --- a/compiler/suggest.nim +++ b/compiler/suggest.nim @@ -32,11 +32,13 @@ # included from sigmatch.nim -import algorithm, prefixmatches, lineinfos -from wordrecg import wDeprecated +import prefixmatches, suggestsymdb +from wordrecg import wDeprecated, wError, wAddr, wYield + +import std/[algorithm, sets, parseutils, tables] when defined(nimsuggest): - import passes, tables # importer + import pathutils # importer const sep = '\t' @@ -47,19 +49,21 @@ template origModuleName(m: PSym): string = m.name.s proc findDocComment(n: PNode): PNode = if n == nil: return nil - if not isNil(n.comment): return n + if n.comment.len > 0: return n if n.kind in {nkStmtList, nkStmtListExpr, nkObjectTy, nkRecList} and n.len > 0: - result = findDocComment(n.sons[0]) + result = findDocComment(n[0]) if result != nil: return if n.len > 1: - result = findDocComment(n.sons[1]) - elif n.kind in {nkAsgn, nkFastAsgn} and n.len == 2: - result = findDocComment(n.sons[1]) + result = findDocComment(n[1]) + elif n.kind in {nkAsgn, nkFastAsgn, nkSinkAsgn} and n.len == 2: + result = findDocComment(n[1]) + else: + result = nil -proc extractDocComment(s: PSym): string = +proc extractDocComment(g: ModuleGraph; s: PSym): string = var n = findDocComment(s.ast) if n.isNil and s.kind in routineKinds and s.ast != nil: - n = findDocComment(s.ast[bodyPos]) + n = findDocComment(getBody(g, s)) if not n.isNil: result = n.comment.replace("\n##", "\n").strip else: @@ -70,25 +74,78 @@ proc cmpSuggestions(a, b: Suggest): int = result = b.field.int - a.field.int if result != 0: return result - cf scope cf prefix + cf contextFits + cf scope # when the first type matches, it's better when it's a generic match: cf quality - cf contextFits cf localUsages cf globalUsages # if all is equal, sort alphabetically for deterministic output, # independent of hashing order: result = cmp(a.name[], b.name[]) -proc symToSuggest(conf: ConfigRef; s: PSym, isLocal: bool, section: IdeCmd, info: TLineInfo; +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) + + proc isOpeningBacktick(col: int): bool = + if col >= 0 and col < line.len: + if line[col] == '`': + not isOpeningBacktick(col - 1) + else: + isOpeningBacktick(col - 1) + else: + false + + if column > line.len: + result = 0 + elif column > 0 and line[column - 1] == '`' and isOpeningBacktick(column - 1): + result = skipUntil(line, '`', column) + if cmpIgnoreStyle(line[column..column + result - 1], ident) != 0: + result = 0 + elif column >= 0 and line[column] == '`' and isOpeningBacktick(column): + result = skipUntil(line, '`', column + 1) + 2 + if cmpIgnoreStyle(line[column + 1..column + result - 2], ident) != 0: + result = 0 + elif ident[0] in linter.Letters and ident[^1] != '=': + result = identLen(line, column) + if cmpIgnoreStyle(line[column..column + result - 1], ident[0..min(result-1,len(ident)-1)]) != 0: + result = 0 + if skipTrailingAsterisk and result > 0: + result += scanForTrailingAsterisk(line, column + result) + else: + var sourceIdent: string = "" + result = parseWhile(line, sourceIdent, + OpChars + {'[', '(', '{', ']', ')', '}'}, column) + if ident[^1] == '=' and ident[0] in linter.Letters: + if sourceIdent != "=": + result = 0 + 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; quality: range[0..100]; prefix: PrefixMatch; - inTypeContext: bool; scope: int): Suggest = + inTypeContext: bool; scope: int; + useSuppliedInfo = false, + endLine: uint16 = 0, + endCol = 0, extractDocs = true): Suggest = new(result) result.section = section result.quality = quality result.isGlobal = sfGlobal in s.flags - result.tokenLen = s.name.s.len result.prefix = prefix result.contextFits = inTypeContext == (s.kind in {skType, skGenericParam}) result.scope = scope @@ -100,7 +157,7 @@ proc symToSuggest(conf: ConfigRef; s: PSym, isLocal: bool, section: IdeCmd, info if u.fileIndex == info.fileIndex: inc c result.localUsages = c result.symkind = byte s.kind - if optIdeTerse notin conf.globalOptions: + if optIdeTerse notin g.config.globalOptions: result.qualifiedPath = @[] if not isLocal and s.kind != skModule: let ow = s.owner @@ -109,60 +166,146 @@ proc symToSuggest(conf: ConfigRef; s: PSym, isLocal: bool, section: IdeCmd, info result.qualifiedPath.add(ow2.origModuleName) if ow != nil: result.qualifiedPath.add(ow.origModuleName) - result.qualifiedPath.add(s.name.s) + if s.name.s[0] in OpChars + {'[', '{', '('} or + s.name.id in ord(wAddr)..ord(wYield): + result.qualifiedPath.add('`' & s.name.s & '`') + else: + 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): - result.doc = s.extractDocComment - let infox = if section in {ideUse, ideHighlight, ideOutline}: info else: s.info - result.filePath = toFullPath(conf, infox) - result.line = toLinenumber(infox) - result.column = toColumn(infox) - result.version = conf.suggestVersion + when defined(nimsuggest) and not defined(noDocgen) and not defined(leanCompiler): + 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.endLine = endLine + result.endCol = endCol + +proc `$`*(suggest: SuggestInlayHint): string = + result = $suggest.kind + result.add(sep) + 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 = - result = $suggest.section - 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) + 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 = $suggest.section result.add(sep) - result.add(suggest.filePath) - result.add(sep) - result.add($suggest.line) - result.add(sep) - result.add($suggest.column) - result.add(sep) - when defined(nimsuggest) and not defined(noDocgen): - 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.quality) - if suggest.section == ideSug: + 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.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: @@ -190,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 @@ -205,57 +352,63 @@ 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 -proc suggestField(c: PContext, s: PSym; f: PNode; info: TLineInfo; outputs: var Suggestions) = - var pm: PrefixMatch - if filterSym(s, f, pm) and fieldVisible(c, s): - outputs.add(symToSuggest(c.config, s, isLocal=true, ideSug, info, 100, pm, c.inTypeContext > 0, 0)) + 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] = - if s.typ != nil and s.typ.len > 1: - var exp = s.typ.sons[1].skipTypes({tyGenericInst, tyVar, tyLent, tyAlias, tySink}) + result = 100 + 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 {tyExpr, tyStmt, tyGenericParam, tyAnything}: return 50 - return 100 - -template wholeSymTab(cond, section: untyped) = - var isLocal = true - var scopeN = 0 - for scope in walkScopes(c.currentScope): - if scope == c.topLevelScope: isLocal = false - dec scopeN - for item in scope.symbols: - let it {.inject.} = item - var pm {.inject.}: PrefixMatch - if cond: - outputs.add(symToSuggest(c.config, it, isLocal = isLocal, section, info, getQuality(it), - pm, c.inTypeContext > 0, scopeN)) + if exp.kind in {tyUntyped, tyTyped, tyGenericParam, tyAnything}: result = 50 + + # penalize deprecated symbols + if sfDeprecated in s.flags: + result = result - 5 + +proc suggestField(c: PContext, s: PSym; f: PNode; info: TLineInfo; outputs: var Suggestions) = + 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 uniqueSyms(c): + let it = item + var pm: PrefixMatch = default(PrefixMatch) + if cond: + outputs.add(symToSuggest(c.graph, it, isLocal = isLocal, section, info, getQuality(it), + pm, c.inTypeContext > 0, scopeN)) proc suggestSymList(c: PContext, list, f: PNode; info: TLineInfo, outputs: var Suggestions) = - for i in countup(0, sonsLen(list) - 1): - if list.sons[i].kind == nkSym: - suggestField(c, list.sons[i].sym, f, info, outputs) + for i in 0..<list.len: + if list[i].kind == nkSym: + suggestField(c, list[i].sym, f, info, outputs) #else: InternalError(list.info, "getSymFromList") proc suggestObject(c: PContext, n, f: PNode; info: TLineInfo, outputs: var Suggestions) = case n.kind of nkRecList: - for i in countup(0, sonsLen(n)-1): suggestObject(c, n.sons[i], f, info, outputs) + for i in 0..<n.len: suggestObject(c, n[i], f, info, outputs) of nkRecCase: - var L = sonsLen(n) - if L > 0: - suggestObject(c, n.sons[0], f, info, outputs) - for i in countup(1, L-1): suggestObject(c, lastSon(n.sons[i]), f, info, outputs) + if n.len > 0: + suggestObject(c, n[0], f, info, outputs) + for i in 1..<n.len: suggestObject(c, lastSon(n[i]), f, info, outputs) of nkSym: suggestField(c, n.sym, f, info, outputs) else: discard proc nameFits(c: PContext, s: PSym, n: PNode): bool = - var op = n.sons[0] - if op.kind in {nkOpenSymChoice, nkClosedSymChoice}: op = op.sons[0] + var op = if n.kind in nkCallKinds: n[0] else: n + if op.kind in {nkOpenSymChoice, nkClosedSymChoice}: op = op[0] + if op.kind == nkDotExpr: op = op[1] var opr: PIdent case op.kind of nkSym: opr = op.sym.name @@ -266,8 +419,7 @@ proc nameFits(c: PContext, s: PSym, n: PNode): bool = proc argsFit(c: PContext, candidate: PSym, n, nOrig: PNode): bool = case candidate.kind of OverloadableSyms: - var m: TCandidate - initCandidate(c, m, candidate, nil) + var m = newCandidate(c, candidate, nil) sigmatch.partialMatch(c, n, nOrig, m) result = m.state != csNoMatch else: @@ -278,18 +430,24 @@ proc suggestCall(c: PContext, n, nOrig: PNode, outputs: var Suggestions) = wholeSymTab(filterSym(it, nil, pm) and nameFits(c, it, n) and argsFit(c, it, n, nOrig), ideCon) +proc suggestVar(c: PContext, n: PNode, outputs: var Suggestions) = + let info = n.info + wholeSymTab(nameFits(c, it, n), ideCon) + proc typeFits(c: PContext, s: PSym, firstArg: PType): bool {.inline.} = - if s.typ != nil and sonsLen(s.typ) > 1 and s.typ.sons[1] != nil: - # special rule: if system and some weird generic match via 'tyExpr' + 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.sons[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 {tyExpr, tyStmt, tyGenericParam, tyAnything}: return - result = sigmatch.argtypeMatches(c, s.typ.sons[1], firstArg) + if exp.kind in {tyUntyped, tyTyped, tyGenericParam, tyAnything}: return + 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 @@ -298,39 +456,36 @@ 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: - var isLocal = true - var scopeN = 0 - for scope in walkScopes(c.currentScope): - if scope == c.topLevelScope: isLocal = false - dec scopeN - for it in items(scope.symbols): - var pm: PrefixMatch - if filterSym(it, f, pm): - outputs.add(symToSuggest(c.config, it, isLocal = isLocal, ideSug, n.info, 0, pm, - c.inTypeContext > 0, scopeN)) - #if scope == c.topLevelScope and f.isNil: break + 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)) 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. let fullPath = findModule(c.config, n.sym.name.s, toFullPath(c.config, n.info)) - if fullPath.len == 0: + if fullPath.isEmpty: # error: no known module name: typ = nil else: - let m = c.graph.importModuleCallback(c.graph, c.module, fileInfoIdx(c.config, fullpath)) + let m = c.graph.importModuleCallback(c.graph, c.module, fileInfoIdx(c.config, fullPath)) if m == nil: typ = nil else: - for it in items(n.sym.tab): + for it in allSyms(c.graph, n.sym): if filterSym(it, field, pm): - outputs.add(symToSuggest(c.config, it, isLocal=false, ideSug, n.info, 100, pm, c.inTypeContext > 0, -100)) - outputs.add(symToSuggest(c.config, m, isLocal=false, ideMod, n.info, 100, PrefixMatch.None, - c.inTypeContext > 0, -99)) + outputs.add(symToSuggest(c.graph, it, isLocal=false, ideSug, + n.info, it.getQuality, pm, + c.inTypeContext > 0, -100)) + outputs.add(symToSuggest(c.graph, m, isLocal=false, ideMod, n.info, + 100, PrefixMatch.None, c.inTypeContext > 0, + -99)) if typ == nil: # a module symbol has no type for example: @@ -339,32 +494,45 @@ proc suggestFieldAccess(c: PContext, n, field: PNode, outputs: var Suggestions) # all symbols accessible, because we are in the current module: for it in items(c.topLevelScope.symbols): if filterSym(it, field, pm): - outputs.add(symToSuggest(c.config, it, isLocal=false, ideSug, n.info, 100, pm, c.inTypeContext > 0, -99)) + outputs.add(symToSuggest(c.graph, it, isLocal=false, ideSug, + n.info, it.getQuality, pm, + c.inTypeContext > 0, -99)) else: - for it in items(n.sym.tab): + for it in allSyms(c.graph, n.sym): if filterSym(it, field, pm): - outputs.add(symToSuggest(c.config, it, isLocal=false, ideSug, n.info, 100, pm, c.inTypeContext > 0, -99)) + outputs.add(symToSuggest(c.graph, it, isLocal=false, ideSug, + n.info, it.getQuality, pm, + c.inTypeContext > 0, -99)) else: # fallback: suggestEverything(c, n, field, outputs) - elif typ.kind == tyEnum and n.kind == nkSym and n.sym.kind == skType: - # look up if the identifier belongs to the enum: - var t = typ - while t != nil: - suggestSymList(c, t.n, field, n.info, outputs) - t = t.sons[0] - suggestOperations(c, n, field, typ, outputs) else: - let orig = typ # skipTypes(typ, {tyGenericInst, tyAlias, tySink}) - typ = skipTypes(typ, {tyGenericInst, tyVar, tyLent, tyPtr, tyRef, tyAlias, tySink}) - if typ.kind == tyObject: + let orig = typ + typ = skipTypes(orig, {tyTypeDesc, tyGenericInst, tyVar, tyLent, tyPtr, tyRef, tyAlias, tySink, tyOwned}) + + if typ.kind == tyEnum and n.kind == nkSym and n.sym.kind == skType: + # look up if the identifier belongs to the enum: + var t = typ + while t != nil: + suggestSymList(c, t.n, field, n.info, outputs) + t = t.baseClass + elif typ.kind == tyObject: var t = typ while true: suggestObject(c, t.n, field, n.info, outputs) - if t.sons[0] == nil: break - t = skipTypes(t.sons[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) @@ -375,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, @@ -401,28 +586,31 @@ when defined(nimsuggest): if infoB.infoToInt == infoAsInt: return s.allUsages.add(info) -proc findUsages(conf: ConfigRef; info: TLineInfo; s: PSym; usageSym: var PSym) = - if conf.suggestVersion == 1: - if usageSym == nil and isTracked(info, conf.m.trackPos, s.name.s.len): +proc findUsages(g: ModuleGraph; info: TLineInfo; s: PSym; usageSym: var PSym) = + if g.config.suggestVersion == 1: + if usageSym == nil and isTracked(info, g.config.m.trackPos, s.name.s.len): usageSym = s - suggestResult(conf, symToSuggest(conf, s, isLocal=false, ideUse, info, 100, PrefixMatch.None, false, 0)) + suggestResult(g.config, symToSuggest(g, s, isLocal=false, ideUse, info, 100, PrefixMatch.None, false, 0)) elif s == usageSym: - if conf.lastLineInfo != info: - suggestResult(conf, symToSuggest(conf, s, isLocal=false, ideUse, info, 100, PrefixMatch.None, false, 0)) - conf.lastLineInfo = info + if g.config.lastLineInfo != info: + suggestResult(g.config, symToSuggest(g, s, isLocal=false, ideUse, info, 100, PrefixMatch.None, false, 0)) + g.config.lastLineInfo = info when defined(nimsuggest): - proc listUsages*(conf: ConfigRef; s: PSym) = - #echo "usages ", len(s.allUsages) + proc listUsages*(g: ModuleGraph; s: PSym) = + #echo "usages ", s.allUsages.len for info in s.allUsages: let x = if info == s.info and info.col == s.info.col: ideDef else: ideUse - suggestResult(conf, symToSuggest(conf, s, isLocal=false, x, info, 100, PrefixMatch.None, false, 0)) + suggestResult(g.config, symToSuggest(g, s, isLocal=false, x, info, 100, PrefixMatch.None, false, 0)) -proc findDefinition(conf: ConfigRef; info: TLineInfo; s: PSym) = +proc findDefinition(g: ModuleGraph; info: TLineInfo; s: PSym; usageSym: var PSym) = if s.isNil: return - if isTracked(info, conf.m.trackPos, s.name.s.len): - suggestResult(conf, symToSuggest(conf, s, isLocal=false, ideDef, info, 100, PrefixMatch.None, false, 0)) - suggestQuit() + 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 and g.config.suggestVersion < 3: + suggestQuit() + else: + usageSym = s proc ensureIdx[T](x: var T, y: int) = if x.len <= y: x.setLen(y+1) @@ -430,53 +618,104 @@ proc ensureIdx[T](x: var T, y: int) = proc ensureSeq[T](x: var seq[T]) = if x == nil: newSeq(x, 0) -proc suggestSym*(conf: ConfigRef; info: TLineInfo; s: PSym; usageSym: var PSym; isDecl=true) {.inline.} = +proc suggestSym*(g: ModuleGraph; info: TLineInfo; s: PSym; usageSym: var PSym; isDecl=true) {.inline.} = ## 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.isNil: + if s.allUsages.len == 0: s.allUsages = @[info] else: s.addNoDup(info) if conf.ideCmd == ideUse: - findUsages(conf, info, s, usageSym) + findUsages(g, info, s, usageSym) elif conf.ideCmd == ideDef: - findDefinition(conf, info, s) + findDefinition(g, info, s, usageSym) elif conf.ideCmd == ideDus and s != nil: if isTracked(info, conf.m.trackPos, s.name.s.len): - suggestResult(conf, symToSuggest(conf, s, isLocal=false, ideDef, info, 100, PrefixMatch.None, false, 0)) - findUsages(conf, info, s, usageSym) + suggestResult(conf, symToSuggest(g, s, isLocal=false, ideDef, info, 100, PrefixMatch.None, false, 0)) + findUsages(g, info, s, usageSym) elif conf.ideCmd == ideHighlight and info.fileIndex == conf.m.trackPos.fileIndex: - suggestResult(conf, symToSuggest(conf, s, isLocal=false, ideHighlight, info, 100, PrefixMatch.None, false, 0)) - elif conf.ideCmd == ideOutline and info.fileIndex == conf.m.trackPos.fileIndex and - isDecl: - suggestResult(conf, symToSuggest(conf, s, isLocal=false, ideOutline, info, 100, PrefixMatch.None, false, 0)) + suggestResult(conf, symToSuggest(g, s, isLocal=false, ideHighlight, info, 100, PrefixMatch.None, false, 0)) + elif conf.ideCmd == ideOutline and isDecl: + # if a module is included then the info we have is inside the include and + # we need to walk up the owners until we find the outer most module, + # which will be the last skModule prior to an skPackage. + var + parentFileIndex = info.fileIndex # assume we're in the correct module + parentModule = s.owner + while parentModule != nil and parentModule.kind == skModule: + parentFileIndex = parentModule.info.fileIndex + parentModule = parentModule.owner + + if parentFileIndex == conf.m.trackPos.fileIndex: + suggestResult(conf, symToSuggest(g, s, isLocal=false, ideOutline, info, 100, PrefixMatch.None, false, 0)) proc warnAboutDeprecated(conf: ConfigRef; info: TLineInfo; s: PSym) = - if s.kind in routineKinds: - let n = s.ast[pragmasPos] - if n.kind != nkEmpty: - for it in n: - if whichPragma(it) == wDeprecated and it.safeLen == 2 and - it[1].kind in {nkStrLit..nkTripleStrLit}: - message(conf, info, warnDeprecated, it[1].strVal & "; " & s.name.s) - return - message(conf, info, warnDeprecated, s.name.s) - -proc markUsed(conf: ConfigRef; info: TLineInfo; s: PSym; usageSym: var PSym) = + var pragmaNode: PNode + pragmaNode = if s.kind == skEnumField: extractPragma(s.owner) else: extractPragma(s) + let name = + if s.kind == skEnumField and sfDeprecated notin s.flags: "enum '" & s.owner.name.s & "' which contains field '" & s.name.s & "'" + else: s.name.s + if pragmaNode != nil: + for it in pragmaNode: + if whichPragma(it) == wDeprecated and it.safeLen == 2 and + it[1].kind in {nkStrLit..nkTripleStrLit}: + message(conf, info, warnDeprecated, it[1].strVal & "; " & name & " is deprecated") + return + message(conf, info, warnDeprecated, name & " is deprecated") + +proc userError(conf: ConfigRef; info: TLineInfo; s: PSym) = + let pragmaNode = extractPragma(s) + template bail(prefix: string) = + localError(conf, info, "$1usage of '$2' is an {.error.} defined at $3" % + [prefix, s.name.s, toFileLineCol(conf, s.ast.info)]) + if pragmaNode != nil: + for it in pragmaNode: + if whichPragma(it) == wError and it.safeLen == 2 and + it[1].kind in {nkStrLit..nkTripleStrLit}: + bail(it[1].strVal & "; ") + return + bail("") + +proc markOwnerModuleAsUsed(c: PContext; s: PSym) = + var module = s + while module != nil and module.kind != skModule: + module = module.owner + if module != nil and module != c.module: + var i = 0 + while i <= high(c.unusedImports): + let candidate = c.unusedImports[i][0] + if candidate == module or c.importModuleMap.getOrDefault(candidate.id, int.low) == module.id or + c.exportIndirections.contains((candidate.id, s.id)): + # mark it as used: + c.unusedImports.del(i) + else: + inc i + +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: incl(s.owner.flags, sfUsed) + if sfDeprecated in s.owner.flags: + warnAboutDeprecated(conf, info, s) if {sfDeprecated, sfError} * s.flags != {}: - if sfDeprecated in s.flags: warnAboutDeprecated(conf, info, s) - if sfError in s.flags: localError(conf, info, "usage of '$1' is a user-defined error" % s.name.s) - when defined(nimsuggest): - suggestSym(conf, info, s, usageSym, false) + if sfDeprecated in s.flags: + if not (c.lastTLineInfo.line == info.line and + c.lastTLineInfo.col == info.col): + warnAboutDeprecated(conf, info, s) + c.lastTLineInfo = info -proc useSym*(conf: ConfigRef; sym: PSym; usageSym: var PSym): PNode = - result = newSymNode(sym) - markUsed(conf, result.info, sym, usageSym) + if sfError in s.flags: userError(conf, info, s) + when defined(nimsuggest): + suggestSym(c.graph, info, s, c.graph.usageSym, false) + if checkStyle: + styleCheckUse(c, info, s) + markOwnerModuleAsUsed(c, s) proc safeSemExpr*(c: PContext, n: PNode): PNode = # use only for idetools support! @@ -487,7 +726,7 @@ proc safeSemExpr*(c: PContext, n: PNode): PNode = proc sugExpr(c: PContext, n: PNode, outputs: var Suggestions) = if n.kind == nkDotExpr: - var obj = safeSemExpr(c, n.sons[0]) + var obj = safeSemExpr(c, n[0]) # it can happen that errnously we have collected the fieldname # of the next line, so we check the 'field' is actually on the same # line as the object to prevent this from happening: @@ -498,6 +737,11 @@ proc sugExpr(c: PContext, n: PNode, outputs: var Suggestions) = #if optIdeDebug in gGlobalOptions: # echo "expression ", renderTree(obj), " has type ", typeToString(obj.typ) #writeStackTrace() + elif n.kind == nkIdent: + let + prefix = if c.config.m.trackPosAttached: nil else: n + info = n.info + wholeSymTab(filterSym(it, prefix, pm), ideSug) else: let prefix = if c.config.m.trackPosAttached: nil else: n suggestEverything(c, n, prefix, outputs) @@ -512,15 +756,19 @@ proc suggestExprNoCheck*(c: PContext, n: PNode) = elif c.config.ideCmd == ideCon: if n.kind in nkCallKinds: var a = copyNode(n) - var x = safeSemExpr(c, n.sons[0]) - if x.kind == nkEmpty or x.typ == nil: x = n.sons[0] - addSon(a, x) - for i in 1..sonsLen(n)-1: + var x = safeSemExpr(c, n[0]) + if x.kind == nkEmpty or x.typ == nil: x = n[0] + a.add x + for i in 1..<n.len: # use as many typed arguments as possible: - var x = safeSemExpr(c, n.sons[i]) + var x = safeSemExpr(c, n[i]) if x.kind == nkEmpty or x.typ == nil: break - addSon(a, x) + a.add x suggestCall(c, a, n, outputs) + elif n.kind in nkIdentKinds: + var x = safeSemExpr(c, n) + if x.kind == nkEmpty or x.typ == nil: x = n + suggestVar(c, x, outputs) dec(c.compilesContextId) if outputs.len > 0 and c.config.ideCmd in {ideSug, ideCon, ideDef}: @@ -535,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) = @@ -546,23 +797,63 @@ 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: - var isLocal = true - var scopeN = 0 - for scope in walkScopes(c.currentScope): - if scope == c.topLevelScope: isLocal = false - dec scopeN - for it in items(scope.symbols): - var pm: PrefixMatch - if filterSymNoOpr(it, nil, pm): - outputs.add(symToSuggest(c.config, it, isLocal = isLocal, ideSug, - newLineInfo(c.config.m.trackPos.fileIndex, -1, -1), 0, - PrefixMatch.None, false, scopeN)) + 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, + PrefixMatch.None, false, scopeN)) 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 069f65eee..6b325c77f 100644 --- a/compiler/syntaxes.nim +++ b/compiler/syntaxes.nim @@ -10,55 +10,37 @@ ## Implements the dispatcher for the different parsers. import - strutils, llstream, ast, astalgo, idents, lexer, options, msgs, parser, - filters, filter_tmpl, renderer, lineinfos + llstream, ast, idents, lexer, options, msgs, parser, + filters, filter_tmpl, renderer, lineinfos, pathutils -type - TFilterKind* = enum - filtNone, filtTemplate, filtReplace, filtStrip - TParserKind* = enum - skinStandard, skinStrongSpaces, skinEndX +import std/strutils +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] -const - parserNames*: array[TParserKind, string] = ["standard", "strongspaces", - "endx"] - filterNames*: array[TFilterKind, string] = ["none", "stdtmpl", "replace", - "strip"] +export Parser, parseAll, parseTopLevelStmt, checkFirstLineIndentation, closeParser type - TParsers* = object - skin*: TParserKind - parser*: TParser - -template config(p: TParsers): ConfigRef = p.parser.lex.config - -proc parseAll*(p: var TParsers): PNode = - case p.skin - of skinStandard, skinStrongSpaces: - result = parser.parseAll(p.parser) - of skinEndX: - internalError(p.config, "parser to implement") - -proc parseTopLevelStmt*(p: var TParsers): PNode = - case p.skin - of skinStandard, skinStrongSpaces: - result = parser.parseTopLevelStmt(p.parser) - of skinEndX: - internalError(p.config, "parser to implement") + FilterKind = enum + filtNone = "none" + filtTemplate = "stdtmpl" + filtReplace = "replace" + filtStrip = "strip" proc utf8Bom(s: string): int = if s.len >= 3 and s[0] == '\xEF' and s[1] == '\xBB' and s[2] == '\xBF': - result = 3 + 3 else: - result = 0 + 0 proc containsShebang(s: string, i: int): bool = if i+1 < s.len and s[i] == '#' and s[i+1] == '!': var j = i + 2 while j < s.len and s[j] in Whitespace: inc(j) result = s[j] == '/' + else: + result = false -proc parsePipe(filename: string, inputStream: PLLStream; cache: IdentCache; +proc parsePipe(filename: AbsoluteFile, inputStream: PLLStream; cache: IdentCache; config: ConfigRef): PNode = result = newNode(nkEmpty) var s = llStreamOpen(filename, fmRead) @@ -72,98 +54,92 @@ proc parsePipe(filename: string, inputStream: PLLStream; cache: IdentCache; i = 0 inc linenumber if i+1 < line.len and line[i] == '#' and line[i+1] == '?': - inc(i, 2) - while i < line.len and line[i] in Whitespace: inc(i) - var q: TParser - parser.openParser(q, filename, llStreamOpen(substr(line, i)), cache, config) - result = parser.parseAll(q) - parser.closeParser(q) + when defined(nimpretty): + # XXX this is a bit hacky, but oh well... + 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 = default(Parser) + openParser(p, filename, llStreamOpen(substr(line, i)), cache, config) + result = parseAll(p) + closeParser(p) llStreamClose(s) -proc getFilter(ident: PIdent): TFilterKind = - for i in countup(low(TFilterKind), high(TFilterKind)): - if cmpIgnoreStyle(ident.s, filterNames[i]) == 0: - return i +proc getFilter(ident: PIdent): FilterKind = result = filtNone - -proc getParser(conf: ConfigRef; n: PNode; ident: PIdent): TParserKind = - for i in countup(low(TParserKind), high(TParserKind)): - if cmpIgnoreStyle(ident.s, parserNames[i]) == 0: + for i in FilterKind: + if cmpIgnoreStyle(ident.s, $i) == 0: return i - localError(conf, n.info, "unknown parser: " & ident.s) proc getCallee(conf: ConfigRef; n: PNode): PIdent = - if n.kind in nkCallKinds and n.sons[0].kind == nkIdent: - result = n.sons[0].ident + if n.kind in nkCallKinds and n[0].kind == nkIdent: + result = n[0].ident elif n.kind == nkIdent: result = n.ident else: + result = nil localError(conf, n.info, "invalid filter: " & renderTree(n)) -proc applyFilter(p: var TParsers, n: PNode, filename: string, +proc applyFilter(p: var Parser, n: PNode, filename: AbsoluteFile, stdin: PLLStream): PLLStream = - var ident = getCallee(p.config, n) - var f = getFilter(ident) - case f - of filtNone: - p.skin = getParser(p.config, n, ident) - result = stdin - of filtTemplate: - result = filterTmpl(stdin, filename, n, p.config) - of filtStrip: - result = filterStrip(p.config, stdin, filename, n) - of filtReplace: - result = filterReplace(p.config, stdin, filename, n) + var f = getFilter(getCallee(p.lex.config, n)) + result = case f + of filtNone: + stdin + of filtTemplate: + filterTmpl(p.lex.config, stdin, filename, n) + of filtStrip: + filterStrip(p.lex.config, stdin, filename, n) + of filtReplace: + filterReplace(p.lex.config, stdin, filename, n) if f != filtNone: - assert p.config != nil - if hintCodeBegin in p.config.notes: - rawMessage(p.config, hintCodeBegin, []) - msgWriteln(p.config, result.s) - rawMessage(p.config, hintCodeEnd, []) + assert p.lex.config != nil + if p.lex.config.hasHint(hintCodeBegin): + rawMessage(p.lex.config, hintCodeBegin, "") + msgWriteln(p.lex.config, result.s) + rawMessage(p.lex.config, hintCodeEnd, "") -proc evalPipe(p: var TParsers, n: PNode, filename: string, +proc evalPipe(p: var Parser, n: PNode, filename: AbsoluteFile, start: PLLStream): PLLStream = - assert p.config != nil + assert p.lex.config != nil result = start if n.kind == nkEmpty: return if n.kind == nkInfix and n[0].kind == nkIdent and n[0].ident.s == "|": - for i in countup(1, 2): - if n.sons[i].kind == nkInfix: - result = evalPipe(p, n.sons[i], filename, result) + for i in 1..2: + if n[i].kind == nkInfix: + result = evalPipe(p, n[i], filename, result) else: - result = applyFilter(p, n.sons[i], filename, result) + result = applyFilter(p, n[i], filename, result) elif n.kind == nkStmtList: - result = evalPipe(p, n.sons[0], filename, result) + result = evalPipe(p, n[0], filename, result) else: result = applyFilter(p, n, filename, result) -proc openParsers*(p: var TParsers, fileIdx: FileIndex, inputstream: PLLStream; +proc openParser*(p: var Parser, fileIdx: FileIndex, inputstream: PLLStream; cache: IdentCache; config: ConfigRef) = assert config != nil - var s: PLLStream - p.skin = skinStandard let filename = toFullPathConsiderDirty(config, fileIdx) var pipe = parsePipe(filename, inputstream, cache, config) - p.config() = config - if pipe != nil: s = evalPipe(p, pipe, filename, inputstream) - else: s = inputstream - case p.skin - of skinStandard, skinEndX: - parser.openParser(p.parser, fileIdx, s, cache, config, false) - of skinStrongSpaces: - parser.openParser(p.parser, fileIdx, s, cache, config, true) + p.lex.config = config + let s = if pipe != nil: evalPipe(p, pipe, filename, inputstream) + else: inputstream + parser.openParser(p, fileIdx, s, cache, config) -proc closeParsers*(p: var TParsers) = - parser.closeParser(p.parser) - -proc parseFile*(fileIdx: FileIndex; cache: IdentCache; config: ConfigRef): PNode {.procvar.} = - var - p: TParsers - f: File +proc setupParser*(p: var Parser; fileIdx: FileIndex; cache: IdentCache; + config: ConfigRef): bool = let filename = toFullPathConsiderDirty(config, fileIdx) - if not open(f, filename): - rawMessage(config, errGenerated, "cannot open file: " & filename) - return - openParsers(p, fileIdx, llStreamOpen(f), cache, config) - result = parseAll(p) - closeParsers(p) + var f: File = default(File) + if not open(f, filename.string): + rawMessage(config, errGenerated, "cannot open file: " & filename.string) + return false + openParser(p, fileIdx, llStreamOpen(f), cache, config) + result = true + +proc parseFile*(fileIdx: FileIndex; cache: IdentCache; config: ConfigRef): PNode = + 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 ea0fb590f..9ee8516c4 100644 --- a/compiler/tccgen.nim +++ b/compiler/tccgen.nim @@ -8,12 +8,20 @@ # import - os, strutils, options, msgs, tinyc + os, strutils, options, msgs, tinyc, lineinfos, sequtils -{.compile: "../tinyc/libtcc.c".} +const tinyPrefix = "dist/nim-tinyc-archive".unixToNativePath +const nimRoot = currentSourcePath.parentDir.parentDir +const tinycRoot = nimRoot / tinyPrefix +when not dirExists(tinycRoot): + static: raiseAssert $(tinycRoot, "requires: ./koch installdeps tinyc") +{.compile: tinycRoot / "tinyc/libtcc.c".} + +var + gConf: ConfigRef # ugly but can be cleaned up if this is revived proc tinyCErrorHandler(closure: pointer, msg: cstring) {.cdecl.} = - rawMessage(errGenerated, $msg) + rawMessage(gConf, errGenerated, $msg) proc initTinyCState: PccState = result = openCCState() @@ -25,7 +33,7 @@ var proc addFile(filename: string) = if addFile(gTinyC, filename) != 0'i32: - rawMessage(errCannotOpenFile, filename) + rawMessage(gConf, errCannotOpenFile, filename) proc setupEnvironment = when defined(amd64): @@ -35,42 +43,47 @@ proc setupEnvironment = when defined(linux): defineSymbol(gTinyC, "__linux__", nil) defineSymbol(gTinyC, "__linux", nil) - var nimDir = getPrefixDir() - addIncludePath(gTinyC, libpath) + var nimDir = getPrefixDir(gConf).string + var tinycRoot = nimDir / tinyPrefix + let libpath = nimDir / "lib" + + addIncludePath(gTinyC, cstring(libpath)) when defined(windows): - addSysincludePath(gTinyC, nimrodDir / "tinyc/win32/include") - addSysincludePath(gTinyC, nimrodDir / "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", nimDir] - addSysincludePath(gTinyC, gccbin /../ "include") - #addFile(nimrodDir / r"tinyc\win32\wincrt1.o") - addFile(nimrodDir / r"tinyc\win32\alloca86.o") - addFile(nimrodDir / r"tinyc\win32\chkstk.o") - #addFile(nimrodDir / r"tinyc\win32\crt1.o") + var gccbin = getConfigVar("gcc.path") % ["nim", tinycRoot] + 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") + #addFile(tinycRoot / r"tinyc\win32\crt1.o") - #addFile(nimrodDir / r"tinyc\win32\dllcrt1.o") - #addFile(nimrodDir / r"tinyc\win32\dllmain.o") - addFile(nimrodDir / r"tinyc\win32\libtcc1.o") + #addFile(tinycRoot / r"tinyc\win32\dllcrt1.o") + #addFile(tinycRoot / r"tinyc\win32\dllmain.o") + addFile(tinycRoot / r"tinyc\win32\libtcc1.o") - #addFile(nimrodDir / r"tinyc\win32\lib\crt1.c") - #addFile(nimrodDir / r"tinyc\lib\libtcc1.c") + #addFile(tinycRoot / r"tinyc\win32\lib\crt1.c") + #addFile(tinycRoot / r"tinyc\lib\libtcc1.c") else: addSysincludePath(gTinyC, "/usr/include") when defined(amd64): addSysincludePath(gTinyC, "/usr/include/x86_64-linux-gnu") -proc compileCCode*(ccode: string) = +proc compileCCode*(ccode: string, conf: ConfigRef) = + gConf = conf if not libIncluded: libIncluded = true setupEnvironment() discard compileString(gTinyC, ccode) -proc run*(args: string) = - var s = @[cstring(gProjectName)] & map(split(args), proc(x: string): cstring = cstring(x)) - var err = tinyc.run(gTinyC, cint(len(s)), cast[cstringArray](addr(s[0]))) != 0'i32 +proc run*(conf: ConfigRef, args: string) = + doAssert gConf == conf + var s = @[cstring(conf.projectName)] & map(split(args), proc(x: string): cstring = cstring(x)) + var err = tinyc.run(gTinyC, cint(s.len), cast[cstringArray](addr(s[0]))) != 0'i32 closeCCState(gTinyC) - if err: rawMessage(errExecutionOfProgramFailed, "") + if err: rawMessage(conf, errUnknown, "") diff --git a/compiler/transf.nim b/compiler/transf.nim index ad7f38b91..8dd24e090 100644 --- a/compiler/transf.nim +++ b/compiler/transf.nim @@ -18,68 +18,68 @@ # * performs lambda lifting for closure support # * transforms 'defer' into a 'try finally' statement +import std / tables + import - intsets, strutils, options, ast, astalgo, trees, treetab, msgs, lookups, - idents, renderer, types, passes, semfold, magicsys, cgmeth, - lambdalifting, sempass2, lowerings, destroyer, liftlocals, closureiters, + options, ast, astalgo, trees, msgs, + idents, renderer, types, semfold, magicsys, cgmeth, + lowerings, liftlocals, modulegraphs, lineinfos +when defined(nimPreviewSlimSystem): + import std/assertions + type - PTransNode* = distinct PNode + TransformFlag* = enum + useCache, keepOpenArrayConversions, force + TransformFlags* = set[TransformFlag] + +proc transformBody*(g: ModuleGraph; idgen: IdGenerator; prc: PSym; flags: TransformFlags): PNode - PTransCon = ref TTransCon - TTransCon{.final.} = object # part of TContext; stackable - mapping: TIdNodeTable # mapping from symbols to nodes +import closureiters, lambdalifting + +type + 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: PTransNode # transformed for loop body + forLoopBody: PNode # transformed for loop body yieldStmts: int # we count the number of yield statements, # because we need to introduce new variables # if we encounter the 2nd yield statement next: PTransCon # for stacking - TTransfContext = object of passes.TPassContext + 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, needsDestroyPass: bool + deferDetected, tooEarly: bool + isIntroducingNewLocalVars: bool # true if we are in `introducingNewLocalVars` (don't transform yields) + inAddr: bool + flags: TransformFlags graph: ModuleGraph - PTransf = ref TTransfContext + idgen: IdGenerator -proc newTransNode(a: PNode): PTransNode {.inline.} = - result = PTransNode(shallowCopy(a)) +proc newTransNode(a: PNode): PNode {.inline.} = + result = shallowCopy(a) proc newTransNode(kind: TNodeKind, info: TLineInfo, - sons: int): PTransNode {.inline.} = + sons: int): PNode {.inline.} = var x = newNodeI(kind, info) newSeq(x.sons, sons) - result = x.PTransNode + result = x proc newTransNode(kind: TNodeKind, n: PNode, - sons: int): PTransNode {.inline.} = + sons: int): PNode {.inline.} = var x = newNodeIT(kind, n.info, n.typ) newSeq(x.sons, sons) - x.typ = n.typ - result = x.PTransNode - -proc `[]=`(a: PTransNode, i: int, x: PTransNode) {.inline.} = - var n = PNode(a) - n.sons[i] = PNode(x) - -proc `[]`(a: PTransNode, i: int): PTransNode {.inline.} = - var n = PNode(a) - result = n.sons[i].PTransNode - -proc add(a, b: PTransNode) {.inline.} = addSon(PNode(a), PNode(b)) -proc len(a: PTransNode): int {.inline.} = result = sonsLen(a.PNode) +# 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 @@ -94,36 +94,40 @@ 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), 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: - result = freshVarForClosureIter(c.graph, r, owner) + 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) -proc transform(c: PTransf, n: PNode): PTransNode +proc transform(c: PTransf, n: PNode): PNode -proc transformSons(c: PTransf, n: PNode): PTransNode = +proc transformSons(c: PTransf, n: PNode): PNode = result = newTransNode(n) - for i in countup(0, sonsLen(n)-1): - result[i] = transform(c, n.sons[i]) - -proc newAsgnStmt(c: PTransf, le: PNode, ri: PTransNode): PTransNode = - result = newTransNode(nkFastAsgn, PNode(ri).info, 2) - result[0] = PTransNode(le) + for i in 0..<n.len: + result[i] = transform(c, n[i]) + +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, {useCache}+c.flags) if s.kind == skIterator: if c.tooEarly: return n - else: return liftIterSym(c.graph, n, getCurrOwner(c)) + else: return liftIterSym(c.graph, n, c.idgen, getCurrOwner(c)) elif s.kind in {skProc, skFunc, skConverter, skMethod} and not c.tooEarly: # top level .closure procs are still somewhat supported for 'Nake': - return makeClosure(c.graph, s, nil, n.info) + return makeClosure(c.graph, c.idgen, s, nil, n.info) #elif n.sym.kind in {skVar, skLet} and n.sym.typ.callConv == ccClosure: # echo n.info, " come heer for ", c.tooEarly # if not c.tooEarly: @@ -131,13 +135,34 @@ 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: - b = s.getBody + 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) + elif c.inlining > 0: + # see bug #13596: we use ref-based equality in the DFA for destruction + # injections so we need to ensure unique nodes after iterator inlining + # which can lead to duplicated for loop bodies! Consider: + #[ + while remaining > 0: + if ending == nil: + yield ms + break + ... + yield ms + ]# + b = newSymNode(n.sym, n.info) 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: @@ -147,38 +172,40 @@ proc transformSymAux(c: PTransf, n: PNode): PNode = tc = tc.next result = b -proc transformSym(c: PTransf, n: PNode): PTransNode = - result = PTransNode(transformSymAux(c, n)) +proc transformSym(c: PTransf, n: PNode): PNode = + result = transformSymAux(c, n) proc freshVar(c: PTransf; v: PSym): PNode = let owner = getCurrOwner(c) - if owner.isIterator and not c.tooEarly: - result = freshVarForClosureIter(c.graph, v, owner) + 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) + var newVar = copySym(v, c.idgen) incl(newVar.flags, sfFromGeneric) newVar.owner = owner result = newSymNode(newVar) -proc transformVarSection(c: PTransf, v: PNode): PTransNode = +proc transformVarSection(c: PTransf, v: PNode): PNode = result = newTransNode(v) - for i in countup(0, sonsLen(v)-1): - var it = v.sons[i] + for i in 0..<v.len: + var it = v[i] if it.kind == nkCommentStmt: - result[i] = PTransNode(it) + result[i] = it elif it.kind == nkIdentDefs: - if it.sons[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.sons[0].sym) - idNodeTablePut(c.transCon.mapping, it.sons[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: - PNode(defs).comment = it.comment - defs[0] = x.PTransNode - defs[1] = it.sons[1].PTransNode - defs[2] = transform(c, it.sons[2]) - if x.kind == nkSym: x.sym.ast = defs[2].PNode + defs.comment = it.comment + defs[0] = x + defs[1] = it[1] + defs[2] = transform(c, it[2]) + if x.kind == nkSym: x.sym.ast = defs[2] result[i] = defs else: # has been transformed into 'param.x' for closure iterators, so just @@ -187,67 +214,64 @@ proc transformVarSection(c: PTransf, v: PNode): PTransNode = else: if it.kind != nkVarTuple: internalError(c.graph.config, it.info, "transformVarSection: not nkVarTuple") - var L = sonsLen(it) - var defs = newTransNode(it.kind, it.info, L) - for j in countup(0, L-3): - let x = freshVar(c, it.sons[j].sym) - idNodeTablePut(c.transCon.mapping, it.sons[j].sym, x) - defs[j] = x.PTransNode - assert(it.sons[L-2].kind == nkEmpty) - defs[L-2] = newNodeI(nkEmpty, it.info).PTransNode - defs[L-1] = transform(c, it.sons[L-1]) + var defs = newTransNode(it.kind, it.info, it.len) + for j in 0..<it.len-2: + if it[j].kind == nkSym: + let x = freshVar(c, it[j].sym) + c.transCon.mapping[it[j].sym.itemId] = x + defs[j] = x + else: + defs[j] = transform(c, it[j]) + assert(it[^2].kind == nkEmpty) + defs[^2] = newNodeI(nkEmpty, it.info) + defs[^1] = transform(c, it[^1]) result[i] = defs -proc transformConstSection(c: PTransf, v: PNode): PTransNode = - result = newTransNode(v) - for i in countup(0, sonsLen(v)-1): - var it = v.sons[i] - if it.kind == nkCommentStmt: - result[i] = PTransNode(it) - else: - if it.kind != nkConstDef: internalError(c.graph.config, it.info, "transformConstSection") - if it.sons[0].kind != nkSym: - internalError(c.graph.config, it.info, "transformConstSection") +proc transformConstSection(c: PTransf, v: PNode): PNode = + result = v + when false: + result = newTransNode(v) + for i in 0..<v.len: + var it = v[i] + if it.kind == nkCommentStmt: + result[i] = it + else: + if it.kind != nkConstDef: internalError(c.graph.config, it.info, "transformConstSection") + if it[0].kind != nkSym: + debug it[0] + internalError(c.graph.config, it.info, "transformConstSection") - result[i] = PTransNode(it) + result[i] = it 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: - for i in countup(0, sonsLen(n) - 1): - if hasContinue(n.sons[i]): return true + 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, getCurrOwner(c), n.info) - result.name = getIdent(c.graph.cache, genPrefix & $result.id) - -proc freshLabels(c: PTransf, n: PNode; symMap: var TIdTable) = - if n.kind in {nkBlockStmt, nkBlockExpr}: - if n.sons[0].kind == nkSym: - let x = newLabel(c, n[0]) - idTablePut(symMap, n[0].sym, x) - n.sons[0].sym = x - if n.kind == nkSym and n.sym.kind == skLabel: - let x = PSym(idTableGet(symMap, n.sym)) - if x != nil: n.sym = x - else: - for i in 0 ..< safeLen(n): freshLabels(c, n.sons[i], symMap) + result = newSym(skLabel, getIdent(c.graph.cache, genPrefix), c.idgen, getCurrOwner(c), n.info) -proc transformBlock(c: PTransf, n: PNode): PTransNode = +proc transformBlock(c: PTransf, n: PNode): PNode = var labl: PSym - if n.sons[0].kind != nkEmpty: - # already named block? -> Push symbol on the stack: - labl = n.sons[0].sym + if c.inlining > 0: + labl = newLabel(c, n[0]) + c.transCon.mapping[n[0].sym.itemId] = newSymNode(labl) else: - labl = newLabel(c, n) + labl = + if n[0].kind != nkEmpty: + n[0].sym # already named block? -> Push symbol on the stack + else: + newLabel(c, n) c.breakSyms.add(labl) result = transformSons(c, n) discard c.breakSyms.pop - result[0] = newSymNode(labl).PTransNode + result[0] = newSymNode(labl) -proc transformLoopBody(c: PTransf, n: PNode): PTransNode = +proc transformLoopBody(c: PTransf, n: PNode): PNode = # What if it contains "continue" and "break"? "break" needs # an explicit label too, but not the same! @@ -259,59 +283,41 @@ proc transformLoopBody(c: PTransf, n: PNode): PTransNode = c.contSyms.add(labl) result = newTransNode(nkBlockStmt, n.info, 2) - result[0] = newSymNode(labl).PTransNode + result[0] = newSymNode(labl) result[1] = transform(c, n) discard c.contSyms.pop() else: result = transform(c, n) -proc transformWhile(c: PTransf; n: PNode): PTransNode = +proc transformWhile(c: PTransf; n: PNode): PNode = if c.inlining > 0: result = transformSons(c, n) else: let labl = newLabel(c, n) c.breakSyms.add(labl) result = newTransNode(nkBlockStmt, n.info, 2) - result[0] = newSymNode(labl).PTransNode + result[0] = newSymNode(labl) var body = newTransNode(n) - for i in 0..n.len-2: - body[i] = transform(c, n.sons[i]) - body[n.len-1] = transformLoopBody(c, n.sons[n.len-1]) + for i in 0..<n.len-1: + body[i] = transform(c, n[i]) + body[^1] = transformLoopBody(c, n[^1]) result[1] = body discard c.breakSyms.pop -proc transformBreak(c: PTransf, n: PNode): PTransNode = - if n.sons[0].kind != nkEmpty or c.inlining > 0: - result = n.PTransNode - when false: - let lablCopy = idNodeTableGet(c.transCon.mapping, n.sons[0].sym) - if lablCopy.isNil: - result = n.PTransNode - else: - result = newTransNode(n.kind, n.info, 1) - result[0] = lablCopy.PTransNode - elif c.breakSyms.len > 0: - # this check can fail for 'nim check' +proc transformBreak(c: PTransf, n: PNode): PNode = + result = transformSons(c, n) + if n[0].kind == nkEmpty and c.breakSyms.len > 0: let labl = c.breakSyms[c.breakSyms.high] - result = transformSons(c, n) - result[0] = newSymNode(labl).PTransNode - else: - result = n.PTransNode + result[0] = newSymNode(labl) -proc unpackTuple(c: PTransf, n: PNode, father: PTransNode) = - # XXX: BUG: what if `n` is an expression with side-effects? - for i in countup(0, sonsLen(c.transCon.forStmt) - 3): - add(father, newAsgnStmt(c, c.transCon.forStmt.sons[i], - transform(c, newTupleAccess(c.graph, n, i)))) - -proc introduceNewLocalVars(c: PTransf, n: PNode): PTransNode = +proc introduceNewLocalVars(c: PTransf, n: PNode): PNode = case n.kind of nkSym: result = transformSym(c, n) of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit: # nothing to be done for leaves: - result = PTransNode(n) + result = n of nkVarSection, nkLetSection: result = transformVarSection(c, n) of nkClosure: @@ -320,69 +326,201 @@ proc introduceNewLocalVars(c: PTransf, n: PNode): PTransNode = # (bug #2604). We need to patch this environment here too: let a = n[1] if a.kind == nkSym: - n.sons[1] = transformSymAux(c, a) - return PTransNode(n) + 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 countup(0, sonsLen(n)-1): - result[i] = introduceNewLocalVars(c, n.sons[i]) - -proc transformYield(c: PTransf, n: PNode): PTransNode = + for i in 0..<n.len: + result[i] = introduceNewLocalVars(c, n[i]) + +proc transformAsgn(c: PTransf, n: PNode): PNode = + let rhs = n[1] + + if rhs.kind != nkTupleConstr: + return transformSons(c, n) + + # Unpack the tuple assignment into N temporary variables and then pack them + # into a tuple: this allows us to get the correct results even when the rhs + # depends on the value of the lhs + let letSection = newTransNode(nkLetSection, n.info, rhs.len) + let newTupleConstr = newTransNode(nkTupleConstr, n.info, rhs.len) + for i, field in rhs: + let val = if field.kind == nkExprColonExpr: field[1] else: field + let def = newTransNode(nkIdentDefs, field.info, 3) + def[0] = newTemp(c, val.typ, field.info) + def[1] = newNodeI(nkEmpty, field.info) + def[2] = transform(c, val) + letSection[i] = def + # NOTE: We assume the constructor fields are in the correct order for the + # given tuple type + newTupleConstr[i] = def[0] + + newTupleConstr.typ = rhs.typ + + let asgnNode = newTransNode(nkAsgn, n.info, 2) + asgnNode[0] = transform(c, n[0]) + asgnNode[1] = newTupleConstr + + result = newTransNode(nkStmtList, n.info, 2) + result[0] = letSection + result[1] = asgnNode + +proc transformYield(c: PTransf, n: PNode): PNode = + proc asgnTo(lhs: PNode, rhs: PNode): PNode = + # Choose the right assignment instruction according to the given ``lhs`` + # node since it may not be a nkSym (a stack-allocated skForVar) but a + # nkDotExpr (a heap-allocated slot into the envP block) + case lhs.kind + of nkSym: + internalAssert c.graph.config, lhs.sym.kind == skForVar + result = newAsgnStmt(c, nkFastAsgn, lhs, rhs, false) + of nkDotExpr: + result = newAsgnStmt(c, nkAsgn, lhs, rhs, false) + else: + result = nil + internalAssert c.graph.config, false result = newTransNode(nkStmtList, n.info, 0) - var e = n.sons[0] + var e = n[0] # c.transCon.forStmt.len == 3 means that there is one for loop variable # and thus no tuple unpacking: if e.typ.isNil: return result # can happen in nimsuggest for unknown reasons - if skipTypes(e.typ, {tyGenericInst, tyAlias, tySink}).kind == tyTuple and - c.transCon.forStmt.len != 3: + if c.transCon.forStmt.len != 3: e = skipConv(e) - if e.kind in {nkPar, nkTupleConstr}: - for i in countup(0, sonsLen(e) - 1): - var v = e.sons[i] - if v.kind == nkExprColonExpr: v = v.sons[1] - add(result, newAsgnStmt(c, c.transCon.forStmt.sons[i], - transform(c, v))) + if e.kind == nkTupleConstr: + for i in 0..<e.len: + var v = e[i] + if v.kind == nkExprColonExpr: v = v[1] + 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, v, j)) + result.add(asgnTo(lhs, rhs)) + else: + 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: - unpackTuple(c, e, result) + 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: - var x = transform(c, e) - add(result, newAsgnStmt(c, c.transCon.forStmt.sons[0], x)) + if c.transCon.forStmt[0].kind == nkVarTuple: + 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 - add(result, c.transCon.forLoopBody) + result.add(c.transCon.forLoopBody) else: # we need to introduce new local variables: - add(result, introduceNewLocalVars(c, c.transCon.forLoopBody.PNode)) + c.isIntroducingNewLocalVars = true # don't transform yields when introducing new local vars + result.add(introduceNewLocalVars(c, c.transCon.forLoopBody)) + c.isIntroducingNewLocalVars = false -proc transformAddrDeref(c: PTransf, n: PNode, a, b: TNodeKind): PTransNode = +proc transformAddrDeref(c: PTransf, n: PNode, kinds: TNodeKinds): PNode = result = transformSons(c, n) - if c.graph.config.cmd == cmdCompileToCpp or sfCompileToCpp in c.module.flags: return - var n = result.PNode - case n.sons[0].kind + # 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.sons[0].sons[0] - if m.kind == a or m.kind == b: + var m = n[0][0] + if m.kind in kinds: # addr ( nkConv ( deref ( x ) ) ) --> nkConv(x) - n.sons[0].sons[0] = m.sons[0] - result = PTransNode(n.sons[0]) + n[0][0] = m[0] + result = n[0] if n.typ.skipTypes(abstractVar).kind != tyOpenArray: - PNode(result).typ = n.typ + result.typ = n.typ + elif n.typ.skipTypes(abstractInst).kind in {tyVar}: + result.typ = toVar(result.typ, n.typ.skipTypes(abstractInst).kind, c.idgen) of nkHiddenStdConv, nkHiddenSubConv, nkConv: - var m = n.sons[0].sons[1] - if m.kind == a or m.kind == b: + var m = n[0][1] + if m.kind in kinds: # addr ( nkConv ( deref ( x ) ) ) --> nkConv(x) - n.sons[0].sons[1] = m.sons[0] - result = PTransNode(n.sons[0]) + n[0][1] = m[0] + result = n[0] if n.typ.skipTypes(abstractVar).kind != tyOpenArray: - PNode(result).typ = n.typ + result.typ = n.typ + elif n.typ.skipTypes(abstractInst).kind in {tyVar}: + result.typ = toVar(result.typ, n.typ.skipTypes(abstractInst).kind, c.idgen) else: - if n.sons[0].kind == a or n.sons[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 = PTransNode(n.sons[0].sons[0]) + result = n[0][0] if n.typ.skipTypes(abstractVar).kind != tyOpenArray: - PNode(result).typ = n.typ + result.typ = n.typ proc generateThunk(c: PTransf; prc: PNode, dest: PType): PNode = ## Converts 'prc' into '(thunk, nil)' so that it's compatible with @@ -390,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.cmd == cmdCompileToJS: 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)) @@ -400,18 +538,18 @@ proc generateThunk(c: PTransf; prc: PNode, dest: PType): PNode = result.add(conv) result.add(newNodeIT(nkNilLit, prc.info, getSysType(c.graph, prc.info, tyNil))) -proc transformConv(c: PTransf, n: PNode): PTransNode = +proc transformConv(c: PTransf, n: PNode): PNode = # numeric types need range checks: var dest = skipTypes(n.typ, abstractVarRange) - var source = skipTypes(n.sons[1].typ, abstractVarRange) + var source = skipTypes(n[1].typ, abstractVarRange) case dest.kind - of tyInt..tyInt64, tyEnum, tyChar, tyBool, tyUInt8..tyUInt32: + of tyInt..tyInt64, tyEnum, tyChar, tyUInt8..tyUInt32: # we don't include uint and uint64 here as these are no ordinal types ;-) if not isOrdinalType(source): # float -> int conversions. ugh. result = transformSons(c, n) - elif firstOrd(c.graph.config, n.typ) <= firstOrd(c.graph.config, n.sons[1].typ) and - lastOrd(c.graph.config, n.sons[1].typ) <= lastOrd(c.graph.config, n.typ): + elif firstOrd(c.graph.config, n.typ) <= firstOrd(c.graph.config, n[1].typ) and + lastOrd(c.graph.config, n[1].typ) <= lastOrd(c.graph.config, n.typ): # BUGFIX: simply leave n as it is; we need a nkConv node, # but no range check: result = transformSons(c, n) @@ -422,34 +560,38 @@ proc transformConv(c: PTransf, n: PNode): PTransNode = else: result = newTransNode(nkChckRange, n, 3) dest = skipTypes(n.typ, abstractVar) - result[0] = transform(c, n.sons[1]) - result[1] = newIntTypeNode(nkIntLit, firstOrd(c.graph.config, dest), dest).PTransNode - result[2] = newIntTypeNode(nkIntLit, lastOrd(c.graph.config, dest), dest).PTransNode + result[0] = transform(c, n[1]) + result[1] = newIntTypeNode(firstOrd(c.graph.config, dest), dest) + result[2] = newIntTypeNode(lastOrd(c.graph.config, dest), dest) of tyFloat..tyFloat128: # XXX int64 -> float conversion? if skipTypes(n.typ, abstractVar).kind == tyRange: result = newTransNode(nkChckRangeF, n, 3) dest = skipTypes(n.typ, abstractVar) - result[0] = transform(c, n.sons[1]) - result[1] = copyTree(dest.n.sons[0]).PTransNode - result[2] = copyTree(dest.n.sons[1]).PTransNode + result[0] = transform(c, n[1]) + result[1] = copyTree(dest.n[0]) + result[2] = copyTree(dest.n[1]) else: result = transformSons(c, n) of tyOpenArray, tyVarargs: - result = transform(c, n.sons[1]) - PNode(result).typ = takeType(n.typ, n.sons[1].typ) - #echo n.info, " came here and produced ", typeToString(PNode(result).typ), - # " from ", typeToString(n.typ), " and ", typeToString(n.sons[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.sons[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.sons[1]) + result[0] = transform(c, n[1]) else: result = transformSons(c, n) of tyRef, tyPtr: @@ -459,91 +601,142 @@ proc transformConv(c: PTransf, n: PNode): PTransNode = var diff = inheritanceDiff(dest, source) if diff < 0: result = newTransNode(nkObjUpConv, n, 1) - result[0] = transform(c, n.sons[1]) + result[0] = transform(c, n[1]) elif diff > 0 and diff != high(int): result = newTransNode(nkObjDownConv, n, 1) - result[0] = transform(c, n.sons[1]) + result[0] = transform(c, n[1]) else: - result = transform(c, n.sons[1]) + result = transform(c, n[1]) + result.typ = n.typ else: result = transformSons(c, n) of tyObject: var diff = inheritanceDiff(dest, source) if diff < 0: result = newTransNode(nkObjUpConv, n, 1) - result[0] = transform(c, n.sons[1]) + result[0] = transform(c, n[1]) elif diff > 0 and diff != high(int): result = newTransNode(nkObjDownConv, n, 1) - result[0] = transform(c, n.sons[1]) + result[0] = transform(c, n[1]) else: - result = transform(c, n.sons[1]) + result = transform(c, n[1]) + result.typ = n.typ of tyGenericParam, tyOrdinal: - result = transform(c, n.sons[1]) + result = transform(c, n[1]) # happens sometimes for generated assignments, etc. of tyProc: result = transformSons(c, n) - if dest.callConv == ccClosure and source.callConv == ccDefault: - result = generateThunk(c, result[1].PNode, dest).PTransNode + if dest.callConv == ccClosure and source.callConv == ccNimCall: + result = generateThunk(c, result[1], dest) else: result = transformSons(c, n) type TPutArgInto = enum - paDirectMapping, paFastAsgn, paVarAsgn, paComplexOpenarray + paDirectMapping, paFastAsgn, paFastAsgnTakeTypeFromArg + paVarAsgn, paComplexOpenarray, paViaIndirection proc putArgInto(arg: PNode, formal: PType): TPutArgInto = # This analyses how to treat the mapping "formal <-> arg" in an # inline context. + if formal.kind == tyTypeDesc: return paDirectMapping if skipTypes(formal, abstractInst).kind in {tyOpenArray, tyVarargs}: - if arg.kind == nkStmtListExpr: + case arg.kind + of nkStmtListExpr: return paComplexOpenarray - return paDirectMapping # XXX really correct? - # what if ``arg`` has side-effects? + of nkBracket: + return paFastAsgnTakeTypeFromArg + else: + # XXX incorrect, causes #13417 when `arg` has side effects. + return paDirectMapping case arg.kind of nkEmpty..nkNilLit: result = paDirectMapping - of nkPar, nkTupleConstr, nkCurly, nkBracket: - result = paFastAsgn - for i in countup(0, sonsLen(arg) - 1): - if putArgInto(arg.sons[i], formal) != paDirectMapping: return + 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: + return paFastAsgn + result = paDirectMapping + of nkPar, nkTupleConstr, nkObjConstr: + for i in 0..<arg.len: + let a = if arg[i].kind == nkExprColonExpr: arg[i][1] + else: arg[0] + 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 proc findWrongOwners(c: PTransf, n: PNode) = if n.kind == nkVarSection: - let x = n.sons[0].sons[0] + let x = n[0][0] if x.kind == nkSym and x.sym.owner != getCurrOwner(c): internalError(c.graph.config, x.info, "bah " & x.sym.name.s & " " & x.sym.owner.name.s & " " & getCurrOwner(c).name.s) else: - for i in 0 ..< safeLen(n): findWrongOwners(c, n.sons[i]) + for i in 0..<n.safeLen: findWrongOwners(c, n[i]) + +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 + of nkYieldStmt: + if n[0].kind == nkSym and n[0].sym.owner == owner: + discard "good: yield a single variable that we own" + else: + inc dangerousYields + 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) -proc transformFor(c: PTransf, n: PNode): PTransNode = +proc transformFor(c: PTransf, n: PNode): PNode = # generate access statements for the parameters (unless they are constant) # put mapping from formal parameters to actual parameters if n.kind != nkForStmt: internalError(c.graph.config, n.info, "transformFor") - var length = sonsLen(n) - var call = n.sons[length - 2] + var call = n[^2] let labl = newLabel(c, n) result = newTransNode(nkBlockStmt, n.info, 2) - result[0] = newSymNode(labl).PTransNode + result[0] = newSymNode(labl) if call.typ.isNil: # see bug #3051 - result[1] = newNode(nkEmpty).PTransNode + result[1] = newNode(nkEmpty) return result c.breakSyms.add(labl) - if call.kind notin nkCallKinds or call.sons[0].kind != nkSym or - call.sons[0].typ.callConv == ccClosure: - n.sons[length-1] = transformLoopBody(c, n.sons[length-1]).PNode - if not c.tooEarly: - n.sons[length-2] = transform(c, n.sons[length-2]).PNode - result[1] = lambdalifting.liftForLoop(c.graph, n, getCurrOwner(c)).PTransNode - else: - result[1] = newNode(nkEmpty).PTransNode + if call.kind notin nkCallKinds or call[0].kind != nkSym or + call[0].typ.skipTypes(abstractInst).callConv == ccClosure: + result[1] = n + result[1][^1] = transformLoopBody(c, n[^1]) + result[1][^2] = transform(c, n[^2]) + result[1] = lambdalifting.liftForLoop(c.graph, result[1], c.idgen, getCurrOwner(c)) discard c.breakSyms.pop return result @@ -551,18 +744,26 @@ proc transformFor(c: PTransf, n: PNode): PTransNode = var stmtList = newTransNode(nkStmtList, n.info, 0) result[1] = stmtList - var loopBody = transformLoopBody(c, n.sons[length-1]) + var loopBody = transformLoopBody(c, n[^1]) discard c.breakSyms.pop + let iter = call[0].sym + var v = newNodeI(nkVarSection, n.info) - for i in countup(0, length - 3): - addVar(v, copyTree(n.sons[i])) # declare new vars - add(stmtList, v.PTransNode) + for i in 0..<n.len - 2: + if n[i].kind == nkVarTuple: + 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, call, n[i].sym.owner): + incl n[i].sym.flags, sfCursor + addVar(v, copyTree(n[i])) # declare new vars + stmtList.add(v) + # Bugfix: inlined locals belong to the invoking routine, not to the invoked # iterator! - let iter = call.sons[0].sym var newC = newTransCon(getCurrOwner(c)) newC.forStmt = n newC.forLoopBody = loopBody @@ -570,217 +771,246 @@ proc transformFor(c: PTransf, n: PNode): PTransNode = if iter.kind != skIterator: return result # generate access statements for the parameters (unless they are constant) pushTransCon(c, newC) - for i in countup(1, sonsLen(call) - 1): - var arg = transform(c, call.sons[i]).PNode + for i in 1..<call.len: + var arg = transform(c, call[i]) let ff = skipTypes(iter.typ, abstractInst) # can happen for 'nim check': if i >= ff.n.len: return result - var formal = ff.n.sons[i].sym - case putArgInto(arg, formal.typ) + var formal = ff.n[i].sym + let pa = putArgInto(arg, formal.typ) + case pa of paDirectMapping: - idNodeTablePut(newC.mapping, formal, arg) - of paFastAsgn: + newC.mapping[formal.itemId] = arg + of paFastAsgn, paFastAsgnTakeTypeFromArg: + var t = formal.typ + if pa == paFastAsgnTakeTypeFromArg: + t = arg.typ + elif formal.ast != nil and formal.ast.typ.destructor != nil and t.destructor == nil: + t = formal.ast.typ # better use the type that actually has a destructor. + elif t.destructor == nil and arg.typ.destructor != nil: + t = arg.typ # generate a temporary and produce an assignment statement: - var temp = newTemp(c, formal.typ, formal.info) + var temp = newTemp(c, t, formal.info) + #incl(temp.sym.flags, sfCursor) addVar(v, temp) - add(stmtList, newAsgnStmt(c, temp, arg.PTransNode)) - 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 == 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: - let typ = newType(tySequence, formal.owner) - addSonSkipIntLit(typ, formal.typ.sons[0]) - var temp = newTemp(c, typ, formal.info) + # arrays will deep copy here (pretty bad). + var temp = newTemp(c, arg.typ, formal.info) addVar(v, temp) - add(stmtList, newAsgnStmt(c, temp, arg.PTransNode)) - idNodeTablePut(newC.mapping, formal, temp) + stmtList.add(newAsgnStmt(c, nkFastAsgn, temp, arg, true)) + newC.mapping[formal.itemId] = temp - var body = iter.getBody.copyTree + let body = transformBody(c.graph, c.idgen, iter, {useCache}+c.flags) pushInfoContext(c.graph.config, n.info) - # XXX optimize this somehow. But the check "c.inlining" is not correct: - var symMap: TIdTable - initIdTable symMap - freshLabels(c, body, symMap) - inc(c.inlining) - add(stmtList, transform(c, body)) - #findWrongOwners(c, stmtList.pnode) + stmtList.add(transform(c, body)) + #findWrongOwners(c, stmtList.PNode) dec(c.inlining) popInfoContext(c.graph.config) popTransCon(c) - # echo "transformed: ", stmtList.PNode.renderTree + # echo "transformed: ", stmtList.renderTree -proc transformCase(c: PTransf, n: PNode): PTransNode = +proc transformCase(c: PTransf, n: PNode): PNode = # removes `elif` branches of a case stmt # adds ``else: nil`` if needed for the code generator result = newTransNode(nkCaseStmt, n, 0) - var ifs = PTransNode(nil) - for i in 0 .. sonsLen(n)-1: - var it = n.sons[i] + var ifs: PNode = nil + for it in n: var e = transform(c, it) case it.kind of nkElifBranch: - if ifs.PNode == nil: - ifs = newTransNode(nkIfStmt, it.info, 0) + if ifs == nil: + # Generate the right node depending on whether `n` is used as a stmt or + # as an expr + let kind = if n.typ != nil: nkIfExpr else: nkIfStmt + ifs = newTransNode(kind, it.info, 0) + ifs.typ = n.typ ifs.add(e) of nkElse: - if ifs.PNode == nil: result.add(e) + if ifs == nil: result.add(e) else: ifs.add(e) else: result.add(e) - if ifs.PNode != nil: + if ifs != nil: var elseBranch = newTransNode(nkElse, n.info, 1) elseBranch[0] = ifs result.add(elseBranch) - elif result.PNode.lastSon.kind != nkElse and not ( - skipTypes(n.sons[0].typ, abstractVarRange).kind in - {tyInt..tyInt64, tyChar, tyEnum, tyUInt..tyUInt32}): + elif result.lastSon.kind != nkElse and not ( + skipTypes(n[0].typ, abstractVarRange).kind in + {tyInt..tyInt64, tyChar, tyEnum, tyUInt..tyUInt64}): # fix a stupid code gen bug by normalizing: var elseBranch = newTransNode(nkElse, n.info, 1) elseBranch[0] = newTransNode(nkNilLit, n.info, 0) - add(result, elseBranch) + result.add(elseBranch) -proc transformArrayAccess(c: PTransf, n: PNode): PTransNode = +proc transformArrayAccess(c: PTransf, n: PNode): PNode = # XXX this is really bad; transf should use a proper AST visitor - if n.sons[0].kind == nkSym and n.sons[0].sym.kind == skType: - result = n.PTransNode + if n[0].kind == nkSym and n[0].sym.kind == skType: + result = n else: result = newTransNode(n) - for i in 0 ..< n.len: - result[i] = transform(c, skipConv(n.sons[i])) + for i in 0..<n.len: + result[i] = transform(c, skipConv(n[i])) proc getMergeOp(n: PNode): PSym = case n.kind of nkCall, nkHiddenCallConv, nkCommand, nkInfix, nkPrefix, nkPostfix, nkCallStrLit: - if n.sons[0].kind == nkSym and n.sons[0].sym.magic == mConStrStr: - result = n.sons[0].sym - else: discard + if n[0].kind == nkSym and n[0].sym.magic == mConStrStr: + result = n[0].sym + 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): - for i in countup(1, sonsLen(a)-1): flattenTreeAux(d, a.sons[i], op) + for i in 1..<a.len: flattenTreeAux(d, a[i], op) else: - addSon(d, copyTree(a)) + d.add copyTree(a) proc flattenTree(root: PNode): PNode = let op = getMergeOp(root) if op != nil: result = copyNode(root) - addSon(result, copyTree(root.sons[0])) + result.add copyTree(root[0]) flattenTreeAux(result, root, op) else: result = root -proc transformCall(c: PTransf, n: PNode): PTransNode = +proc transformCall(c: PTransf, n: PNode): PNode = var n = flattenTree(n) let op = getMergeOp(n) let magic = getMagic(n) if op != nil and op.magic != mNone and n.len >= 3: result = newTransNode(nkCall, n, 0) - add(result, transform(c, n.sons[0])) + result.add(transform(c, n[0])) var j = 1 - while j < sonsLen(n): - var a = transform(c, n.sons[j]).PNode + while j < n.len: + var a = transform(c, n[j]) inc(j) if isConstExpr(a): - while (j < sonsLen(n)): - let b = transform(c, n.sons[j]).PNode + while (j < n.len): + let b = transform(c, n[j]) if not isConstExpr(b): break - a = evalOp(op.magic, n, a, b, nil, c.graph) + a = evalOp(op.magic, n, a, b, nil, c.idgen, c.graph) inc(j) - add(result, a.PTransNode) - if len(result) == 2: result = result[1] + result.add(a) + if result.len == 2: result = result[1] elif magic in {mNBindSym, mTypeOf, mRunnableExamples}: # for bindSym(myconst) we MUST NOT perform constant folding: - result = n.PTransNode + result = n elif magic == mProcCall: # but do not change to its dispatcher: result = transformSons(c, n[1]) + elif magic == mStrToStr: + result = transform(c, n[1]) else: - let s = transformSons(c, n).PNode + let s = transformSons(c, n) # bugfix: check after 'transformSons' if it's still a method call: # use the dispatcher for the call: - if s.sons[0].kind == nkSym and s.sons[0].sym.kind == skMethod: + if s[0].kind == nkSym and s[0].sym.kind == skMethod: when false: - let t = lastSon(s.sons[0].sym.ast) + let t = lastSon(s[0].sym.ast) if t.kind != nkSym or sfDispatcher notin t.sym.flags: - methodDef(s.sons[0].sym, false) - result = methodCall(s, c.graph.config).PTransNode + methodDef(s[0].sym, false) + result = methodCall(s, c.graph.config) else: - result = s.PTransNode + result = s -proc transformExceptBranch(c: PTransf, n: PNode): PTransNode = - result = transformSons(c, n) +proc transformExceptBranch(c: PTransf, n: PNode): PNode = if n[0].isInfixAs() and not isImportedException(n[0][1].typ, c.graph.config): let excTypeNode = n[0][1] let actions = newTransNode(nkStmtListExpr, n[1], 2) # Generating `let exc = (excType)(getCurrentException())` # -> getCurrentException() - let excCall = PTransNode(callCodegenProc(c.graph, "getCurrentException", newNodeI(nkEmpty, n.info))) + let excCall = callCodegenProc(c.graph, "getCurrentException") # -> (excType) let convNode = newTransNode(nkHiddenSubConv, n[1].info, 2) - convNode[0] = PTransNode(newNodeI(nkEmpty, n.info)) + convNode[0] = newNodeI(nkEmpty, n.info) convNode[1] = excCall - PNode(convNode).typ = excTypeNode.typ.toRef() + convNode.typ = excTypeNode.typ.toRef(c.idgen) # -> let exc = ... let identDefs = newTransNode(nkIdentDefs, n[1].info, 3) - identDefs[0] = PTransNode(n[0][2]) - identDefs[1] = PTransNode(newNodeI(nkEmpty, n.info)) + identDefs[0] = n[0][2] + identDefs[1] = newNodeI(nkEmpty, n.info) identDefs[2] = convNode let letSection = newTransNode(nkLetSection, n[1].info, 1) letSection[0] = identDefs # Place the let statement and body of the 'except' branch into new stmtList. actions[0] = letSection - actions[1] = transformSons(c, n[1]) + actions[1] = transform(c, n[1]) # Overwrite 'except' branch body with our stmtList. - result[1] = actions - + result = newTransNode(nkExceptBranch, n[1].info, 2) # Replace the `Exception as foobar` with just `Exception`. - result[0] = result[0][1] - -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 == nkSym and cnst.kind in {nkCurly, nkPar, nkTupleConstr, nkBracket} and - cnst.len != 0 + result[0] = transform(c, n[0][1]) + result[1] = actions + else: + result = transformSons(c, n) -proc commonOptimizations*(g: ModuleGraph; c: PSym, n: PNode): PNode = +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.sons[i] = commonOptimizations(g, c, n.sons[i]) + for i in 0..<n.safeLen: + result[i] = commonOptimizations(g, idgen, c, n[i]) var op = getMergeOp(n) - if (op != nil) and (op.magic != mNone) and (sonsLen(n) >= 3): + if (op != nil) and (op.magic != mNone) and (n.len >= 3): result = newNodeIT(nkCall, n.info, n.typ) - add(result, n.sons[0]) + result.add(n[0]) var args = newNode(nkArgList) flattenTreeAux(args, n, op) var j = 0 - while j < sonsLen(args): - var a = args.sons[j] + while j < args.len: + var a = args[j] inc(j) if isConstExpr(a): - while j < sonsLen(args): - let b = args.sons[j] + while j < args.len: + let b = args[j] if not isConstExpr(b): break - a = evalOp(op.magic, result, a, b, nil, g) + a = evalOp(op.magic, result, a, b, nil, idgen, g) inc(j) - add(result, a) - if len(result) == 2: result = result[1] + result.add(a) + if result.len == 2: result = result[1] else: - var cnst = getConstExpr(c, n, g) + var cnst = getConstExpr(c, n, idgen, g) # we inline constants if they are not complex constants: if cnst != nil and not dontInlineConstant(n, cnst): result = cnst else: result = n -proc transform(c: PTransf, n: PNode): PTransNode = +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 if n.kind in {nkElifBranch, nkOfBranch, nkExceptBranch, nkElifExpr, @@ -788,31 +1018,29 @@ proc transform(c: PTransf, n: PNode): PTransNode = nkBlockStmt, nkBlockExpr}: oldDeferAnchor = c.deferAnchor c.deferAnchor = n - if n.typ != nil and tfHasAsgn in n.typ.flags: - c.needsDestroyPass = true case n.kind of nkSym: result = transformSym(c, n) of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit, nkComesFrom: # nothing to be done for leaves: - result = PTransNode(n) + result = n of nkBracketExpr: result = transformArrayAccess(c, n) of procDefs: - var s = n.sons[namePos].sym + var s = n[namePos].sym if n.typ != nil and s.typ.callConv == ccClosure: - result = transformSym(c, n.sons[namePos]) + result = transformSym(c, n[namePos]) # use the same node as before if still a symbol: - if result.PNode.kind == nkSym: result = PTransNode(n) + if result.kind == nkSym: result = n else: - result = PTransNode(n) + result = n of nkMacroDef: # XXX no proper closure support yet: when false: - if n.sons[genericParamsPos].kind == nkEmpty: - var s = n.sons[namePos].sym - n.sons[bodyPos] = PNode(transform(c, s.getBody)) + if n[genericParamsPos].kind == nkEmpty: + var s = n[namePos].sym + n[bodyPos] = transform(c, s.getBody) if n.kind == nkMethodDef: methodDef(s, false) - result = PTransNode(n) + result = n of nkForStmt: result = transformFor(c, n) of nkParForStmt: @@ -827,50 +1055,62 @@ proc transform(c: PTransf, n: PNode): PTransNode = result = transformSons(c, n) when false: let deferPart = newNodeI(nkFinally, n.info) - deferPart.add n.sons[0] + deferPart.add n[0] let tryStmt = newNodeI(nkTryStmt, n.info) if c.deferAnchor.isNil: tryStmt.add c.root c.root = tryStmt - result = PTransNode(tryStmt) + result = tryStmt else: # modify the corresponding *action*, don't rely on nkStmtList: - let L = c.deferAnchor.len-1 - tryStmt.add c.deferAnchor.sons[L] - c.deferAnchor.sons[L] = tryStmt + tryStmt.add c.deferAnchor[^1] + c.deferAnchor[^1] = tryStmt result = newTransNode(nkCommentStmt, n.info, 0) - tryStmt.addSon(deferPart) + tryStmt.add deferPart # disable the original 'defer' statement: n.kind = nkEmpty of nkContinueStmt: - result = PTransNode(newNodeI(nkBreakStmt, n.info)) + result = newNodeI(nkBreakStmt, n.info) var labl = c.contSyms[c.contSyms.high] - add(result, PTransNode(newSymNode(labl))) + result.add(newSymNode(labl)) 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: - result = PTransNode(n) - if n.sons[0].kind != nkEmpty: + result = n + if n[0].kind != nkEmpty: result = transformSons(c, n) - if isConstExpr(PNode(result).sons[0]): + if isConstExpr(result[0]): # ensure that e.g. discard "some comment" gets optimized away # completely: - result = PTransNode(newNode(nkCommentStmt)) - of nkCommentStmt, nkTemplateDef, nkImportStmt, nkStaticStmt: - return n.PTransNode + result = newNode(nkCommentStmt) + of nkCommentStmt, nkTemplateDef, nkImportStmt, nkStaticStmt, + nkExportStmt, nkExportExceptStmt: + return n of nkConstSection: # do not replace ``const c = 3`` with ``const 3 = 3`` return transformConstSection(c, n) - of nkTypeSection, nkTypeOfExpr: + of nkTypeSection, nkTypeOfExpr, nkMixinStmt, nkBindStmt: # no need to transform type sections: - return PTransNode(n) + return n of nkVarSection, nkLetSection: if c.inlining > 0: # we need to copy the variables for multiple yield statements: @@ -878,39 +1118,55 @@ proc transform(c: PTransf, n: PNode): PTransNode = 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: - when true: - result = transformSons(c, n) - else: - result = n.PTransNode - let L = n.len-1 - result[L] = transform(c, n.sons[L]) + 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 + 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): - PNode(result).comment = n.comment + result.comment = n.comment of nkClosure: # it can happen that for-loop-inlining produced a fresh # set of variables, including some computed environment # (bug #2604). We need to patch this environment here too: let a = n[1] if a.kind == nkSym: - n.sons[1] = transformSymAux(c, a) - return PTransNode(n) + result = copyTree(n) + result[1] = transformSymAux(c, a) + else: + result = n of nkExceptBranch: result = transformExceptBranch(c, n) + of nkCheckedFieldExpr: + result = transformSons(c, n) + if result[0].kind != nkDotExpr: + # simplfied beyond a dot expression --> simplify further. + result = result[0] else: result = transformSons(c, n) when false: if oldDeferAnchor != nil: c.deferAnchor = oldDeferAnchor - var cnst = getConstExpr(c.module, PNode(result), c.graph) - # we inline constants if they are not complex constants: - if cnst != nil and not dontInlineConstant(n, cnst): - result = PTransNode(cnst) # do not miss an optimization + # Constants can be inlined here, but only if they cannot result in a cast + # in the back-end (e.g. var p: pointer = someProc) + let exprIsPointerCast = n.kind in {nkCast, nkConv, nkHiddenStdConv} and + n.typ != nil and + n.typ.kind == tyPointer + 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): + result = cnst # do not miss an optimization proc processTransf(c: PTransf, n: PNode, owner: PSym): PNode = # Note: For interactive mode we cannot call 'passes.skipCodegen' and skip @@ -918,16 +1174,12 @@ proc processTransf(c: PTransf, n: PNode, owner: PSym): PNode = # nodes into an empty node. if nfTransf in n.flags: return n pushTransCon(c, newTransCon(owner)) - result = PNode(transform(c, n)) + result = transform(c, n) popTransCon(c) incl(result.flags, nfTransf) -proc openTransf(g: ModuleGraph; module: PSym, filename: string): PTransf = - new(result) - result.contSyms = @[] - result.breakSyms = @[] - result.module = module - result.graph = g +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 @@ -949,71 +1201,75 @@ proc liftDeferAux(n: PNode) = goOn = false let last = n.len-1 for i in 0..last: - if n.sons[i].kind == nkDefer: - let deferPart = newNodeI(nkFinally, n.sons[i].info) - deferPart.add n.sons[i].sons[0] - var tryStmt = newNodeI(nkTryStmt, n.sons[i].info) - var body = newNodeI(n.kind, n.sons[i].info) + if n[i].kind == nkDefer: + let deferPart = newNodeI(nkFinally, n[i].info) + deferPart.add n[i][0] + var tryStmt = newNodeIT(nkTryStmt, n[i].info, n.typ) + var body = newNodeIT(n.kind, n[i].info, n.typ) if i < last: body.sons = n.sons[(i+1)..last] - tryStmt.addSon(body) - tryStmt.addSon(deferPart) - n.sons[i] = tryStmt + tryStmt.add body + tryStmt.add deferPart + n[i] = tryStmt n.sons.setLen(i+1) - n.typ = n.sons[i].typ + n.typ = tryStmt.typ goOn = true break for i in 0..n.safeLen-1: - liftDeferAux(n.sons[i]) + liftDeferAux(n[i]) template liftDefer(c, root) = if c.deferDetected: liftDeferAux(root) -proc transformBody*(g: ModuleGraph; module: PSym, n: PNode, prc: PSym): PNode = - if nfTransf in n.flags or prc.kind in {skTemplate}: - result = n +proc transformBody*(g: ModuleGraph; idgen: IdGenerator; prc: PSym; flags: TransformFlags): PNode = + assert prc.kind in routineKinds + + if prc.transformedBody != nil: + result = prc.transformedBody + elif nfTransf in getBody(g, prc).flags or prc.kind in {skTemplate}: + result = getBody(g, prc) else: - var c = openTransf(g, module, "") - result = liftLambdas(g, prc, n, c.tooEarly) - #result = n + prc.transformedBody = newNode(nkEmpty) # protects from recursion + 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 = liftLambdas(prc, result) - when useEffectSystem: trackProc(g, prc, result) - result = liftLocalsIfRequested(prc, result, g.cache, g.config) - if c.needsDestroyPass: #and newDestructors: - result = injectDestructorCalls(g, prc, result) + result = liftLocalsIfRequested(prc, result, g.cache, g.config, c.idgen) if prc.isIterator: - result = g.transformClosureIterator(prc, result) + result = g.transformClosureIterator(c.idgen, prc, result) incl(result.flags, nfTransf) - #if prc.name.s == "testbody": - # echo renderTree(result) -proc transformStmt*(g: ModuleGraph; module: PSym, n: PNode): PNode = + 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 + else: + prc.transformedBody = nil + # XXX Rodfile support for transformedBody! + + #if prc.name.s == "main": + # echo "transformed into ", renderTree(result, {renderIds}) + +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, "") + var c = openTransf(g, module, "", idgen, flags) result = processTransf(c, n, module) liftDefer(c, result) #result = liftLambdasForTopLevel(module, result) - when useEffectSystem: trackTopLevelStmt(g, module, result) - #if n.info ?? "temp.nim": - # echo renderTree(result, {renderIds}) - if c.needsDestroyPass: - result = injectDestructorCalls(g, module, result) incl(result.flags, nfTransf) -proc transformExpr*(g: ModuleGraph; 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, "") + var c = openTransf(g, module, "", idgen, flags) result = processTransf(c, n, module) liftDefer(c, result) - if c.needsDestroyPass: - result = injectDestructorCalls(g, module, result) + # expressions are not to be injected with destructor calls as that + # the list of top level statements needs to be collected before. incl(result.flags, nfTransf) diff --git a/compiler/trees.nim b/compiler/trees.nim index fb523de9d..41b54eb09 100644 --- a/compiler/trees.nim +++ b/compiler/trees.nim @@ -10,9 +10,10 @@ # tree helper routines import - ast, astalgo, lexer, msgs, strutils, wordrecg, idents + 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 @@ -26,6 +27,10 @@ proc cyclicTree*(n: PNode): bool = var visited: seq[PNode] = @[] cyclicTreeAux(n, visited) +proc sameFloatIgnoreNan(a, b: BiggestFloat): bool {.inline.} = + ## ignores NaN semantics, but ensures 0.0 == -0.0, see #13730 + cast[uint64](a) == cast[uint64](b) or a == b + proc exprStructuralEquivalent*(a, b: PNode; strictSymEquality=false): bool = if a == b: result = true @@ -39,18 +44,23 @@ proc exprStructuralEquivalent*(a, b: PNode; strictSymEquality=false): bool = result = a.sym.name.id == b.sym.name.id of nkIdent: result = a.ident.id == b.ident.id of nkCharLit..nkUInt64Lit: result = a.intVal == b.intVal - of nkFloatLit..nkFloat64Lit: result = a.floatVal == b.floatVal + of nkFloatLit..nkFloat64Lit: result = sameFloatIgnoreNan(a.floatVal, b.floatVal) of nkStrLit..nkTripleStrLit: result = a.strVal == b.strVal of nkCommentStmt: result = a.comment == b.comment of nkEmpty, nkNilLit, nkType: result = true else: - if sonsLen(a) == sonsLen(b): - for i in countup(0, sonsLen(a) - 1): - if not exprStructuralEquivalent(a.sons[i], b.sons[i], + if a.len == b.len: + for i in 0..<a.len: + 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: @@ -64,20 +74,21 @@ proc sameTree*(a, b: PNode): bool = result = a.sym.name.id == b.sym.name.id of nkIdent: result = a.ident.id == b.ident.id of nkCharLit..nkUInt64Lit: result = a.intVal == b.intVal - of nkFloatLit..nkFloat64Lit: result = a.floatVal == b.floatVal + of nkFloatLit..nkFloat64Lit: result = sameFloatIgnoreNan(a.floatVal, b.floatVal) of nkStrLit..nkTripleStrLit: result = a.strVal == b.strVal of nkEmpty, nkNilLit, nkType: result = true else: - if sonsLen(a) == sonsLen(b): - for i in countup(0, sonsLen(a) - 1): - if not sameTree(a.sons[i], b.sons[i]): return + if a.len == b.len: + for i in 0..<a.len: + if not sameTree(a[i], b[i]): return result = true proc getMagic*(op: PNode): TMagic = + if op == nil: return mNone case op.kind of nkCallKinds: - case op.sons[0].kind - of nkSym: result = op.sons[0].sym.magic + case op[0].kind + of nkSym: result = op[0].sym.magic else: result = mNone else: result = mNone @@ -86,27 +97,34 @@ 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..<safeLen(n): + for i in 0..<n.safeLen: if n[i].isCaseObj: return true -proc isDeepConstExpr*(n: PNode): bool = +proc isDeepConstExpr*(n: PNode; preventInheritance = false): bool = case n.kind - of nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, - nkFloatLit..nkFloat64Lit, nkNilLit: + of nkCharLit..nkNilLit: result = true of nkExprEqExpr, nkExprColonExpr, nkHiddenStdConv, nkHiddenSubConv: - result = isDeepConstExpr(n.sons[1]) + result = isDeepConstExpr(n[1], preventInheritance) of nkCurly, nkBracket, nkPar, nkTupleConstr, nkObjConstr, nkClosure, nkRange: - for i in ord(n.kind == nkObjConstr) ..< n.len: - if not isDeepConstExpr(n.sons[i]): return false + for i in ord(n.kind == nkObjConstr)..<n.len: + if not isDeepConstExpr(n[i], preventInheritance): return false if n.typ.isNil: result = true else: - let t = n.typ.skipTypes({tyGenericInst, tyDistinct, tyAlias, tySink}) - if t.kind in {tyRef, tyPtr}: return false - if t.kind != tyObject or not isCaseObj(t.n): + 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.baseClass != nil: + result = false + elif isCaseObj(t.n): + result = false + else: + result = true + else: result = true - else: discard + else: result = false proc isRange*(n: PNode): bool {.inline.} = if n.kind in nkCallKinds: @@ -116,10 +134,53 @@ 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.sons[0] else: n - if key.kind == nkIdent: result = whichKeyword(key.ident) + 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: return wCast + of nkClosedSymChoice, nkOpenSymChoice: + return whichPragma(key[0]) + else: return wInvalid + if result in nonPragmaWordsLow..nonPragmaWordsHigh: + result = wInvalid + +proc isNoSideEffectPragma*(n: PNode): bool = + var k = whichPragma(n) + if k == wCast: + k = whichPragma(n[1]) + 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: + result = it[1] + if result.kind notin {nkCurly, nkBracket}: + result = newNodeI(nkCurly, result.info) + result.add(it[1]) + 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: + return it[1] proc unnestStmts(n, result: PNode) = if n.kind == nkStmtList: @@ -131,8 +192,47 @@ proc flattenStmts*(n: PNode): PNode = result = newNodeI(nkStmtList, n.info) unnestStmts(n, result) if result.len == 1: - result = result.sons[0] + result = result[0] 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.sons[i] = n.sons[i+a] + for i in 0..b-a: result[i] = n[i+a] + +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 + ## determined as the owner; ``obj`` in the example. + case n.kind + 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]) + of nkHiddenStdConv, nkHiddenSubConv, nkConv: + result = getRoot(n[1]) + of nkCallKinds: + if getMagic(n) == mSlice: result = getRoot(n[1]) + else: result = nil + else: result = nil + +proc stupidStmtListExpr*(n: PNode): bool = + for i in 0..<n.len-1: + if n[i].kind notin {nkEmpty, nkCommentStmt}: return false + result = true + +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 = 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 e6eb8c666..6685c4a89 100644 --- a/compiler/treetab.nim +++ b/compiler/treetab.nim @@ -9,11 +9,16 @@ # Implements a table from trees to trees. Does structural equivalence checking. -import - hashes, ast, astalgo, types +import ast, astalgo, types -proc hashTree(n: PNode): Hash = - if n == nil: return +import std/hashes + +when defined(nimPreviewSlimSystem): + import std/assertions + +proc hashTree*(n: PNode): Hash = + if n.isNil: + return result = ord(n.kind) case n.kind of nkEmpty, nkNilLit, nkType: @@ -21,7 +26,7 @@ proc hashTree(n: PNode): Hash = of nkIdent: result = result !& n.ident.h of nkSym: - result = result !& n.sym.name.h + result = result !& n.sym.id of nkCharLit..nkUInt64Lit: if (n.intVal >= low(int)) and (n.intVal <= high(int)): result = result !& int(n.intVal) @@ -29,11 +34,13 @@ proc hashTree(n: PNode): Hash = if (n.floatVal >= - 1000000.0) and (n.floatVal <= 1000000.0): result = result !& toInt(n.floatVal) of nkStrLit..nkTripleStrLit: - if not n.strVal.isNil: - result = result !& hash(n.strVal) + result = result !& hash(n.strVal) else: - for i in countup(0, sonsLen(n) - 1): - result = result !& hashTree(n.sons[i]) + for i in 0..<n.len: + result = result !& hashTree(n[i]) + result = !$result + #echo "hashTree ", result + #echo n proc treesEquivalent(a, b: PNode): bool = if a == b: @@ -47,11 +54,15 @@ proc treesEquivalent(a, b: PNode): bool = of nkFloatLit..nkFloat64Lit: result = a.floatVal == b.floatVal of nkStrLit..nkTripleStrLit: result = a.strVal == b.strVal else: - if sonsLen(a) == sonsLen(b): - for i in countup(0, sonsLen(a) - 1): - if not treesEquivalent(a.sons[i], b.sons[i]): return + if a.len == b.len: + 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) @@ -76,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(len(t.data), t.counter): - newSeq(n, len(t.data) * GrowthFactor) - for i in countup(0, high(t.data)): + if mustRehash(t.data.len, t.counter): + 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(len(t.data), t.counter): - newSeq(n, len(t.data) * GrowthFactor) - for i in countup(0, high(t.data)): + if mustRehash(t.data.len, t.counter): + 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 new file mode 100644 index 000000000..39193a42d --- /dev/null +++ b/compiler/typeallowed.nim @@ -0,0 +1,296 @@ +# +# +# The Nim Compiler +# (c) Copyright 2020 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## This module contains 'typeAllowed' and friends which check +## for invalid types like `openArray[var int]`. + +import ast, renderer, options, semdata, types +import std/intsets + +when defined(nimPreviewSlimSystem): + import std/assertions + +type + TTypeAllowedFlag* = enum + taField, + taHeap, + taConcept, + taIsOpenArray, + taNoUntyped + taIsTemplateOrMacro + taProcContextIsNotMacro + taIsCastable + taIsDefaultField + taVoid # only allow direct void fields of objects/tuples + + TTypeAllowedFlags* = set[TTypeAllowedFlag] + +proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind; + c: PContext; flags: TTypeAllowedFlags = {}): PType + +proc typeAllowedNode(marker: var IntSet, n: PNode, kind: TSymKind, + c: PContext; flags: TTypeAllowedFlags = {}): PType = + if n != nil: + result = typeAllowedAux(marker, n.typ, kind, c, flags) + if result == nil: + case n.kind + of nkNone..nkNilLit: + discard + else: + #if n.kind == nkRecCase and kind in {skProc, skFunc, skConst}: + # return n[0].typ + for i in 0..<n.len: + 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 = + assert(kind in {skVar, skLet, skConst, skProc, skFunc, skParam, skResult}) + # if we have already checked the type, return true, because we stop the + # evaluation if something is wrong: + result = nil + 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 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.elementType, abstractInst-{tyTypeDesc, tySink}) + case t2.kind + of tyVar, tyLent: + if taHeap notin flags: result = t2 # ``var var`` is illegal on the heap + of tyOpenArray: + if (kind != skParam and views notin c.features) or taIsOpenArray in flags: result = t + else: result = typeAllowedAux(marker, t2[0], kind, c, flags+{taIsOpenArray}) + of tyUncheckedArray: + if kind != skParam and views notin c.features: result = t + else: result = typeAllowedAux(marker, t2[0], kind, c, flags) + of tySink: + result = t + else: + if kind notin {skParam, skResult} and views notin c.features: result = t + else: result = typeAllowedAux(marker, t2, kind, c, flags) + of tyProc: + if kind in {skVar, skLet, skConst} and taIsTemplateOrMacro in flags: + result = t + else: + if isInlineIterator(typ) and kind in {skVar, skLet, skConst, skParam, skResult}: + # only closure iterators may be assigned to anything. + result = t + let f = if kind in {skProc, skFunc}: flags+{taNoUntyped} else: flags + for _, a in t.paramTypes: + if result != nil: break + 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 + else: + # XXX: This is still a horrible idea... + 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 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.last, kind, c, flags) + elif kind notin {skParam, skResult}: + result = t + of tyGenericBody, tyGenericParam, tyGenericInvocation, + tyNone, tyForward, tyFromExpr: + result = t + of tyNil: + if kind != skConst and kind != skParam: result = t + 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, skipModifier(t), kind, c, flags) + of tyRange: + 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.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.elementType, kind, c, flags+{taIsOpenArray}) + of tySink: + # you cannot nest openArrays/sinks/etc. + if kind != skParam or taIsOpenArray in flags or t.elementType.kind in {tySink, tyLent, tyVar}: + result = t + else: + result = typeAllowedAux(marker, t.elementType, kind, c, flags) + of tyUncheckedArray: + if kind != skParam and taHeap notin flags: + result = t + else: + result = typeAllowedAux(marker, elementType(t), kind, c, flags-{taHeap}) + of tySequence: + if t.elementType.kind != tyEmpty: + result = typeAllowedAux(marker, t.elementType, kind, c, flags+{taHeap}) + elif kind in {skVar, skLet}: + result = t.elementType + of tyArray: + 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.elementType + of tyRef: + 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.elementType, kind, c, flags+{taHeap}) + of tySet: + result = typeAllowedAux(marker, t.elementType, kind, c, flags) + of tyObject: + if kind in {skProc, skFunc, skConst} and + t.baseClass != nil and taIsDefaultField notin flags: + result = t + else: + 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 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.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: + if kind != skParam: result = t + else: result = nil + +proc typeAllowed*(t: PType, kind: TSymKind; c: PContext; flags: TTypeAllowedFlags = {}): PType = + # returns 'nil' on success and otherwise the part of the type that is + # wrong! + var marker = initIntSet() + result = typeAllowedAux(marker, t, kind, c, flags) + +type + ViewTypeKind* = enum + noView, immutableView, mutableView + +proc combine(dest: var ViewTypeKind, b: ViewTypeKind) {.inline.} = + case dest + of noView, mutableView: + dest = b + of immutableView: + if b == mutableView: dest = b + +proc classifyViewTypeAux(marker: var IntSet, t: PType): ViewTypeKind + +proc classifyViewTypeNode(marker: var IntSet, n: PNode): ViewTypeKind = + case n.kind + of nkSym: + result = classifyViewTypeAux(marker, n.typ) + of nkOfBranch: + result = classifyViewTypeNode(marker, n.lastSon) + else: + result = noView + for child in n: + result.combine classifyViewTypeNode(marker, child) + if result == mutableView: break + +proc classifyViewTypeAux(marker: var IntSet, t: PType): ViewTypeKind = + if containsOrIncl(marker, t.id): return noView + case t.kind + of tyVar: + result = mutableView + of tyLent, tyOpenArray, tyVarargs: + result = immutableView + of tyGenericInst, tyDistinct, tyAlias, tyInferred, tySink, tyOwned, + tyUncheckedArray, tySequence, tyArray, tyRef, tyStatic: + result = classifyViewTypeAux(marker, skipModifier(t)) + of tyFromExpr: + if t.hasElementType: + result = classifyViewTypeAux(marker, skipModifier(t)) + else: + result = noView + of tyTuple: + result = noView + 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.baseClass != nil: + result.combine classifyViewTypeAux(marker, t.baseClass) + else: + # it doesn't matter what these types contain, 'ptr openArray' is not a + # view type! + result = noView + +proc classifyViewType*(t: PType): ViewTypeKind = + var marker = initIntSet() + result = classifyViewTypeAux(marker, t) + +proc directViewType*(t: PType): ViewTypeKind = + # does classify 't' without looking recursively into 't'. + case t.kind + of tyVar: + result = mutableView + of tyLent, tyOpenArray: + result = immutableView + of abstractInst-{tyTypeDesc}: + result = directViewType(t.skipModifier) + else: + result = noView + +proc requiresInit*(t: PType): bool = + (t.flags * {tfRequiresInit, tfNeedsFullInit, tfNotNil} != {}) or + classifyViewType(t) != noView diff --git a/compiler/types.nim b/compiler/types.nim index 98343c688..a441b0ea2 100644 --- a/compiler/types.nim +++ b/compiler/types.nim @@ -10,30 +10,69 @@ # this module contains routines for accessing and iterating over types import - intsets, ast, astalgo, trees, msgs, strutils, platform, renderer, options, - lineinfos + 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 - preferName, preferDesc, preferExported, preferModuleInfo, preferGenericArg, - preferTypeName + preferName, # default + preferDesc, # probably should become what preferResolved is + preferExported, + preferModuleInfo, # fully qualified + preferGenericArg, + preferTypeName, + preferResolved, # fully resolved symbols + 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.sons[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 @@ -52,50 +91,68 @@ const # TODO: Remove tyTypeDesc from each abstractX and (where necessary) # replace with typedescX abstractPtrs* = {tyVar, tyPtr, tyRef, tyGenericInst, tyDistinct, tyOrdinal, - tyTypeDesc, tyAlias, tyInferred, tySink, tyLent} + tyTypeDesc, tyAlias, tyInferred, tySink, tyLent, tyOwned} abstractVar* = {tyVar, tyGenericInst, tyDistinct, tyOrdinal, tyTypeDesc, - tyAlias, tyInferred, tySink, tyLent} + tyAlias, tyInferred, tySink, tyLent, tyOwned} abstractRange* = {tyGenericInst, tyRange, tyDistinct, tyOrdinal, tyTypeDesc, - tyAlias, tyInferred, tySink} - abstractVarRange* = {tyGenericInst, tyRange, tyVar, tyDistinct, tyOrdinal, - tyTypeDesc, tyAlias, tyInferred, tySink} - abstractInst* = {tyGenericInst, tyDistinct, tyOrdinal, tyTypeDesc, tyAlias, - tyInferred, tySink} + tyAlias, tyInferred, tySink, tyOwned} + abstractInstOwned* = abstractInst + {tyOwned} skipPtrs* = {tyVar, tyPtr, tyRef, tyGenericInst, tyTypeDesc, tyAlias, - tyInferred, tySink, tyLent} + tyInferred, tySink, tyLent, tyOwned} # typedescX is used if we're sure tyTypeDesc should be included (or skipped) typedescPtrs* = abstractPtrs + {tyTypeDesc} - typedescInst* = abstractInst + {tyTypeDesc} - -type - TTypeFieldResult* = enum - frNone, # type has no object type field - frHeader, # type has an object type field only in the header - frEmbedded # type has an object type field somewhere embedded - -proc analyseObjectWithTypeField*(t: PType): TTypeFieldResult - # this does a complex analysis whether a call to ``objectInit`` needs to be - # made or intializing of the type field suffices or if there is no type field - # at all in this type. + 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.sons[0] != nil: - t = t.sons[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 getOrdValue*(n: PNode): BiggestInt = - case n.kind - of nkCharLit..nkUInt64Lit: result = n.intVal - of nkNilLit: result = 0 - of nkHiddenStdConv: result = getOrdValue(n.sons[1]) +proc isUnsigned*(t: PType): bool = + t.skipTypes(abstractInst).kind in {tyChar, tyUInt..tyUInt64} + +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 + + case k + of nkCharLit, nkUIntLit..nkUInt64Lit: + # XXX: enable this assert + #assert n.typ == nil or isUnsigned(n.typ), $n.typ + toInt128(cast[uint64](n.intVal)) + of nkIntLit..nkInt64Lit: + # XXX: enable this assert + #assert n.typ == nil or not isUnsigned(n.typ), $n.typ.kind + toInt128(n.intVal) + of nkNilLit: + int128.Zero + of nkHiddenStdConv: + getOrdValueAux(n[1], err) else: - #localError(n.info, errOrdinalTypeExpected) - # XXX check usages of getOrdValue - result = high(BiggestInt) + 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 + of nkFloatLiterals: n.floatVal + of nkHiddenStdConv: getFloatValue(n[1]) + else: NaN proc isIntLit*(t: PType): bool {.inline.} = result = t.kind == tyInt and t.n != nil and t.n.kind == nkIntLit @@ -103,46 +160,52 @@ 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 getProcHeader*(conf: ConfigRef; sym: PSym; prefer: TPreferedDesc = preferName): string = - result = sym.owner.name.s & '.' & sym.name.s & '(' - var n = sym.typ.n - for i in countup(1, sonsLen(n) - 1): - let p = n.sons[i] - if p.kind == nkSym: - add(result, p.sym.name.s) - add(result, ": ") - add(result, typeToString(p.sym.typ, prefer)) - if i != sonsLen(n)-1: add(result, ", ") - else: - result.add renderTree(p) - add(result, ')') - if n.sons[0].typ != nil: - result.add(": " & typeToString(n.sons[0].typ, prefer)) - result.add "[declared in " - result.add(conf$sym.info) - result.add "]" +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) + +proc getProcHeader*(conf: ConfigRef; sym: PSym; prefer: TPreferedDesc = preferName; getDeclarationPath = true): string = + assert sym != nil + # consider using `skipGenericOwner` to avoid fun2.fun2 when fun2 is generic + result = sym.owner.name.s & '.' & sym.name.s + if sym.kind in routineKinds: + result.add '(' + var n = sym.typ.n + for i in 1..<n.len: + let p = n[i] + if p.kind == nkSym: + result.add(p.sym.name.s) + result.add(": ") + result.add(typeToString(p.sym.typ, prefer)) + if i != n.len-1: result.add(", ") + else: + result.add renderTree(p) + result.add(')') + if n[0].typ != nil: + result.add(": " & typeToString(n[0].typ, prefer)) + if getDeclarationPath: result.addDeclaredLoc(conf, sym) proc elemType*(t: PType): PType = assert(t != nil) case t.kind - of tyGenericInst, tyDistinct, tyAlias: result = elemType(lastSon(t)) - of tyArray: result = t.sons[1] - else: result = t.lastSon + of tyGenericInst, tyDistinct, tyAlias, tySink: result = elemType(skipModifier(t)) + of tyArray: result = t.elementType + of tyError: result = t + else: result = t.elementType assert(result != nil) -proc isOrdinalType*(t: PType): bool = - assert(t != nil) - const - # caution: uint, uint64 are no ordinal types! - baseKinds = {tyChar,tyInt..tyInt64,tyUInt8..tyUInt32,tyBool,tyEnum} - parentKinds = {tyRange, tyOrdinal, tyGenericInst, tyAlias, tyDistinct} - t.kind in baseKinds or (t.kind in parentKinds and isOrdinalType(t.sons[0])) - proc enumHasHoles*(t: PType): bool = - var b = t - while b.kind in {tyRange, tyGenericInst, tyAlias}: b = b.sons[0] + var b = t.skipTypes({tyRange, tyGenericInst, tyAlias, tySink}) result = b.kind == tyEnum and tfEnumHasHoles in b.flags +proc isOrdinalType*(t: PType, allowEnumWithHoles: bool = false): bool = + assert(t != nil) + const + 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.skipModifier, allowEnumWithHoles)) + proc iterOverTypeAux(marker: var IntSet, t: PType, iter: TTypeIter, closure: RootRef): bool proc iterOverNode(marker: var IntSet, n: PNode, iter: TTypeIter, @@ -153,9 +216,13 @@ proc iterOverNode(marker: var IntSet, n: PNode, iter: TTypeIter, # a leaf result = iterOverTypeAux(marker, n.typ, iter, closure) else: - for i in countup(0, sonsLen(n) - 1): - result = iterOverNode(marker, n.sons[i], iter, closure) + 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 = @@ -165,13 +232,17 @@ 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, 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 countup(0, sonsLen(t) - 1): - result = iterOverTypeAux(marker, t.sons[i], iter, closure) + for a in t.kids: + result = iterOverTypeAux(marker, a, iter, closure) if result: return - if t.n != nil: result = iterOverNode(marker, t.n, iter, closure) + if t.n != nil and t.kind != tyProc: result = iterOverNode(marker, t.n, iter, closure) proc iterOverType(t: PType, iter: TTypeIter, closure: RootRef): bool = var marker = initIntSet() @@ -185,17 +256,17 @@ proc searchTypeNodeForAux(n: PNode, p: TTypePredicate, result = false case n.kind of nkRecList: - for i in countup(0, sonsLen(n) - 1): - result = searchTypeNodeForAux(n.sons[i], p, marker) + for i in 0..<n.len: + result = searchTypeNodeForAux(n[i], p, marker) if result: return of nkRecCase: - assert(n.sons[0].kind == nkSym) - result = searchTypeNodeForAux(n.sons[0], p, marker) + assert(n[0].kind == nkSym) + result = searchTypeNodeForAux(n[0], p, marker) if result: return - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind + for i in 1..<n.len: + case n[i].kind of nkOfBranch, nkElse: - result = searchTypeNodeForAux(lastSon(n.sons[i]), p, marker) + result = searchTypeNodeForAux(lastSon(n[i]), p, marker) if result: return else: discard of nkSym: @@ -212,19 +283,19 @@ proc searchTypeForAux(t: PType, predicate: TTypePredicate, if result: return case t.kind of tyObject: - if t.sons[0] != nil: - result = searchTypeForAux(t.sons[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: - result = searchTypeForAux(lastSon(t), predicate, marker) + of tyGenericInst, tyDistinct, tyAlias, tySink: + result = searchTypeForAux(skipModifier(t), predicate, marker) of tyArray, tySet, tyTuple: - for i in countup(0, sonsLen(t) - 1): - result = searchTypeForAux(t.sons[i], predicate, marker) + for a in t.kids: + result = searchTypeForAux(a, predicate, marker) if result: return else: discard -proc searchTypeFor(t: PType, predicate: TTypePredicate): bool = +proc searchTypeFor*(t: PType, predicate: TTypePredicate): bool = var marker = initIntSet() result = searchTypeForAux(t, predicate, marker) @@ -235,13 +306,18 @@ proc containsObject*(t: PType): bool = result = searchTypeFor(t, isObjectPredicate) proc isObjectWithTypeFieldPredicate(t: PType): bool = - result = t.kind == tyObject and t.sons[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 +type + TTypeFieldResult* = enum + frNone, # type has no object type field + frHeader, # type has an object type field only in the header + frEmbedded # type has an object type field somewhere embedded + proc analyseObjectWithTypeFieldAux(t: PType, marker: var IntSet): TTypeFieldResult = - var res: TTypeFieldResult result = frNone if t == nil: return case t.kind @@ -249,38 +325,49 @@ proc analyseObjectWithTypeFieldAux(t: PType, if t.n != nil: if searchTypeNodeForAux(t.n, isObjectWithTypeFieldPredicate, marker): return frEmbedded - for i in countup(0, sonsLen(t) - 1): - var x = t.sons[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: - result = analyseObjectWithTypeFieldAux(lastSon(t), marker) + of tyGenericInst, tyDistinct, tyAlias, tySink: + result = analyseObjectWithTypeFieldAux(skipModifier(t), marker) of tyArray, tyTuple: - for i in countup(0, sonsLen(t) - 1): - res = analyseObjectWithTypeFieldAux(t.sons[i], marker) + for a in t.kids: + let res = analyseObjectWithTypeFieldAux(a, marker) if res != frNone: return frEmbedded else: discard -proc analyseObjectWithTypeField(t: PType): TTypeFieldResult = +proc analyseObjectWithTypeField*(t: PType): TTypeFieldResult = + # this does a complex analysis whether a call to ``objectInit`` needs to be + # made or initializing of the type field suffices or if there is no type field + # at all in this type. var marker = initIntSet() result = analyseObjectWithTypeFieldAux(t, marker) proc isGCRef(t: PType): bool = result = t.kind in GcTypeKinds or (t.kind == tyProc and t.callConv == ccClosure) + if result and t.kind in {tyString, tySequence} and tfHasAsgn in t.flags: + result = false proc containsGarbageCollectedRef*(typ: PType): bool = # returns true if typ contains a reference, sequence or string (all the # things that are garbage-collected) result = searchTypeFor(typ, isGCRef) +proc isManagedMemory(t: PType): bool = + result = t.kind in GcTypeKinds or + (t.kind == tyProc and t.callConv == ccClosure) + +proc containsManagedMemory*(typ: PType): bool = + result = searchTypeFor(typ, isManagedMemory) + proc isTyRef(t: PType): bool = result = t.kind == tyRef or (t.kind == tyProc and t.callConv == ccClosure) @@ -289,123 +376,130 @@ proc containsTyRef*(typ: PType): bool = result = searchTypeFor(typ, isTyRef) proc isHiddenPointer(t: PType): bool = - result = t.kind in {tyString, tySequence} + result = t.kind in {tyString, tySequence, tyOpenArray, tyVarargs} proc containsHiddenPointer*(typ: PType): bool = # returns true if typ contains a string, table or sequence (all the things # 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 countup(0, sonsLen(n) - 1): - result = canFormAcycleNode(marker, n.sons[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-{tyTypeDesc}) + 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 countup(0, sonsLen(t) - 1): - result = canFormAcycleAux(marker, t.sons[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 -proc canFormAcycle*(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 countup(0, sonsLen(n) - 1): - addSon(result, mutateNode(marker, n.sons[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 countup(0, sonsLen(t) - 1): - result.sons[i] = mutateTypeAux(marker, result.sons[i], iter, closure) - if t.n != nil: result.n = mutateNode(marker, t.n, iter, closure) - assert(result != nil) +proc isFinal*(t: PType): bool = + let t = t.skipTypes(abstractInst) + result = t.kind != tyObject or tfFinal in t.flags or isPureObject(t) -proc mutateType(t: PType, iter: TTypeMutator, closure: RootRef): PType = +proc canFormAcycle*(g: ModuleGraph, typ: PType): bool = 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 = assert(n.kind == nkRange) - result = valueToString(n.sons[0]) & ".." & valueToString(n.sons[1]) + result = valueToString(n[0]) & ".." & valueToString(n[1]) const - typeToStr: array[TTypeKind, string] = ["None", "bool", "Char", "empty", - "Alias", "nil", "untyped", "typed", "typeDesc", + typeToStr: array[TTypeKind, string] = ["None", "bool", "char", "empty", + "Alias", "typeof(nil)", "untyped", "typed", "typeDesc", + # xxx typeDesc=>typedesc: typedesc is declared as such, and is 10x more common. "GenericInvocation", "GenericBody", "GenericInst", "GenericParam", "distinct $1", "enum", "ordinal[$1]", "array[$1, $2]", "object", "tuple", "set[$1]", "range[$1]", "ptr ", "ref ", "var ", "seq[$1]", "proc", - "pointer", "OpenArray[$1]", "string", "CString", "Forward", + "pointer", "OpenArray[$1]", "string", "cstring", "Forward", "int", "int8", "int16", "int32", "int64", "float", "float32", "float64", "float128", "uint", "uint8", "uint16", "uint32", "uint64", - "opt", "sink", - "lent", "varargs[$1]", "unused", "Error Type", + "owned", "sink", + "lent ", "varargs[$1]", "UncheckedArray[$1]", "Error Type", "BuiltInTypeClass", "UserTypeClass", "UserTypeClassInst", "CompositeTypeClass", "inferred", - "and", "or", "not", "any", "static", "TypeFromExpr", "FieldAccessor", - "void"] + "and", "or", "not", "any", "static", "TypeFromExpr", "concept", # xxx bugfix + "void", "iterable"] -const preferToResolveSymbols = {preferName, preferTypeName, preferModuleInfo, preferGenericArg} +const preferToResolveSymbols = {preferName, preferTypeName, preferModuleInfo, + preferGenericArg, preferResolved, preferMixed, preferInlayHint, preferInferredEffects} template bindConcreteTypeToUserTypeClass*(tc, concrete: PType) = - tc.sons.safeAdd concrete + tc.add concrete tc.flags.incl tfResolved # 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. @@ -416,266 +510,474 @@ proc addTypeFlags(name: var string, typ: PType) {.inline.} = if tfNotNil in typ.flags: name.add(" not nil") proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = - var t = typ - result = "" - if t == nil: return - if prefer in preferToResolveSymbols and t.sym != nil and - sfAnon notin t.sym.flags: - if t.kind == tyInt and isIntLit(t): - result = t.sym.name.s & " literal(" & $t.n.intVal & ")" - elif prefer in {preferName, preferTypeName} or t.sym.owner.isNil: - result = t.sym.name.s - if t.kind == tyGenericParam and t.sons != nil and t.sonsLen > 0: - result.add ": " - var first = true - for son in t.sons: - if not first: result.add " or " - result.add son.typeToString - first = false + let preferToplevel = prefer + proc getPrefer(prefer: TPreferedDesc): TPreferedDesc = + if preferToplevel in {preferResolved, preferMixed}: + preferToplevel # sticky option else: - result = t.sym.owner.name.s & '.' & t.sym.name.s + prefer + + proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = + result = "" + let prefer = getPrefer(prefer) + let t = typ + if t == nil: return + 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): + 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}: + result = typeToStr[t.kind] + of tyGenericBody: + result = typeToString(t.last) + of tyCompositeTypeClass: + # avoids showing `A[any]` in `proc fun(a: A)` with `A = object[T]` + result = typeToString(t.last.last) + else: + result = t.sym.name.s + if prefer == preferMixed and result != t.sym.name.s: + result = t.sym.name.s & "{" & result & "}" + elif prefer in {preferName, preferTypeName, preferInlayHint, preferInferredEffects} or t.sym.owner.isNil: + # note: should probably be: {preferName, preferTypeName, preferGenericArg} + result = t.sym.name.s + if t.kind == tyGenericParam and t.genericParamHasConstraints: + result.add ": " + result.add t.elementType.typeToString + else: + result = t.sym.owner.name.s & '.' & t.sym.name.s + result.addTypeFlags(t) + return + case t.kind + of tyInt: + if not isIntLit(t) or prefer == preferExported: + result = typeToStr[t.kind] + else: + case prefer: + of preferGenericArg: + result = $t.n.intVal + of preferInlayHint: + result = "int" + else: + result = "int literal(" & $t.n.intVal & ")" + 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.typeBodyImpl) & '[' + for i, a in t.genericBodyParams: + if i > 0: result.add(", ") + result.add(typeToString(a, preferTypeName)) + result.add(']') + of tyTypeDesc: + 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.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.last) + return t.sym.owner.name.s + else: + result = "<invalid tyUserTypeClass>" + of tyBuiltInTypeClass: + result = + case t.base.kind + of tyVar: "var" + of tyRef: "ref" + of tyPtr: "ptr" + of tySequence: "seq" + of tyArray: "array" + of tySet: "set" + of tyRange: "range" + of tyDistinct: "distinct" + of tyProc: "proc" + of tyObject: "object" + of tyTuple: "tuple" + of tyOpenArray: "openArray" + else: typeToStr[t.base.kind] + of tyInferred: + let concrete = t.previouslyInferred + if concrete != nil: result = typeToString(concrete) + else: result = "inferred[" & typeToString(t.base) & "]" + of tyUserTypeClassInst: + let body = t.base + result = body.sym.name.s & "[" + for needsComma, a in t.userTypeClassInstParams: + if needsComma: result.add(", ") + result.add(typeToString(a)) + result.add "]" + of tyAnd: + for i, son in t.ikids: + if i > 0: result.add(" and ") + result.add(typeToString(son)) + of tyOr: + for i, son in t.ikids: + if i > 0: result.add(" or ") + result.add(typeToString(son)) + of tyNot: + result = "not " & typeToString(t.elementType) + of tyUntyped: + #internalAssert t.len == 0 + result = "untyped" + of tyFromExpr: + if t.n == nil: + result = "unknown" + else: + result = "typeof(" & renderTree(t.n) & ")" + of tyArray: + result = "array" + if t.hasElementType: + if t.indexType.kind == tyRange: + result &= "[" & rangeToStr(t.indexType.n) & ", " & + typeToString(t.elementType) & ']' + else: + result &= "[" & typeToString(t.indexType) & ", " & + typeToString(t.elementType) & ']' + of tyUncheckedArray: + result = "UncheckedArray" + 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.hasElementType: + result &= "[" & typeToString(t.elementType) & ']' + of tyOrdinal: + result = "ordinal" + if t.hasElementType: + result &= "[" & typeToString(t.skipModifier) & ']' + of tySet: + result = "set" + if t.hasElementType: + result &= "[" & typeToString(t.elementType) & ']' + of tyOpenArray: + result = "openArray" + if t.hasElementType: + result &= "[" & typeToString(t.elementType) & ']' + of tyDistinct: + 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[" + for i in 0..<t.n.len: + assert(t.n[i].kind == nkSym) + 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.isEmptyTupleType: + result = "tuple[]" + elif t.isSingletonTupleType: + result = "(" + for son in t.kids: + result.add(typeToString(son)) + result.add(",)") + else: + result = "(" + for i, son in t.ikids: + if i > 0: result.add ", " + result.add(typeToString(son)) + result.add(')') + of tyPtr, tyRef, tyVar, tyLent: + result = if isOutParam(t): "out " else: typeToStr[t.kind] + 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.elementType) & ")") + of tyProc: + result = if tfIterator in t.flags: "iterator " + elif t.owner != nil: + case t.owner.kind + of skTemplate: "template " + of skMacro: "macro " + of skConverter: "converter " + else: "proc " + else: + "proc " + if tfUnresolved in t.flags: result.add "[*missing parameters*]" + result.add "(" + 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(a)) + result.add(')') + 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") + var effectsOfStr = "" + for i, a in t.paramTypes: + let j = paramTypeToNodeIndex(i) + if t.n != nil and j < t.n.len and t.n[j].kind == nkSym and t.n[j].sym.kind == skParam and sfEffectsDelayed in t.n[j].sym.flags: + addSep(effectsOfStr) + effectsOfStr.add(t.n[j].sym.name.s) + if effectsOfStr != "": + addSep(prag) + prag.add("effectsOf: ") + prag.add(effectsOfStr) + if not hasImplicitRaises and prefer == preferInferredEffects and not isNil(t.owner) and not isNil(t.owner.typ) and not isNil(t.owner.typ.n) and (t.owner.typ.n.len > 0): + let effects = t.owner.typ.n[0] + if effects.kind == nkEffectList and effects.len == effectListLen: + var inferredRaisesStr = "" + let effs = effects[exceptionEffects] + if not isNil(effs): + for eff in items(effs): + if not isNil(eff): + addSep(inferredRaisesStr) + inferredRaisesStr.add($eff.typ) + addSep(prag) + prag.add("raises: <inferred> [") + prag.add(inferredRaisesStr) + prag.add("]") + if prag.len != 0: result.add("{." & prag & ".}") + of tyVarargs: + result = typeToStr[t.kind] % typeToString(t.elementType) + of tySink: + result = "sink " & typeToString(t.skipModifier) + of tyOwned: + result = "owned " & typeToString(t.elementType) + else: + result = typeToStr[t.kind] result.addTypeFlags(t) - return + result = typeToString(typ, prefer) + +proc firstOrd*(conf: ConfigRef; t: PType): Int128 = case t.kind + of tyBool, tyChar, tySequence, tyOpenArray, tyString, tyVarargs, tyError: + result = Zero + 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 not isIntLit(t) or prefer == preferExported: - result = typeToStr[t.kind] - else: - if prefer == preferGenericArg: - result = $t.n.intVal - else: - result = "int literal(" & $t.n.intVal & ")" - of tyGenericBody, tyGenericInst, tyGenericInvocation: - result = typeToString(t.sons[0]) & '[' - for i in countup(1, sonsLen(t)-1-ord(t.kind != tyGenericInvocation)): - if i > 1: add(result, ", ") - add(result, typeToString(t.sons[i], preferGenericArg)) - add(result, ']') - of tyTypeDesc: - if t.sons[0].kind == tyNone: result = "typedesc" - else: result = "type " & typeToString(t.sons[0]) - of tyStatic: - if prefer == preferGenericArg and t.n != nil: - result = t.n.renderTree + 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 = "static[" & (if t.len > 0: typeToString(t.sons[0]) 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) - return t.sym.owner.name.s - else: - result = "<invalid tyUserTypeClass>" - of tyBuiltInTypeClass: - result = case t.base.kind: - of tyVar: "var" - of tyRef: "ref" - of tyPtr: "ptr" - of tySequence: "seq" - of tyArray: "array" - of tySet: "set" - of tyRange: "range" - of tyDistinct: "distinct" - of tyProc: "proc" - of tyObject: "object" - of tyTuple: "tuple" - of tyOpenArray: "openarray" - else: typeToStr[t.base.kind] - of tyInferred: - let concrete = t.previouslyInferred - if concrete != nil: result = typeToString(concrete) - else: result = "inferred[" & typeToString(t.base) & "]" - of tyUserTypeClassInst: - let body = t.base - result = body.sym.name.s & "[" - for i in countup(1, sonsLen(t) - 2): - if i > 1: add(result, ", ") - add(result, typeToString(t.sons[i])) - result.add "]" - of tyAnd: - result = typeToString(t.sons[0]) & " and " & typeToString(t.sons[1]) - of tyOr: - result = typeToString(t.sons[0]) & " or " & typeToString(t.sons[1]) - of tyNot: - result = "not " & typeToString(t.sons[0]) - of tyExpr: - #internalAssert t.len == 0 - result = "untyped" - of tyFromExpr: - result = renderTree(t.n) - of tyArray: - if t.sons[0].kind == tyRange: - result = "array[" & rangeToStr(t.sons[0].n) & ", " & - typeToString(t.sons[1]) & ']' + result = toInt128(0x8000000000000000'i64) + of tyInt8: result = toInt128(-128) + of tyInt16: result = toInt128(-32768) + of tyInt32: result = toInt128(-2147483648) + of tyInt64: result = toInt128(0x8000000000000000'i64) + of tyUInt..tyUInt64: result = Zero + of tyEnum: + # if basetype <> nil then return firstOrd of basetype + if t.baseClass != nil: + result = firstOrd(conf, t.baseClass) else: - result = "array[" & typeToString(t.sons[0]) & ", " & - typeToString(t.sons[1]) & ']' - of tySequence: - result = "seq[" & typeToString(t.sons[0]) & ']' - of tyOpt: - result = "opt[" & typeToString(t.sons[0]) & ']' + 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, tyLent: + result = firstOrd(conf, skipModifier(t)) + of tyUserTypeClasses: + result = firstOrd(conf, last(t)) of tyOrdinal: - result = "ordinal[" & typeToString(t.sons[0]) & ']' - of tySet: - result = "set[" & typeToString(t.sons[0]) & ']' - of tyOpenArray: - result = "openarray[" & typeToString(t.sons[0]) & ']' - of tyDistinct: - result = "distinct " & typeToString(t.sons[0], - if prefer == preferModuleInfo: preferModuleInfo else: preferTypeName) - of tyTuple: - # we iterate over t.sons here, because t.n may be nil - if t.n != nil: - result = "tuple[" - assert(sonsLen(t.n) == sonsLen(t)) - for i in countup(0, sonsLen(t.n) - 1): - assert(t.n.sons[i].kind == nkSym) - add(result, t.n.sons[i].sym.name.s & ": " & typeToString(t.sons[i])) - if i < sonsLen(t.n) - 1: add(result, ", ") - add(result, ']') - elif sonsLen(t) == 0: - result = "tuple[]" + if t.hasElementType: result = firstOrd(conf, skipModifier(t)) else: - if prefer == preferTypeName: result = "(" - else: result = "tuple of (" - for i in countup(0, sonsLen(t) - 1): - add(result, typeToString(t.sons[i])) - if i < sonsLen(t) - 1: add(result, ", ") - add(result, ')') - of tyPtr, tyRef, tyVar, tyLent: - result = typeToStr[t.kind] - if t.len >= 2: - setLen(result, result.len-1) - result.add '[' - for i in countup(0, sonsLen(t) - 1): - add(result, typeToString(t.sons[i])) - if i < sonsLen(t) - 1: add(result, ", ") - result.add ']' - else: - result.add typeToString(t.sons[0]) - 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.sons[0]) & ")") - of tyProc: - result = if tfIterator in t.flags: "iterator " else: "proc " - if tfUnresolved in t.flags: result.add "[*missing parameters*]" - result.add "(" - for i in countup(1, sonsLen(t) - 1): - if t.n != nil and i < t.n.len and t.n[i].kind == nkSym: - add(result, t.n[i].sym.name.s) - add(result, ": ") - add(result, typeToString(t.sons[i])) - if i < sonsLen(t) - 1: add(result, ", ") - add(result, ')') - if t.len > 0 and t.sons[0] != nil: add(result, ": " & typeToString(t.sons[0])) - var prag = if t.callConv == ccDefault: "" else: CallingConvToStr[t.callConv] - if tfNoSideEffect in t.flags: - addSep(prag) - add(prag, "noSideEffect") - if tfThread in t.flags: - addSep(prag) - add(prag, "gcsafe") - if t.lockLevel.ord != UnspecifiedLockLevel.ord: - addSep(prag) - add(prag, "locks: " & $t.lockLevel) - if len(prag) != 0: add(result, "{." & prag & ".}") - of tyVarargs: - result = typeToStr[t.kind] % typeToString(t.sons[0]) - of tySink: - result = "sink " & typeToString(t.sons[0]) + result = Zero + fatal(conf, unknownLineInfo, "invalid kind for firstOrd(" & $t.kind & ')') + of tyUncheckedArray, tyCstring: + result = Zero else: - result = typeToStr[t.kind] - result.addTypeFlags(t) + result = Zero + fatal(conf, unknownLineInfo, "invalid kind for firstOrd(" & $t.kind & ')') -proc firstOrd*(conf: ConfigRef; t: PType): BiggestInt = +proc firstFloat*(t: PType): BiggestFloat = case t.kind - of tyBool, tyChar, tySequence, tyOpenArray, tyString, tyVarargs, tyProxy: - result = 0 - of tySet, tyVar: result = firstOrd(conf, t.sons[0]) - of tyArray: result = firstOrd(conf, t.sons[0]) + of tyFloat..tyFloat128: -Inf of tyRange: assert(t.n != nil) # range directly given: assert(t.n.kind == nkRange) - result = getOrdValue(t.n.sons[0]) + getFloatValue(t.n[0]) + of tyVar: firstFloat(t.elementType) + of tyGenericInst, tyDistinct, tyTypeDesc, tyAlias, tySink, + 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: - if conf != nil and conf.target.intSize == 4: result = - (2147483646) - 2 - else: result = 0x8000000000000000'i64 - of tyInt8: result = - 128 - of tyInt16: result = - 32768 - of tyInt32: result = - 2147483646 - 2 - of tyInt64: result = 0x8000000000000000'i64 - of tyUInt..tyUInt64: result = 0 - of tyEnum: - # if basetype <> nil then return firstOrd of basetype - if sonsLen(t) > 0 and t.sons[0] != nil: - result = firstOrd(conf, t.sons[0]) - else: - assert(t.n.sons[0].kind == nkSym) - result = t.n.sons[0].sym.position - of tyGenericInst, tyDistinct, tyTypeDesc, tyAlias, tyStatic, tyInferred: - result = firstOrd(conf, lastSon(t)) - of tyOrdinal: - if t.len > 0: result = firstOrd(conf, lastSon(t)) - else: internalError(conf, "invalid kind for firstOrd(" & $t.kind & ')') + result = conf.targetSizeSignedToKind() + of tyUInt: + result = conf.targetSizeUnsignedToKind() else: - internalError(conf, "invalid kind for firstOrd(" & $t.kind & ')') - result = 0 + result = k -proc lastOrd*(conf: ConfigRef; t: PType; fixedUnsigned = false): BiggestInt = +proc lastOrd*(conf: ConfigRef; t: PType): Int128 = case t.kind - of tyBool: result = 1 - of tyChar: result = 255 - of tySet, tyVar: result = lastOrd(conf, t.sons[0]) - of tyArray: result = lastOrd(conf, t.sons[0]) + of tyBool: result = toInt128(1'u) + of tyChar: result = toInt128(255'u) + 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.sons[1]) + result = getOrdValue(t.n[1]) of tyInt: - if conf != nil and conf.target.intSize == 4: result = 0x7FFFFFFF - else: result = 0x7FFFFFFFFFFFFFFF'i64 - of tyInt8: result = 0x0000007F - of tyInt16: result = 0x00007FFF - of tyInt32: result = 0x7FFFFFFF - of tyInt64: result = 0x7FFFFFFFFFFFFFFF'i64 + 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) + of tyInt32: result = toInt128(0x7FFFFFFF) + of tyInt64: result = toInt128(0x7FFFFFFFFFFFFFFF'u64) of tyUInt: - if conf != nil and conf.target.intSize == 4: result = 0xFFFFFFFF - elif fixedUnsigned: result = 0xFFFFFFFFFFFFFFFF'i64 - else: result = 0x7FFFFFFFFFFFFFFF'i64 - of tyUInt8: result = 0xFF - of tyUInt16: result = 0xFFFF - of tyUInt32: result = 0xFFFFFFFF + if conf != nil and conf.target.intSize == 4: + result = toInt128(0xFFFFFFFF) + else: + result = toInt128(0xFFFFFFFFFFFFFFFF'u64) + of tyUInt8: result = toInt128(0xFF) + of tyUInt16: result = toInt128(0xFFFF) + of tyUInt32: result = toInt128(0xFFFFFFFF) of tyUInt64: - if fixedUnsigned: result = 0xFFFFFFFFFFFFFFFF'i64 - else: result = 0x7FFFFFFFFFFFFFFF'i64 + result = toInt128(0xFFFFFFFFFFFFFFFF'u64) of tyEnum: - assert(t.n.sons[sonsLen(t.n) - 1].kind == nkSym) - result = t.n.sons[sonsLen(t.n) - 1].sym.position - of tyGenericInst, tyDistinct, tyTypeDesc, tyAlias, tyStatic, tyInferred: - result = lastOrd(conf, lastSon(t)) - of tyProxy: result = 0 + 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, 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: + 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.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: + lastFloat(skipModifier(t)) + of tyUserTypeClasses: + lastFloat(last(t)) else: - internalError(conf, "invalid kind for lastOrd(" & $t.kind & ')') - result = 0 + internalError(newPartialConfigRef(), "invalid kind for lastFloat(" & $t.kind & ')') + NaN -proc lengthOrd*(conf: ConfigRef; t: PType): BiggestInt = +proc floatRangeCheck*(x: BiggestFloat, t: PType): bool = case t.kind - of tyInt64, tyInt32, tyInt: result = lastOrd(conf, t) - of tyDistinct: result = lengthOrd(conf, t.sons[0]) + # This needs to be special cased since NaN is never + # part of firstFloat(t)..lastFloat(t) + of tyFloat..tyFloat128: + true + of tyRange: + x in firstFloat(t)..lastFloat(t) + of tyVar: + floatRangeCheck(x, t.elementType) + of tyGenericInst, tyDistinct, tyTypeDesc, tyAlias, tySink, + 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.skipModifier) else: let last = lastOrd(conf, t) let first = firstOrd(conf, t) - # XXX use a better overflow check here: - if last == high(BiggestInt) and first <= 0: - result = last - else: - result = lastOrd(conf, t) - firstOrd(conf, t) + 1 + result = last - first + One # -------------- type equality ----------------------------------------------- @@ -694,10 +996,14 @@ 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] - TSameTypeClosure = object {.pure.} + TSameTypeClosure = object cmp: TDistinctCompare recCheck: int flags: TTypeCmpFlags @@ -706,12 +1012,11 @@ 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 = not isNil(c.s) and c.s.contains((a.id, b.id)) + result = c.s.len > 0 and c.s.contains((a.id, b.id)) if not result: - if isNil(c.s): c.s = @[] c.s.add((a.id, b.id)) proc sameTypeAux(x, y: PType, c: var TSameTypeClosure): bool @@ -746,13 +1051,15 @@ proc equalParam(a, b: PSym): TParamsEquality = result = paramsEqual elif b.ast != nil: result = paramsIncompatible + else: + result = paramsNotEqual else: result = paramsNotEqual proc sameConstraints(a, b: PNode): bool = if isNil(a) and isNil(b): return true if a.len != b.len: return false - for i in 1 ..< a.len: + for i in 1..<a.len: if not exprStructuralEquivalent(a[i].sym.constraint, b[i].sym.constraint): return false @@ -760,13 +1067,12 @@ proc sameConstraints(a, b: PNode): bool = proc equalParams(a, b: PNode): TParamsEquality = result = paramsEqual - var length = sonsLen(a) - if length != sonsLen(b): + if a.len != b.len: result = paramsNotEqual else: - for i in countup(1, length - 1): - var m = a.sons[i].sym - var n = b.sons[i].sym + for i in 1..<a.len: + var m = a[i].sym + var n = b[i].sym assert((m.kind == skParam) and (n.kind == skParam)) case equalParam(m, n) of paramsNotEqual: @@ -775,7 +1081,7 @@ proc equalParams(a, b: PNode): TParamsEquality = discard of paramsIncompatible: result = paramsIncompatible - if (m.name.id != n.name.id): + if m.name.id != n.name.id: # BUGFIX return paramsNotEqual # paramsIncompatible; # continue traversal! If not equal, we can return immediately; else @@ -791,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 sonsLen(a) == sonsLen(b): + if sameTupleLengths(a, b): result = true - for i in countup(0, sonsLen(a) - 1): - var x = a.sons[i] - var y = b.sons[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}) @@ -803,17 +1109,19 @@ proc sameTuple(a, b: PType, c: var TSameTypeClosure): bool = result = sameTypeAux(x, y, c) if not result: return if a.n != nil and b.n != nil and IgnoreTupleFields notin c.flags: - for i in countup(0, sonsLen(a.n) - 1): + for i in 0..<a.n.len: # check field names: - if a.n.sons[i].kind == nkSym and b.n.sons[i].kind == nkSym: - var x = a.n.sons[i].sym - var y = b.n.sons[i].sym + if a.n[i].kind == nkSym and b.n[i].kind == nkSym: + var x = a.n[i].sym + var y = b.n[i].sym result = x.name.id == y.name.id if not result: break else: 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: @@ -833,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) @@ -866,36 +1176,48 @@ proc sameObjectTree(a, b: PNode, c: var TSameTypeClosure): bool = of nkStrLit..nkTripleStrLit: result = a.strVal == b.strVal of nkEmpty, nkNilLit, nkType: result = true else: - if sonsLen(a) == sonsLen(b): - for i in countup(0, sonsLen(a) - 1): - if not sameObjectTree(a.sons[i], b.sons[i], c): return + if a.len == b.len: + 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 sonsLen(a) != sonsLen(b): return - for i in countup(0, sonsLen(a) - 1): - if not sameTypeOrNilAux(a.sons[i], b.sons[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 sonsLen(a) != sonsLen(b): return false + if not sameTupleLengths(a, b): return false + # XXX This is not tuple specific. result = true - for i in countup(0, sonsLen(a) - 1): - result = sameTypeOrNilAux(a.sons[i], b.sons[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 @@ -906,65 +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}) - var b = skipTypes(y, {tyGenericInst, tyAlias}) + let aliasSkipSet = maybeSkipRange({tyAlias}) + var a = skipTypes(x, aliasSkipSet) + while a.kind == tyUserTypeClass and tfResolved in a.flags: + a = skipTypes(a.last, aliasSkipSet) + var b = skipTypes(y, aliasSkipSet) + while b.kind == tyUserTypeClass and tfResolved in b.flags: + 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.sons[0] - while b.kind == tyDistinct: b = b.sons[0] - if a.kind != b.kind: return false - of dcEqOrDistinctOf: - while a.kind == tyDistinct: a = a.sons[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 - 2: - let ff = rhs.sons[i] - let aa = lhs.sons[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, - tyInt..tyUInt64, tyStmt, tyExpr, tyVoid: + 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.sons[0], b.sons[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.sons[0], b.sons[0], c) + result = sameTypeAux(a.elementType, b.elementType, c) else: - result = sameTypeAux(a.sons[0], b.sons[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: @@ -976,15 +1336,23 @@ proc sameTypeAux(x, y: PType, c: var TSameTypeClosure): bool = result = sameChildrenAux(a, b, c) and sameFlags(a, b) if result and {ExactGenericParams, ExactTypeDescValues} * c.flags != {}: result = a.sym.position == b.sym.position - of tyGenericInvocation, tyGenericBody, tySequence, - tyOpenArray, tySet, tyRef, tyPtr, tyVar, tyLent, tySink, - tyArray, tyProc, tyVarargs, tyOrdinal, tyTypeClasses, tyOpt: + of tyBuiltInTypeClass: + 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: @@ -994,14 +1362,25 @@ 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.sons[0], b.sons[0], c) and - sameValue(a.n.sons[0], b.n.sons[0]) and - sameValue(a.n.sons[1], b.n.sons[1]) - of tyGenericInst, tyAlias, tyInferred: + 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 tyAlias, tyInferred, tyIterable: cycleCheck() - result = sameTypeAux(a.lastSon, b.lastSon, c) + result = sameTypeAux(a.skipModifier, b.skipModifier, c) + of tyGenericInst: + # BUG #23445 + # The type system must distinguish between `T[int] = object #[empty]#` + # and `T[float] = object #[empty]#`! + cycleCheck() + withoutShallowFlags: + for ff, aa in underspecifiedPairs(a, b, 1, -1): + if not sameTypeAux(ff, aa, c): return false + result = sameTypeAux(a.skipModifier, b.skipModifier, c) of tyNone: result = false - of tyUnused, tyOptAsRef: result = false + of tyConcept: + result = exprStructuralEquivalent(a.n, b.n) proc sameBackendType*(x, y: PType): bool = var c = initSameTypeClosure() @@ -1009,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 = @@ -1026,25 +1418,26 @@ proc inheritanceDiff*(a, b: PType): int = # | returns: +x iff `a` is the x'th direct subclass of `b` # | returns: `maxint` iff `a` and `b` are not compatible at all if a == b or a.kind == tyError or b.kind == tyError: return 0 - assert a.kind == tyObject - assert b.kind == tyObject + assert a.kind in {tyObject} + skipPtrs + assert b.kind in {tyObject} + skipPtrs var x = a result = 0 while x != nil: x = skipTypes(x, skipPtrs) if sameObjectTypes(x, b): return - x = x.sons[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.sons[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 @@ -1057,7 +1450,7 @@ proc commonSuperclass*(a, b: PType): PType = while x != nil: x = skipTypes(x, skipPtrs) ancestors.incl(x.id) - x = x.sons[0] + x = x.baseClass var y = b while y != nil: var t = y # bug #7818, save type before skip @@ -1066,326 +1459,29 @@ proc commonSuperclass*(a, b: PType): PType = # bug #7818, defer the previous skipTypes if t.kind != tyGenericInst: t = y return t - y = y.sons[0] - -type - TTypeAllowedFlag* = enum - taField, - taHeap, - taConcept - - TTypeAllowedFlags* = set[TTypeAllowedFlag] + y = y.baseClass -proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, - flags: TTypeAllowedFlags = {}): PType +proc lacksMTypeField*(typ: PType): bool {.inline.} = + (typ.sym != nil and sfPure in typ.sym.flags) or tfFinal in typ.flags -proc typeAllowedNode(marker: var IntSet, n: PNode, kind: TSymKind, - flags: TTypeAllowedFlags = {}): PType = - if n != nil: - result = typeAllowedAux(marker, n.typ, kind, flags) - #if not result: debug(n.typ) - if result == nil: - case n.kind - of nkNone..nkNilLit: - discard - else: - if n.kind == nkRecCase and kind in {skProc, skFunc, skConst}: - return n[0].typ - for i in countup(0, sonsLen(n) - 1): - let it = n.sons[i] - result = typeAllowedNode(marker, it, kind, flags) - if result != nil: break - -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.sonsLen or a.sons[i] == nil: return false - a = a.sons[i] - result = a.kind == last - -proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, - flags: TTypeAllowedFlags = {}): PType = - assert(kind in {skVar, skLet, skConst, skProc, skFunc, skParam, skResult}) - # if we have already checked the type, return true, because we stop the - # evaluation if something is wrong: - result = nil - if typ == nil: return - if containsOrIncl(marker, typ.id): return - var t = skipTypes(typ, abstractInst-{tyTypeDesc}) - case t.kind - of tyVar, tyLent: - if kind in {skProc, skFunc, skConst}: return t - var t2 = skipTypes(t.sons[0], abstractInst-{tyTypeDesc}) - case t2.kind - of tyVar, tyLent: - if taHeap notin flags: result = t2 # ``var var`` is illegal on the heap - of tyOpenArray: - if kind != skParam: result = t - else: result = typeAllowedAux(marker, t2, kind, flags) - else: - if kind notin {skParam, skResult}: result = t - else: result = typeAllowedAux(marker, t2, kind, flags) - of tyProc: - if kind == skConst and t.callConv == ccClosure: return t - for i in countup(1, sonsLen(t) - 1): - result = typeAllowedAux(marker, t.sons[i], skParam, flags) - if result != nil: break - if result.isNil and t.sons[0] != nil: - result = typeAllowedAux(marker, t.sons[0], skResult, flags) - of tyTypeDesc: - # XXX: This is still a horrible idea... - result = nil - of tyExpr, tyStmt, tyStatic: - if kind notin {skParam, skResult}: result = t - of tyVoid: - if taField 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, flags) - elif kind notin {skParam, skResult}: - result = t - of tyGenericBody, tyGenericParam, tyGenericInvocation, - tyNone, tyForward, tyFromExpr: - result = t - of tyNil: - if kind != skConst: result = t - 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, flags) - of tyRange: - if skipTypes(t.sons[0], abstractInst-{tyTypeDesc}).kind notin - {tyChar, tyEnum, tyInt..tyFloat128, tyUInt8..tyUInt32}: result = t - of tyOpenArray, tyVarargs, tySink: - if kind != skParam: result = t - else: result = typeAllowedAux(marker, t.sons[0], skVar, flags) - of tySequence, tyOpt: - if t.sons[0].kind != tyEmpty: - result = typeAllowedAux(marker, t.sons[0], skVar, flags+{taHeap}) - elif kind in {skVar, skLet}: - result = t.sons[0] - of tyArray: - if t.sons[1].kind != tyEmpty: - result = typeAllowedAux(marker, t.sons[1], skVar, flags) - elif kind in {skVar, skLet}: - result = t.sons[1] - of tyRef: - if kind == skConst: result = t - else: result = typeAllowedAux(marker, t.lastSon, skVar, flags+{taHeap}) - of tyPtr: - result = typeAllowedAux(marker, t.lastSon, skVar, flags+{taHeap}) - of tySet: - for i in countup(0, sonsLen(t) - 1): - result = typeAllowedAux(marker, t.sons[i], kind, flags) - if result != nil: break - of tyObject, tyTuple: - if kind in {skProc, skFunc, skConst} and - t.kind == tyObject and t.sons[0] != nil: return t - let flags = flags+{taField} - for i in countup(0, sonsLen(t) - 1): - result = typeAllowedAux(marker, t.sons[i], kind, flags) - if result != nil: break - if result.isNil and t.n != nil: - result = typeAllowedNode(marker, t.n, kind, flags) - of tyEmpty: - if kind in {skVar, skLet}: result = t - of tyProxy: - # for now same as error node; we say it's a valid type as it should - # prevent cascading errors: - result = nil - of tyUnused, tyOptAsRef: result = t - -proc typeAllowed*(t: PType, kind: TSymKind; flags: TTypeAllowedFlags = {}): PType = - # returns 'nil' on success and otherwise the part of the type that is - # wrong! - var marker = initIntSet() - result = typeAllowedAux(marker, t, kind, flags) - -proc align(address, alignment: BiggestInt): BiggestInt = - result = (address + (alignment - 1)) and not (alignment - 1) - -const - szNonConcreteType* = -3 - szIllegalRecursion* = -2 - szUnknownSize* = -1 - -proc computeSizeAux(conf: ConfigRef; typ: PType, a: var BiggestInt): BiggestInt -proc computeRecSizeAux(conf: ConfigRef; n: PNode, a, currOffset: var BiggestInt): BiggestInt = - var maxAlign, maxSize, b, res: BiggestInt - case n.kind - of nkRecCase: - assert(n.sons[0].kind == nkSym) - result = computeRecSizeAux(conf, n.sons[0], a, currOffset) - maxSize = 0 - maxAlign = 1 - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind - of nkOfBranch, nkElse: - res = computeRecSizeAux(conf, lastSon(n.sons[i]), b, currOffset) - if res < 0: return res - maxSize = max(maxSize, res) - maxAlign = max(maxAlign, b) - else: - return szIllegalRecursion - currOffset = align(currOffset, maxAlign) + maxSize - result = align(result, maxAlign) + maxSize - a = maxAlign - of nkRecList: - result = 0 - maxAlign = 1 - for i in countup(0, sonsLen(n) - 1): - res = computeRecSizeAux(conf, n.sons[i], b, currOffset) - if res < 0: return res - currOffset = align(currOffset, b) + res - result = align(result, b) + res - if b > maxAlign: maxAlign = b - a = maxAlign - of nkSym: - result = computeSizeAux(conf, n.sym.typ, a) - n.sym.offset = int(currOffset) - else: - a = 1 - result = szNonConcreteType - -proc computeSizeAux(conf: ConfigRef; typ: PType, a: var BiggestInt): BiggestInt = - var res, maxAlign, length, currOffset: BiggestInt - if typ.size == szIllegalRecursion: - # we are already computing the size of the type - # --> illegal recursion in type - return szIllegalRecursion - if typ.size >= 0: - # size already computed - result = typ.size - a = typ.align - return - typ.size = szIllegalRecursion # mark as being computed - case typ.kind - of tyInt, tyUInt: - result = conf.target.intSize - a = result - of tyInt8, tyUInt8, tyBool, tyChar: - result = 1 - a = result - of tyInt16, tyUInt16: - result = 2 - a = result - of tyInt32, tyUInt32, tyFloat32: - result = 4 - a = result - of tyInt64, tyUInt64, tyFloat64: - result = 8 - a = result - of tyFloat128: - result = 16 - a = result - of tyFloat: - result = conf.target.floatSize - a = result - of tyProc: - if typ.callConv == ccClosure: result = 2 * conf.target.ptrSize - else: result = conf.target.ptrSize - a = conf.target.ptrSize - of tyString, tyNil: - result = conf.target.ptrSize - a = result - of tyCString, tySequence, tyPtr, tyRef, tyVar, tyLent, tyOpenArray: - let base = typ.lastSon - if base == typ or (base.kind == tyTuple and base.size==szIllegalRecursion): - result = szIllegalRecursion - else: result = conf.target.ptrSize - a = result - of tyArray: - let elemSize = computeSizeAux(conf, typ.sons[1], a) - if elemSize < 0: return elemSize - result = lengthOrd(conf, typ.sons[0]) * elemSize - of tyEnum: - if firstOrd(conf, typ) < 0: - result = 4 # use signed int32 - else: - length = lastOrd(conf, typ) # BUGFIX: use lastOrd! - if length + 1 < `shl`(1, 8): result = 1 - elif length + 1 < `shl`(1, 16): result = 2 - elif length + 1 < `shl`(BiggestInt(1), 32): result = 4 - else: result = 8 - a = result - of tySet: - if typ.sons[0].kind == tyGenericParam: - result = szUnknownSize - else: - length = lengthOrd(conf, typ.sons[0]) - if length <= 8: result = 1 - elif length <= 16: result = 2 - elif length <= 32: result = 4 - elif length <= 64: result = 8 - elif align(length, 8) mod 8 == 0: result = align(length, 8) div 8 - else: result = align(length, 8) div 8 + 1 - a = result - of tyRange: - result = computeSizeAux(conf, typ.sons[0], a) - of tyTuple: - result = 0 - maxAlign = 1 - for i in countup(0, sonsLen(typ) - 1): - res = computeSizeAux(conf, typ.sons[i], a) - if res < 0: return res - maxAlign = max(maxAlign, a) - result = align(result, a) + res - result = align(result, maxAlign) - a = maxAlign - of tyObject: - if typ.sons[0] != nil: - result = computeSizeAux(conf, typ.sons[0].skipTypes(skipPtrs), a) - if result < 0: return - maxAlign = a - elif isObjectWithTypeFieldPredicate(typ): - result = conf.target.intSize - maxAlign = result - else: - result = 0 - maxAlign = 1 - currOffset = result - result = computeRecSizeAux(conf, typ.n, a, currOffset) - if result < 0: return - if a < maxAlign: a = maxAlign - result = align(result, a) - of tyInferred: - if typ.len > 1: - result = computeSizeAux(conf, typ.lastSon, a) - of tyGenericInst, tyDistinct, tyGenericBody, tyAlias: - result = computeSizeAux(conf, lastSon(typ), a) - of tyTypeClasses: - result = if typ.isResolvedUserTypeClass: computeSizeAux(conf, typ.lastSon, a) - else: szUnknownSize - of tyTypeDesc: - result = computeSizeAux(conf, typ.base, a) - of tyForward: return szIllegalRecursion - of tyStatic: - result = if typ.n != nil: computeSizeAux(conf, typ.lastSon, a) - else: szUnknownSize - else: - #internalError("computeSizeAux()") - result = szUnknownSize - typ.size = result - typ.align = int16(a) +include sizealignoffsetimpl proc computeSize*(conf: ConfigRef; typ: PType): BiggestInt = - var a: BiggestInt = 1 - result = computeSizeAux(conf, typ, a) + computeSizeAlign(conf, typ) + result = typ.size proc getReturnType*(s: PSym): PType = # Obtains the return type of a iterator/proc/macro/template assert s.kind in skProcKinds - result = s.typ.sons[0] + result = s.typ.returnType + +proc getAlign*(conf: ConfigRef; typ: PType): BiggestInt = + computeSizeAlign(conf, typ) + result = typ.align proc getSize*(conf: ConfigRef; typ: PType): BiggestInt = - result = computeSize(conf, typ) - if result < 0: internalError(conf, "getSize: " & $typ.kind) + computeSizeAlign(conf, typ) + result = typ.size proc containsGenericTypeIter(t: PType, closure: RootRef): bool = case t.kind @@ -1403,18 +1499,36 @@ proc containsGenericTypeIter(t: PType, closure: RootRef): bool = proc containsGenericType*(t: PType): bool = result = iterOverType(t, containsGenericTypeIter, nil) -proc baseOfDistinct*(t: PType): PType = +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.sons[0] + result = t.elementType else: - result = copyType(t, t.owner, false) + 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}: + while it.kind in {tyPtr, tyRef, tyOwned}: parent = it - it = it.lastSon + it = it.elementType if it.kind == tyDistinct and parent != nil: - parent.sons[0] = it.sons[0] + parent[0] = it[0] proc safeInheritanceDiff*(a, b: PType): int = # same as inheritanceDiff but checks for tyError: @@ -1433,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 @@ -1440,52 +1575,74 @@ 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 formal.n.sons[0].kind != nkEffectList or - actual.n.sons[0].kind != nkEffectList: + #if tfEffectSystemWorkaround in actual.flags: + # return efCompat + + if formal.n[0].kind != nkEffectList or + actual.n[0].kind != nkEffectList: return efTagsUnknown - var spec = formal.n.sons[0] + var spec = formal.n[0] if spec.len != 0: - var real = actual.n.sons[0] + var real = actual.n[0] - let se = spec.sons[exceptionEffects] + let se = spec[exceptionEffects] # if 'se.kind == nkArgList' it is no formal type really, but a # computed effect and as such no spec: # 'r.msgHandler = if isNil(msgHandler): defaultMsgHandler else: msgHandler' 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.sons[exceptionEffects]) + let res = compatibleExceptions(se, real[exceptionEffects]) if not res: return efRaisesDiffer - let st = spec.sons[tagEffects] + let st = spec[tagEffects] if not isNil(st) and st.kind != nkArgList: # spec requires some exception or tag, but we don't know anything: if real.len == 0: return efTagsUnknown - let res = compatibleEffectsAux(st, real.sons[tagEffects]) - if not res: return efTagsDiffer - if formal.lockLevel.ord < 0 or - actual.lockLevel.ord <= formal.lockLevel.ord: - result = efCompat - else: - result = efLockLevelsDiffer + let res = compatibleEffectsAux(st, real[tagEffects]) + 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 - if t.sons != nil: - for i in 0 ..< t.sonsLen: - if t.sons[i] != nil and isCompileTimeOnly(t.sons[i]): - return true + for a in t.kids: + if a != nil and isCompileTimeOnly(a): + return true return false +proc safeSkipTypes*(t: PType, kinds: TTypeKinds): PType = + ## same as 'skipTypes' but with a simple cycle detector. + result = t + var seen = initIntSet() + while result.kind in kinds and not containsOrIncl(seen, result.id): + result = skipModifier(result) + type OrdinalType* = enum NoneLike, IntLike, FloatLike @@ -1507,11 +1664,11 @@ proc skipConv*(n: PNode): PNode = of nkObjUpConv, nkObjDownConv, nkChckRange, nkChckRangeF, nkChckRange64: # only skip the conversion if it doesn't lose too important information # (see bug #1334) - if n.sons[0].typ.classify == n.typ.classify: - result = n.sons[0] + if n[0].typ.classify == n.typ.classify: + result = n[0] of nkHiddenStdConv, nkHiddenSubConv, nkConv: - if n.sons[1].typ.classify == n.typ.classify: - result = n.sons[1] + if n[1].typ.classify == n.typ.classify: + result = n[1] else: discard proc skipHidden*(n: PNode): PNode = @@ -1519,11 +1676,11 @@ proc skipHidden*(n: PNode): PNode = while true: case result.kind of nkHiddenStdConv, nkHiddenSubConv: - if result.sons[1].typ.classify == result.typ.classify: - result = result.sons[1] + if result[1].typ.classify == result.typ.classify: + result = result[1] else: break of nkHiddenDeref, nkHiddenAddr: - result = result.sons[0] + result = result[0] else: break proc skipConvTakeType*(n: PNode): PNode = @@ -1532,14 +1689,13 @@ proc skipConvTakeType*(n: PNode): PNode = proc isEmptyContainer*(t: PType): bool = case t.kind - of tyExpr, tyNil: result = true - of tyArray: result = t.sons[1].kind == tyEmpty - of tySet, tySequence, tyOpenArray, tyVarargs: - result = t.sons[0].kind == tyEmpty - of tyGenericInst, tyAlias: result = isEmptyContainer(t.lastSon) + of tyUntyped, tyNil: result = true + 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): PType = +proc takeType*(formal, arg: PType; g: ModuleGraph; idgen: IdGenerator): PType = # param: openArray[string] = [] # [] is an array constructor of length 0 of type string! if arg.kind == tyNil: @@ -1547,23 +1703,24 @@ proc takeType*(formal, arg: PType): PType = result = formal elif formal.kind in {tyOpenArray, tyVarargs, tySequence} and arg.isEmptyContainer: - let a = copyType(arg.skipTypes({tyGenericInst, tyAlias}), arg.owner, keepId=false) - a.sons[ord(arg.kind == tyArray)] = formal.sons[0] + 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 elif formal.kind in {tyTuple, tySet} and arg.kind == formal.kind: result = formal else: result = arg -proc skipHiddenSubConv*(n: PNode): PNode = +proc skipHiddenSubConv*(n: PNode; g: ModuleGraph; idgen: IdGenerator): PNode = if n.kind == nkHiddenSubConv: # param: openArray[string] = [] # [] is an array constructor of length 0 of type string! let formal = n.typ - result = n.sons[1] + result = n[1] let arg = result.typ - let dest = takeType(formal, arg) - if dest == arg and formal.kind != tyExpr: + let dest = takeType(formal, arg, g, idgen) + if dest == arg and formal.kind != tyUntyped: #echo n.info, " came here for ", formal.typeToString result = n else: @@ -1572,26 +1729,209 @@ proc skipHiddenSubConv*(n: PNode): PNode = else: result = n -proc typeMismatch*(conf: ConfigRef; info: TLineInfo, formal, actual: PType) = +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 named = typeToString(formal) + let actualStr = typeToString(actual) + let formalStr = typeToString(formal) let desc = typeToString(formal, preferDesc) - let x = if named == desc: named else: named & " = " & desc - var msg = "type mismatch: got <" & - typeToString(actual) & "> " & - "but expected '" & x & "'" - - 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" + let x = if formalStr == desc: formalStr else: formalStr & " = " & desc + let verbose = actualStr == formalStr or optDeclaredLocs in conf.globalOptions + var msg = "type mismatch:" + if verbose: msg.add "\n" + if conf.isDefined("nimLegacyTypeMismatch"): + msg.add " got <$1>" % actualStr + else: + msg.add " got '$1' for '$2'" % [actualStr, n.renderTree] + if verbose: + msg.addDeclaredLoc(conf, actual) + msg.add "\n" + msg.add " but expected '$1'" % x + if verbose: msg.addDeclaredLoc(conf, formal) + 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 = + if t == nil: + return false + if cycleDetector.containsOrIncl(t.id): + return true + case t.kind + of tyTuple: + result = false + var cycleDetectorCopy: IntSet + for a in t.kids: + cycleDetectorCopy = cycleDetector + if isTupleRecursive(a, cycleDetectorCopy): + return true + of tyRef, tyPtr, tyVar, tyLent, tySink, + tyArray, tyUncheckedArray, tySequence, tyDistinct: + return isTupleRecursive(t.elementType, cycleDetector) + of tyAlias, tyGenericInst: + return isTupleRecursive(t.skipModifier, cycleDetector) + else: + return false + +proc isTupleRecursive*(t: PType): bool = + var cycleDetector = initIntSet() + isTupleRecursive(t, cycleDetector) + +proc isException*(t: PType): bool = + # check if `y` is object type and it inherits from Exception + assert(t != nil) + + var t = t.skipTypes(abstractInst) + while t.kind == tyObject: + if t.sym != nil and t.sym.magic == mException: return true + if t.baseClass == nil: break + t = skipTypes(t.baseClass, abstractPtrs) + return false + +proc isDefectException*(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": + return true + 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 = + # a parameter like 'seq[owned T]' must not be used only once, but its + # elements must, so we detect this case here: + result = t.skipTypes({tyGenericInst, tyAlias}).kind in {tySink, tyOwned} + when false: + if isSinkType(t): + if t.skipTypes({tyGenericInst, tyAlias}).kind in {tyArray, tyVarargs, tyOpenArray, tySequence}: + 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 4d75d5d05..72bcddb05 100644 --- a/compiler/typesrenderer.nim +++ b/compiler/typesrenderer.nim @@ -7,10 +7,21 @@ # distribution, for details about the copyright. # -import renderer, strutils, ast, msgs, types, astalgo +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. ## @@ -19,7 +30,7 @@ proc renderPlainSymbolName*(n: PNode): string = ## for the HTML hyperlinks. case n.kind of nkPostfix, nkAccQuoted: - result = renderPlainSymbolName(n[n.len-1]) + result = renderPlainSymbolName(n[^1]) of nkIdent: result = n.ident.s of nkSym: @@ -29,86 +40,109 @@ proc renderPlainSymbolName*(n: PNode): string = else: result = "" #internalError(n.info, "renderPlainSymbolName() with " & $n.kind) - assert(not result.isNil) -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 len(n) != 1 - if len(n) > 1: + assert n.len != 1 + if n.len > 1 and n[0].kind == nkFormalParams: let params = n[0] - assert params.kind == nkFormalParams - assert len(params) > 0 + assert params.len > 0 result = "proc(" - for i in 1 ..< len(params): result.add(renderType(params[i]) & ',') - result[len(result)-1] = ')' + for i in 1..<params.len: result.add(renderType(params[i], toNormalize) & ',') + result[^1] = ')' else: result = "proc" of nkIdentDefs: - assert len(n) >= 3 - let typePos = len(n) - 2 - let typeStr = renderType(n[typePos]) + assert n.len >= 3 + let typePos = n.len - 2 + let typeStr = renderType(n[typePos], toNormalize) result = typeStr - for i in 1 ..< typePos: - assert n[i].kind == nkIdent + for i in 1..<typePos: + assert n[i].kind in {nkSym, nkIdent} result.add(',' & typeStr) of nkTupleTy: result = "tuple[" - for i in 0 ..< len(n): result.add(renderType(n[i]) & ',') - result[len(result)-1] = ']' + for i in 0..<n.len: result.add(renderType(n[i], toNormalize) & ',') + result[^1] = ']' of nkBracketExpr: - assert len(n) >= 2 - result = renderType(n[0]) & '[' - for i in 1 ..< len(n): result.add(renderType(n[i]) & ',') - result[len(result)-1] = ']' + assert n.len >= 2 + 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], toNormalize) + for i in 1..<n.len: + if i > 1: result.add ", " + result.add(renderType(n[i], toNormalize)) else: result = "" - assert(not result.isNil) -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 - ## function won't render types for parameters with default values. The `doc2` + ## function won't render types for parameters with default values. The `doc` ## generator does include the information. case n.kind of nkFormalParams: - for i in 1 ..< len(n): 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 = len(n) - 2 + 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 if not typ.isNil: typeStr = typeToString(typ, preferExported) if typeStr.len < 1: return - for i in 0 ..< typePos: + for i in 0..<typePos: found.add(typeStr) else: 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 @@ -117,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 new file mode 100644 index 000000000..1711fea46 --- /dev/null +++ b/compiler/varpartitions.nim @@ -0,0 +1,1019 @@ +# +# +# The Nim Compiler +# (c) Copyright 2020 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Partition variables into different graphs. Used for +## Nim's write tracking, borrow checking and also for the +## cursor inference. +## The algorithm is a reinvention / variation of Steensgaard's +## algorithm. +## The used data structure is "union find" with path compression. + +## We perform two passes over the AST: +## - Pass one (``computeLiveRanges``): collect livetimes of local +## variables and whether they are potentially re-assigned. +## - Pass two (``traverse``): combine local variables to abstract "graphs". +## Strict func checking: Ensure that graphs that are connected to +## const parameters are not mutated. +## Cursor inference: Ensure that potential cursors are not +## borrowed from locations that are connected to a graph +## that is mutated during the liveness of the cursor. +## (We track all possible mutations of a graph.) +## +## See https://nim-lang.github.io/Nim/manual_experimental.html#view-types-algorithm +## for a high-level description of how borrow checking works. + +import ast, types, lineinfos, options, msgs, renderer, typeallowed, modulegraphs +from trees import getMagic, isNoSideEffectPragma, stupidStmtListExpr +from isolation_check import canAlias + +when defined(nimPreviewSlimSystem): + import std/assertions + +type + AbstractTime = distinct int + +const + MaxTime = AbstractTime high(int) + MinTime = AbstractTime(-1) + +proc `<=`(a, b: AbstractTime): bool {.borrow.} +proc `<`(a, b: AbstractTime): bool {.borrow.} + +proc inc(x: var AbstractTime; diff = 1) {.borrow.} +proc dec(x: var AbstractTime; diff = 1) {.borrow.} + +proc `$`(x: AbstractTime): string {.borrow.} + +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 + ownsData, + preventCursor, + isReassigned, + isConditionallyReassigned, + viewDoesMutate, + viewBorrowsFromConst + + VarIndexKind = enum + isEmptyRoot, + dependsOn, + isRootOf + + Connection = object + case kind: VarIndexKind + of isEmptyRoot: discard + of dependsOn: parent: int + of isRootOf: graphIndex: int + + VarIndex = object + con: Connection + flags: set[VarFlag] + sym: PSym + reassignedTo: int + aliveStart, aliveEnd: AbstractTime # the range for which the variable is alive. + borrowsFrom: seq[int] # indexes into Partitions.s + + MutationInfo* = object + param: PSym + mutatedHere, connectedVia: TLineInfo + flags: set[SubgraphFlag] + maxMutation, minConnection: AbstractTime + mutations: seq[AbstractTime] + + Goal* = enum + constParameters, + borrowChecking, + cursorInference + + 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 + +proc mutationAfterConnection(g: MutationInfo): bool {.inline.} = + #echo g.maxMutation.int, " ", g.minConnection.int, " ", g.param + g.maxMutation > g.minConnection + +proc `$`*(config: ConfigRef; g: MutationInfo): string = + result = "" + if g.flags * {isMutated, connectsConstParam} == {isMutated, connectsConstParam}: + result.add "\nan object reachable from '" + result.add g.param.name.s + result.add "' is potentially mutated" + if g.mutatedHere != unknownLineInfo: + result.add "\n" + result.add config $ g.mutatedHere + result.add " the mutation is here" + if g.connectedVia != unknownLineInfo: + result.add "\n" + result.add config $ g.connectedVia + result.add " is the statement that connected the mutation to the parameter" + +proc hasSideEffect*(c: var Partitions; info: var MutationInfo): bool = + for g in mitems c.graphs: + if g.flags * {isMutated, connectsConstParam} == {isMutated, connectsConstParam} and + (mutationAfterConnection(g) or isMutatedDirectly in g.flags): + info = g + return true + return false + +template isConstParam(a): bool = a.kind == skParam and a.typ.kind notin {tyVar, tySink} + +proc variableId(c: Partitions; x: PSym): int = + for i in 0 ..< c.s.len: + if c.s[i].sym == x: return i + return -1 + +proc registerResult(c: var Partitions; n: PNode) = + if n.kind == nkSym: + c.s.add VarIndex(con: Connection(kind: isEmptyRoot), sym: n.sym, reassignedTo: 0, + aliveStart: MaxTime, aliveEnd: c.abstractTime) + +proc registerParam(c: var Partitions; n: PNode) = + assert n.kind == nkSym + if isConstParam(n.sym): + c.s.add VarIndex(con: Connection(kind: isRootOf, graphIndex: c.graphs.len), + sym: n.sym, reassignedTo: 0, + aliveStart: c.abstractTime, aliveEnd: c.abstractTime) + c.graphs.add MutationInfo(param: n.sym, mutatedHere: unknownLineInfo, + connectedVia: unknownLineInfo, flags: {connectsConstParam}, + maxMutation: MinTime, minConnection: MaxTime, + mutations: @[]) + else: + c.s.add VarIndex(con: Connection(kind: isEmptyRoot), sym: n.sym, reassignedTo: 0, + aliveStart: c.abstractTime, aliveEnd: c.abstractTime) + +proc registerVariable(c: var Partitions; n: PNode) = + if n.kind == nkSym and variableId(c, n.sym) < 0: + c.s.add VarIndex(con: Connection(kind: isEmptyRoot), sym: n.sym, reassignedTo: 0, + aliveStart: c.abstractTime, aliveEnd: c.abstractTime) + +proc root(v: var Partitions; start: int): int = + result = start + var depth = 0 + while v.s[result].con.kind == dependsOn: + result = v.s[result].con.parent + inc depth + if depth > 0: + # path compression: + var it = start + while v.s[it].con.kind == dependsOn: + let next = v.s[it].con.parent + v.s[it].con = Connection(kind: dependsOn, parent: result) + it = next + +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: + 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} + + case v.s[r].con.kind + of isEmptyRoot: + v.s[r].con = Connection(kind: isRootOf, graphIndex: v.graphs.len) + v.graphs.add MutationInfo(param: if isConstParam(s): s else: nil, mutatedHere: info, + connectedVia: unknownLineInfo, flags: flags, + maxMutation: v.abstractTime, minConnection: MaxTime, + mutations: @[v.abstractTime]) + of isRootOf: + let g = addr v.graphs[v.s[r].con.graphIndex] + if g.param == nil and isConstParam(s): + g.param = s + if v.abstractTime > g.maxMutation: + g.mutatedHere = info + g.maxMutation = v.abstractTime + g.flags.incl flags + g.mutations.add v.abstractTime + else: + assert false, "cannot happen" + else: + v.unanalysableMutation = true + +proc connect(v: var Partitions; a, b: PSym; info: TLineInfo) = + let aid = variableId(v, a) + if aid < 0: + return + let bid = variableId(v, b) + if bid < 0: + return + + let ra = root(v, aid) + let rb = root(v, bid) + if ra != rb: + var param = PSym(nil) + if isConstParam(a): param = a + elif isConstParam(b): param = b + + let paramFlags = + if param != nil: + {connectsConstParam} + else: + {} + + # for now we always make 'rb' the slave and 'ra' the master: + var rbFlags: set[SubgraphFlag] = {} + var mutatedHere = unknownLineInfo + var mut = AbstractTime 0 + var con = v.abstractTime + var gb: ptr MutationInfo = nil + if v.s[rb].con.kind == isRootOf: + gb = addr v.graphs[v.s[rb].con.graphIndex] + if param == nil: param = gb.param + mutatedHere = gb.mutatedHere + rbFlags = gb.flags + mut = gb.maxMutation + con = min(con, gb.minConnection) + + v.s[rb].con = Connection(kind: dependsOn, parent: ra) + case v.s[ra].con.kind + of isEmptyRoot: + v.s[ra].con = Connection(kind: isRootOf, graphIndex: v.graphs.len) + v.graphs.add MutationInfo(param: param, mutatedHere: mutatedHere, + connectedVia: info, flags: paramFlags + rbFlags, + maxMutation: mut, minConnection: con, + mutations: if gb != nil: gb.mutations else: @[]) + of isRootOf: + var g = addr v.graphs[v.s[ra].con.graphIndex] + if g.param == nil: g.param = param + if g.mutatedHere == unknownLineInfo: g.mutatedHere = mutatedHere + g.minConnection = min(g.minConnection, con) + g.connectedVia = info + g.flags.incl paramFlags + rbFlags + if gb != nil: + g.mutations.add gb.mutations + else: + assert false, "cannot happen" + +proc borrowFromConstExpr(n: PNode): bool = + case n.kind + of nkCharLit..nkNilLit: + result = true + of nkExprEqExpr, nkExprColonExpr, nkHiddenStdConv, nkHiddenSubConv, + nkCast, nkObjUpConv, nkObjDownConv: + result = borrowFromConstExpr(n.lastSon) + of nkCurly, nkBracket, nkPar, nkTupleConstr, nkObjConstr, nkClosure, nkRange: + result = true + for i in ord(n.kind == nkObjConstr)..<n.len: + if not borrowFromConstExpr(n[i]): return false + of nkCallKinds: + if getMagic(n) == mArrToSeq: + result = true + for i in 1..<n.len: + if not borrowFromConstExpr(n[i]): return false + else: + result = false + else: result = false + +proc pathExpr(node: PNode; owner: PSym): PNode = + #[ From the spec: + + - ``source`` itself is a path expression. + - Container access like ``e[i]`` is a path expression. + - Tuple access ``e[0]`` is a path expression. + - Object field access ``e.field`` is a path expression. + - ``system.toOpenArray(e, ...)`` is a path expression. + - Pointer dereference ``e[]`` is a path expression. + - An address ``addr e``, ``unsafeAddr e`` is a path expression. + - A type conversion ``T(e)`` is a path expression. + - A cast expression ``cast[T](e)`` is a path expression. + - ``f(e, ...)`` is a path expression if ``f``'s return type is a view type. + Because the view can only have been borrowed from ``e``, we then know + that owner of ``f(e, ...)`` is ``e``. + + Returns the owner of the path expression. Returns ``nil`` + if it is not a valid path expression. + ]# + var n = node + result = nil + while true: + case n.kind + of nkSym: + case n.sym.kind + of skParam, skTemp, skResult, skForVar: + if n.sym.owner == owner: result = n + of skVar: + if n.sym.owner == owner or sfThread in n.sym.flags: result = n + of skLet, skConst: + if n.sym.owner == owner or {sfThread, sfGlobal} * n.sym.flags != {}: + result = n + else: + discard + break + of nkDotExpr, nkDerefExpr, nkBracketExpr, nkHiddenDeref, + nkCheckedFieldExpr, nkAddr, nkHiddenAddr: + n = n[0] + of nkHiddenStdConv, nkHiddenSubConv, nkConv, nkCast, + nkObjUpConv, nkObjDownConv: + n = n.lastSon + of nkStmtList, nkStmtListExpr: + if n.len > 0 and stupidStmtListExpr(n): + n = n.lastSon + else: + break + of nkCallKinds: + if n.len > 1: + if (n.typ != nil and classifyViewType(n.typ) != noView) or getMagic(n) == mSlice: + n = n[1] + else: + break + else: + break + else: + break + # borrowFromConstExpr(n) is correct here because we need 'node' + # stripped off the path suffixes: + if result == nil and borrowFromConstExpr(n): + result = n + +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, level)) + + 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, level) + of nkCaseStmt, nkObjConstr: + for i in 1..<n.len: + allRoots(n[i].lastSon, result, level) + of nkIfStmt, nkIfExpr: + for i in 0..<n.len: + allRoots(n[i].lastSon, result, level) + of nkBracket, nkTupleConstr, nkPar: + for i in 0..<n.len: + allRoots(n[i], result, level-1) + + of nkCallKinds: + if n.typ != nil and n.typ.kind in {tyVar, tyLent}: + if n.len > 1: + # 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 + of mNone: + if n[0].typ.isNil: return + var typ = n[0].typ + if typ != nil: + typ = skipTypes(typ, abstractInst) + if typ.kind != tyProc: typ = nil + + for i in 1 ..< n.len: + let it = n[i] + 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.returnType.isEmptyType and + canAlias(paramType, typ.returnType): + allRoots(it, result, RootEscapes) + else: + allRoots(it, result, RootEscapes) + + of mSlice: + allRoots(n[1], result, level+1) + else: + discard "harmless operation" + else: + discard "nothing to do" + +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'. + case n.kind + of nkEmpty, nkCharLit..nkNilLit: + # primitive literals including the empty are harmless: + discard + + 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: + destMightOwn(c, dest, n[^1]) + + of nkClosure: + for i in 1..<n.len: + destMightOwn(c, dest, n[i]) + # you must destroy a closure: + dest.flags.incl ownsData + + of nkObjConstr: + for i in 1..<n.len: + destMightOwn(c, dest, n[i]) + if hasDestructor(n.typ): + # you must destroy a ref object: + dest.flags.incl ownsData + + of nkCurly, nkBracket, nkPar, nkTupleConstr: + inc c.inConstructor + for son in n: + destMightOwn(c, dest, son) + dec c.inConstructor + if n.typ.skipTypes(abstractInst).kind == tySequence: + # you must destroy a sequence: + dest.flags.incl ownsData + + of nkSym: + if n.sym.kind in {skVar, skResult, skTemp, skLet, skForVar, skParam}: + if n.sym.flags * {sfThread, sfGlobal} != {}: + # aliasing a global is inherently dangerous: + dest.flags.incl ownsData + else: + # otherwise it's just a dependency, nothing to worry about: + connect(c, dest.sym, n.sym, n.info) + # but a construct like ``[symbol]`` is dangerous: + if c.inConstructor > 0: dest.flags.incl ownsData + + of nkDotExpr, nkBracketExpr, nkHiddenDeref, nkDerefExpr, + nkObjUpConv, nkObjDownConv, nkCheckedFieldExpr, nkAddr, nkHiddenAddr: + destMightOwn(c, dest, n[0]) + + of nkCallKinds: + 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, 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: + dest.flags.incl preventCursor + +proc noCursor(c: var Partitions, s: PSym) = + let vid = variableId(c, s) + if vid >= 0: + c.s[vid].flags.incl preventCursor + +proc pretendOwnsData(c: var Partitions, s: PSym) = + let vid = variableId(c, s) + if vid >= 0: + c.s[vid].flags.incl ownsData + +const + explainCursors = false + +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.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: + localError(c.g.config, src.info, "'result' must borrow from the first parameter") + + let vid = variableId(c, dest) + if vid >= 0: + var sourceIdx = variableId(c, s.sym) + if sourceIdx < 0: + sourceIdx = c.s.len + c.s.add VarIndex(con: Connection(kind: isEmptyRoot), sym: s.sym, reassignedTo: 0, + aliveStart: MinTime, aliveEnd: MaxTime) + + c.s[vid].borrowsFrom.add sourceIdx + if isConstSym(s.sym): + c.s[vid].flags.incl viewBorrowsFromConst + else: + let vid = variableId(c, dest) + if vid >= 0: + c.s[vid].flags.incl viewBorrowsFromConst + #discard "a valid borrow location that is a deeply constant expression so we have nothing to track" + + +proc borrowingCall(c: var Partitions; destType: PType; n: PNode; i: int) = + let v = pathExpr(n[i], c.owner) + if v != nil and v.kind == nkSym: + when false: + let isView = directViewType(destType) == immutableView + if n[0].kind == nkSym and n[0].sym.name.s == "[]=": + localError(c.g.config, n[i].info, "attempt to mutate an immutable view") + + for j in i+1..<n.len: + if getMagic(n[j]) == mSlice: + borrowFrom(c, v.sym, n[j]) + else: + localError(c.g.config, n[i].info, "cannot determine the target of the borrow") + +proc borrowingAsgn(c: var Partitions; dest, src: PNode) = + proc mutableParameter(n: PNode): bool {.inline.} = + result = n.kind == nkSym and n.sym.kind == skParam and n.sym.typ.kind == tyVar + + if dest.kind == nkSym: + if directViewType(dest.typ) != noView: + borrowFrom(c, dest.sym, src) + 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" + else: + localError(c.g.config, dest.info, "attempt to mutate a borrowed location from an immutable view") + ]# + else: + discard "nothing to do" + +proc containsPointer(t: PType): bool = + proc wrap(t: PType): bool {.nimcall.} = t.kind in {tyRef, tyPtr} + result = types.searchTypeFor(t, wrap) + +proc deps(c: var Partitions; dest, src: PNode) = + if borrowChecking in c.goals: + borrowingAsgn(c, dest, src) + + 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[0], t[1], dest.info) + + if destIsComplex: + for s in sources: + connect(c, t[0], s[0], dest.info) + + if cursorInference in c.goals and src.kind != nkEmpty: + let d = pathExpr(dest, c.owner) + if d != nil and d.kind == nkSym: + let vid = variableId(c, d.sym) + if vid >= 0: + destMightOwn(c, c.s[vid], src) + 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): + # do not borrow from a global variable or from something with a + # disabled assignment operator. + c.s[vid].flags.incl preventCursor + when explainCursors: echo "A not a cursor: ", d.sym, " ", s + else: + let srcid = variableId(c, s) + if srcid >= 0: + if s.kind notin {skResult, skParam} and ( + c.s[srcid].aliveEnd < c.s[vid].aliveEnd): + # you cannot borrow from a local that lives shorter than 'vid': + when explainCursors: echo "B not a cursor ", d.sym, " ", c.s[srcid].aliveEnd, " ", c.s[vid].aliveEnd + c.s[vid].flags.incl preventCursor + elif {isReassigned, preventCursor} * c.s[srcid].flags != {}: + # you cannot borrow from something that is re-assigned: + when explainCursors: echo "C not a cursor ", d.sym, " ", c.s[srcid].flags, " reassignedTo ", c.s[srcid].reassignedTo + c.s[vid].flags.incl preventCursor + elif c.s[srcid].reassignedTo != 0 and c.s[srcid].reassignedTo != d.sym.id: + when explainCursors: echo "D not a cursor ", d.sym, " reassignedTo ", c.s[srcid].reassignedTo + c.s[vid].flags.incl preventCursor + + +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, 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 + case n.kind + of nkLetSection, nkVarSection: + for child in n: + let last = lastSon(child) + traverse(c, last) + if child.kind == nkVarTuple and last.kind in {nkPar, nkTupleConstr}: + if child.len-2 != last.len: return + for i in 0..<child.len-2: + #registerVariable(c, child[i]) + deps(c, child[i], last[i]) + else: + for i in 0..<child.len-2: + #registerVariable(c, child[i]) + deps(c, child[i], last) + of nkAsgn, nkFastAsgn, nkSinkAsgn: + traverse(c, n[0]) + inc c.inAsgnSource + traverse(c, n[1]) + dec c.inAsgnSource + deps(c, n[0], n[1]) + of nkSym: + dec c.abstractTime + + of nodesToIgnoreSet: + dec c.abstractTime + discard "do not follow the construct" + of nkCallKinds: + for child in n: traverse(c, child) + + let parameters = n[0].typ + 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, int)] = @[] + allRoots(it, roots, RootEscapes) + if paramType.kind == tyVar: + if c.inNoSideEffectSection == 0: + 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 + # operation. We know 'paramType' is a tyVar and we really care if + # '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 m == mNone: + potentialMutationViaArg(c, n[i], parameters) + + of nkAddr, nkHiddenAddr: + traverse(c, n[0]) + when false: + # XXX investigate if this is required, it doesn't look + # like it is! + var roots: seq[(PSym, int)] + allRoots(n[0], roots, RootEscapes) + for r in roots: + potentialMutation(c, r[0], r[1], it.info) + + of nkTupleConstr, nkBracket: + for child in n: traverse(c, child) + if c.inAsgnSource > 0: + for i in 0..<n.len: + if n[i].kind == nkSym: + # we assume constructions with cursors are better without + # the cursors because it's likely we can move then, see + # test arc/topt_no_cursor.nim + pretendOwnsData(c, n[i].sym) + + of nkObjConstr: + for child in n: traverse(c, child) + if c.inAsgnSource > 0: + for i in 1..<n.len: + let it = n[i].skipColon + if it.kind == nkSym: + # we assume constructions with cursors are better without + # the cursors because it's likely we can move then, see + # test arc/topt_no_cursor.nim + pretendOwnsData(c, it.sym) + + of nkPragmaBlock: + let pragmaList = n[0] + var enforceNoSideEffects = 0 + for i in 0..<pragmaList.len: + if isNoSideEffectPragma(pragmaList[i]): + enforceNoSideEffects = 1 + break + + inc c.inNoSideEffectSection, enforceNoSideEffects + traverse(c, n.lastSon) + dec c.inNoSideEffectSection, enforceNoSideEffects + of nkWhileStmt, nkForStmt, nkParForStmt: + for child in n: traverse(c, child) + # analyse loops twice so that 'abstractTime' suffices to detect cases + # like: + # while cond: + # 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) + +proc markAsReassigned(c: var Partitions; vid: int) {.inline.} = + c.s[vid].flags.incl isReassigned + if c.inConditional > 0 and c.inLoop > 0: + # bug #17033: live ranges with loops and conditionals are too + # complex for our current analysis, so we prevent the cursorfication. + c.s[vid].flags.incl isConditionallyReassigned + +proc computeLiveRanges(c: var Partitions; n: PNode) = + # first pass: Compute live ranges for locals. + # **Watch out!** We must traverse the tree like 'traverse' does + # so that the 'c.abstractTime' is consistent. + inc c.abstractTime + case n.kind + of nkLetSection, nkVarSection: + for child in n: + let last = lastSon(child) + computeLiveRanges(c, last) + if child.kind == nkVarTuple and last.kind in {nkPar, nkTupleConstr}: + if child.len-2 != last.len: return + for i in 0..<child.len-2: + registerVariable(c, child[i]) + #deps(c, child[i], last[i]) + else: + for i in 0..<child.len-2: + registerVariable(c, child[i]) + #deps(c, child[i], last) + + 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: + let vid = variableId(c, n[0].sym) + 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) + + of nkSym: + dec c.abstractTime + if n.sym.kind in {skVar, skResult, skTemp, skLet, skForVar, skParam}: + let id = variableId(c, n.sym) + if id >= 0: + c.s[id].aliveEnd = max(c.s[id].aliveEnd, c.abstractTime) + if n.sym.kind == skResult: + c.s[id].aliveStart = min(c.s[id].aliveStart, c.abstractTime) + + of nodesToIgnoreSet: + dec c.abstractTime + discard "do not follow the construct" + of nkCallKinds: + for child in n: computeLiveRanges(c, child) + + let parameters = n[0].typ + let L = if parameters != nil: parameters.signatureLen else: 0 + + for i in 1..<n.len: + let it = n[i] + if it.kind == nkSym and i < L: + let paramType = parameters[i].skipTypes({tyGenericInst, tyAlias}) + if not paramType.isCompileTimeOnly and paramType.kind == tyVar: + let vid = variableId(c, it.sym) + if vid >= 0: + markAsReassigned(c, vid) + + of nkAddr, nkHiddenAddr: + computeLiveRanges(c, n[0]) + if n[0].kind == nkSym: + let vid = variableId(c, n[0].sym) + if vid >= 0: + c.s[vid].flags.incl preventCursor + + of nkPragmaBlock: + computeLiveRanges(c, n.lastSon) + of nkWhileStmt, nkForStmt, nkParForStmt: + for child in n: computeLiveRanges(c, child) + # analyse loops twice so that 'abstractTime' suffices to detect cases + # like: + # while cond: + # mutate(graph) + # connect(graph, cursorVar) + inc c.inLoop + for child in n: computeLiveRanges(c, child) + 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) + +proc computeGraphPartitions*(s: PSym; n: PNode; g: ModuleGraph; goals: set[Goal]): Partitions = + result = Partitions(owner: s, g: g, goals: goals) + if s.kind notin {skModule, skMacro}: + let params = s.typ.n + for i in 1..<params.len: + registerParam(result, params[i]) + if resultPos < s.ast.safeLen: + 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, isMutatedByVarParam} * g.flags != {}: + for m in g.mutations: + #echo "mutation ", m + if m in v.aliveStart..v.aliveEnd: + return true + return false + +proc cannotBorrow(config: ConfigRef; s: PSym; g: MutationInfo) = + var m = "cannot borrow " & s.name.s & + "; what it borrows from is potentially mutated" + + if g.mutatedHere != unknownLineInfo: + m.add "\n" + m.add config $ g.mutatedHere + m.add " the mutation is here" + if g.connectedVia != unknownLineInfo: + m.add "\n" + m.add config $ g.connectedVia + m.add " is the statement that connected the mutation to the parameter" + localError(config, s.info, m) + +proc checkBorrowedLocations*(par: var Partitions; body: PNode; config: ConfigRef) = + for i in 0 ..< par.s.len: + let v = par.s[i].sym + if v.kind != skParam and classifyViewType(v.typ) != noView: + let rid = root(par, i) + if rid >= 0: + var constViolation = false + for b in par.s[rid].borrowsFrom: + let sid = root(par, b) + if sid >= 0: + if par.s[sid].con.kind == isRootOf and dangerousMutation(par.graphs[par.s[sid].con.graphIndex], par.s[i]): + cannotBorrow(config, v, par.graphs[par.s[sid].con.graphIndex]) + if par.s[sid].sym.kind != skParam and par.s[sid].aliveEnd < par.s[rid].aliveEnd: + localError(config, v.info, "'" & v.name.s & "' borrows from location '" & par.s[sid].sym.name.s & + "' which does not live long enough") + if viewDoesMutate in par.s[rid].flags and isConstSym(par.s[sid].sym): + localError(config, v.info, "'" & v.name.s & "' borrows from the immutable location '" & + par.s[sid].sym.name.s & "' and attempts to mutate it") + constViolation = true + if {viewDoesMutate, viewBorrowsFromConst} * par.s[rid].flags == {viewDoesMutate, viewBorrowsFromConst} and + not constViolation: + # we do not track the constant expressions we allow to borrow from so + # we can only produce a more generic error message: + localError(config, v.info, "'" & v.name.s & + "' borrows from an immutable location and attempts to mutate it") + + #if par.s[rid].con.kind == isRootOf and dangerousMutation(par.graphs[par.s[rid].con.graphIndex], par.s[i]): + # cannotBorrow(config, s, par.graphs[par.s[rid].con.graphIndex]) + +proc computeCursors*(s: PSym; n: PNode; g: ModuleGraph) = + var par = computeGraphPartitions(s, n, g, {cursorInference}) + for i in 0 ..< par.s.len: + let v = addr(par.s[i]) + 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 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 + 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 3e33e8256..161b025a6 100644 --- a/compiler/vm.nim +++ b/compiler/vm.nim @@ -10,48 +10,27 @@ ## This file implements the new evaluation engine for Nim code. ## An instruction is 1-3 int32s in memory, it is a register based VM. -const - debugEchoCode = false - traceCode = debugEchoCode - -import ast except getstr - +import semmacrosanity import - strutils, astalgo, 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 -from modulegraphs import ModuleGraph +const + traceCode = defined(nimVMDebug) when hasFFI: import evalffi -type - TRegisterKind = enum - rkNone, rkNode, rkInt, rkFloat, rkRegisterAddr, rkNodeAddr - TFullReg = object # with a custom mark proc, we could use the same - # data representation as LuaJit (tagged NaNs). - case kind: TRegisterKind - of rkNone: nil - of rkInt: intVal: BiggestInt - of rkFloat: floatVal: BiggestFloat - of rkNode: node: PNode - of rkRegisterAddr: regAddr: ptr TFullReg - of rkNodeAddr: nodeAddr: ptr PNode - - PStackFrame* = ref TStackFrame - TStackFrame* = object - prc: PSym # current prc; proc that is evaluated - slots: seq[TFullReg] # parameters passed to the proc + locals; - # parameters come first - next: PStackFrame # for stacking - comesFrom: int - safePoints: seq[int] # used for exception handling - # XXX 'break' should perform cleanup actions - # What does the C backend do for it? proc stackTraceAux(c: PCtx; x: PStackFrame; pc: int; recursionLimit=100) = if x != nil: @@ -61,47 +40,62 @@ 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] - # we now use the same format as in system/except.nim - var s = substr(toFilename(c.config, info), 0) - # this 'substr' prevents a strange corruption. XXX This needs to be - # investigated eventually but first attempts to fix it broke everything - # see the araq-wip-fixed-writebarrier branch. + # we now use a format similar to the one in lib/system/excpt.nim + var s = "" + # todo: factor with quotedFilename + if optExcessiveStackTrace in c.config.globalOptions: + s = toFullPath(c.config, info) + else: + s = toFilename(c.config, info) var line = toLinenumber(info) + var col = toColumn(info) if line > 0: - add(s, '(') - add(s, $line) - add(s, ')') + s.add('(') + s.add($line) + s.add(", ") + s.add($(col + ColOffset)) + s.add(')') if x.prc != nil: - for k in 1..max(1, 25-s.len): add(s, ' ') - add(s, x.prc.name.s) - msgWriteln(c.config, s) - -proc stackTrace(c: PCtx, tos: PStackFrame, pc: int, - msg: string, n: PNode = nil) = - msgWriteln(c.config, "stack trace: (most recent call last)") + for k in 1..max(1, 25-s.len): s.add(' ') + s.add(x.prc.name.s) + msgWriteln(c.config, s, {msgNoUnitSep}) + +proc stackTraceImpl(c: PCtx, tos: PStackFrame, pc: int, + msg: string, lineInfo: TLineInfo, infoOrigin: InstantiationInfo) {.noinline.} = + # noinline to avoid code bloat + msgWriteln(c.config, "stack trace: (most recent call last)", {msgNoUnitSep}) stackTraceAux(c, tos, pc) - # XXX test if we want 'globalError' for every mode - let lineInfo = if n == nil: c.debug[pc] else: n.info - if c.mode == emRepl: globalError(c.config, lineInfo, msg) - else: localError(c.config, lineInfo, msg) + 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) {.callsite.} = + stackTraceImpl(c, tos, pc, msg, lineInfo, instantiationInfo(-2, fullPaths = true)) + return proc bailOut(c: PCtx; tos: PStackFrame) = stackTrace(c, tos, c.exceptionInstr, "unhandled exception: " & - c.currentExceptionA.sons[3].skipColon.strVal) + c.currentExceptionA[3].skipColon.strVal & + " [" & c.currentExceptionA[2].skipColon.strVal & "]") when not defined(nimComputedGoto): {.pragma: computedGoto.} -proc myreset(n: var TFullReg) = reset(n) +proc ensureKind(n: var TFullReg, k: TRegisterKind) {.inline.} = + if n.kind != k: + n = TFullReg(kind: k) template ensureKind(k: untyped) {.dirty.} = - if regs[ra].kind != k: - myreset(regs[ra]) - regs[ra].kind = k + ensureKind(regs[ra], k) template decodeB(k: untyped) {.dirty.} = let rb = instr.regB @@ -125,8 +119,44 @@ 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, typ, rkind) = + if isAssign: + cast[ptr typ](address)[] = typ(r.field) + else: + r.ensureKind(rkind) + let val = cast[ptr typ](address)[] + when typ is SomeInteger | char: + r.field = BiggestInt(val) + else: + r.field = val + return true + + ## see also typeinfo.getBiggestInt + case typ.kind + of tyChar: fun(intVal, char, rkInt) + of tyInt: fun(intVal, int, rkInt) + of tyInt8: fun(intVal, int8, rkInt) + of tyInt16: fun(intVal, int16, rkInt) + of tyInt32: fun(intVal, int32, rkInt) + of tyInt64: fun(intVal, int64, rkInt) + of tyUInt: fun(intVal, uint, rkInt) + of tyUInt8: fun(intVal, uint8, rkInt) + of tyUInt16: fun(intVal, uint16, rkInt) + of tyUInt32: fun(intVal, uint32, rkInt) + of tyUInt64: fun(intVal, uint64, rkInt) # note: differs from typeinfo.getBiggestInt + of tyFloat: fun(floatVal, float, rkFloat) + of tyFloat32: fun(floatVal, float32, rkFloat) + of tyFloat64: fun(floatVal, float64, rkFloat) + else: return false proc createStrKeepNode(x: var TFullReg; keepNode=true) = if x.node.isNil or not keepNode: @@ -134,8 +164,7 @@ proc createStrKeepNode(x: var TFullReg; keepNode=true) = elif x.node.kind == nkNilLit and keepNode: when defined(useNodeIds): let id = x.node.id - system.reset(x.node[]) - x.node.kind = nkStrLit + x.node[] = TNode(kind: nkStrLit) when defined(useNodeIds): x.node.id = id elif x.node.kind notin {nkStrLit..nkTripleStrLit} or @@ -144,7 +173,7 @@ proc createStrKeepNode(x: var TFullReg; keepNode=true) = x.node = newNode(nkStrLit) # It not only hackey, it is also wrong for tgentemplate. The primary # cause of bugs like these is that the VM does not properly distinguish - # between variable defintions (var foo = e) and variable updates (foo = e). + # between variable definitions (var foo = e) and variable updates (foo = e). include vmhooks @@ -155,9 +184,7 @@ template createSet(x) = x.node = newNode(nkCurly) proc moveConst(x: var TFullReg, y: TFullReg) = - if x.kind != y.kind: - myreset(x) - x.kind = y.kind + x.ensureKind(y.kind) case x.kind of rkNone: discard of rkInt: x.intVal = y.intVal @@ -188,14 +215,12 @@ proc copyValue(src: PNode): PNode = of nkIdent: result.ident = src.ident of nkStrLit..nkTripleStrLit: result.strVal = src.strVal else: - newSeq(result.sons, sonsLen(src)) - for i in countup(0, sonsLen(src) - 1): - result.sons[i] = copyValue(src.sons[i]) + newSeq(result.sons, src.len) + for i in 0..<src.len: + result[i] = copyValue(src[i]) proc asgnComplex(x: var TFullReg, y: TFullReg) = - if x.kind != y.kind: - myreset(x) - x.kind = y.kind + x.ensureKind(y.kind) case x.kind of rkNone: discard of rkInt: x.intVal = y.intVal @@ -204,38 +229,44 @@ proc asgnComplex(x: var TFullReg, y: TFullReg) = of rkRegisterAddr: x.regAddr = y.regAddr of rkNodeAddr: x.nodeAddr = y.nodeAddr -proc putIntoNode(n: var PNode; x: TFullReg) = +proc fastAsgnComplex(x: var TFullReg, y: TFullReg) = + x.ensureKind(y.kind) case x.kind of rkNone: discard - of rkInt: n.intVal = x.intVal + of rkInt: x.intVal = y.intVal + of rkFloat: x.floatVal = y.floatVal + of rkNode: x.node = y.node + of rkRegisterAddr: x.regAddr = y.regAddr + of rkNodeAddr: x.nodeAddr = y.nodeAddr + +proc writeField(n: var PNode, x: TFullReg) = + case x.kind + of rkNone: discard + of rkInt: + if n.kind == nkNilLit: + n[] = TNode(kind: nkIntLit) # ideally, `nkPtrLit` + n.intVal = x.intVal of rkFloat: n.floatVal = x.floatVal - of rkNode: - if nfIsRef in x.node.flags: - n = x.node - else: - let destIsRef = nfIsRef in n.flags - n[] = x.node[] - # Ref-ness must be kept for the destination - if destIsRef: - n.flags.incl nfIsRef - of rkRegisterAddr: putIntoNode(n, x.regAddr[]) - of rkNodeAddr: n[] = x.nodeAddr[][] + of rkNode: n = copyValue(x.node) + of rkRegisterAddr: writeField(n, x.regAddr[]) + of rkNodeAddr: n = x.nodeAddr[] proc putIntoReg(dest: var TFullReg; n: PNode) = case n.kind of nkStrLit..nkTripleStrLit: - dest.kind = rkNode - createStr(dest) - dest.node.strVal = n.strVal - of nkCharLit..nkUInt64Lit: - dest.kind = rkInt - dest.intVal = n.intVal + dest = TFullReg(kind: rkNode, node: newStrNode(nkStrLit, n.strVal)) + of nkIntLit: # use `nkPtrLit` once this is added + if dest.kind == rkNode: dest.node = n + elif n.typ != nil and n.typ.kind in PtrLikeKinds: + dest = TFullReg(kind: rkNode, node: n) + else: + dest = TFullReg(kind: rkInt, intVal: n.intVal) + of {nkCharLit..nkUInt64Lit} - {nkIntLit}: + dest = TFullReg(kind: rkInt, intVal: n.intVal) of nkFloatLit..nkFloat128Lit: - dest.kind = rkFloat - dest.floatVal = n.floatVal + dest = TFullReg(kind: rkFloat, floatVal: n.floatVal) else: - dest.kind = rkNode - dest.node = n + dest = TFullReg(kind: rkNode, node: n) proc regToNode(x: TFullReg): PNode = case x.kind @@ -250,87 +281,121 @@ template getstr(a: untyped): untyped = (if a.kind == rkNode: a.node.strVal else: $chr(int(a.intVal))) proc pushSafePoint(f: PStackFrame; pc: int) = - if f.safePoints.isNil: f.safePoints = @[] f.safePoints.add(pc) proc popSafePoint(f: PStackFrame) = - # XXX this needs a proper fix! - if f.safePoints.len > 0: - discard f.safePoints.pop() - -proc cleanUpOnException(c: PCtx; tos: PStackFrame): - tuple[pc: int, f: PStackFrame] = - let raisedType = c.currentExceptionA.typ.skipTypes(abstractPtrs) - var f = tos - while true: - while f.safePoints.isNil or f.safePoints.len == 0: - f = f.next - if f.isNil: return (-1, nil) - var pc2 = f.safePoints[f.safePoints.high] - - var nextExceptOrFinally = -1 - if c.code[pc2].opcode == opcExcept: - nextExceptOrFinally = pc2 + c.code[pc2].regBx - wordExcess - inc pc2 - while c.code[pc2].opcode == opcExcept: - let excIndex = c.code[pc2].regBx-wordExcess - let exceptType = if excIndex > 0: c.types[excIndex].skipTypes( - abstractPtrs) - else: nil - #echo typeToString(exceptType), " ", typeToString(raisedType) - if exceptType.isNil or inheritanceDiff(exceptType, raisedType) <= 0: - # mark exception as handled but keep it in B for - # the getCurrentException() builtin: - c.currentExceptionB = c.currentExceptionA - c.currentExceptionA = nil - # execute the corresponding handler: - while c.code[pc2].opcode == opcExcept: inc pc2 - discard f.safePoints.pop - return (pc2, f) - inc pc2 - if c.code[pc2].opcode != opcExcept and nextExceptOrFinally >= 0: - # we're at the end of the *except list*, but maybe there is another - # *except branch*? - pc2 = nextExceptOrFinally+1 - if c.code[pc2].opcode == opcExcept: - nextExceptOrFinally = pc2 + c.code[pc2].regBx - wordExcess - - if nextExceptOrFinally >= 0: - pc2 = nextExceptOrFinally - if c.code[pc2].opcode == opcFinally: - # execute the corresponding handler, but don't quit walking the stack: - discard f.safePoints.pop - return (pc2+1, f) - # not the right one: - discard f.safePoints.pop + discard f.safePoints.pop() + +type + ExceptionGoto = enum + ExceptionGotoHandler, + ExceptionGotoFinally, + ExceptionGotoUnhandled + +proc findExceptionHandler(c: PCtx, f: PStackFrame, exc: PNode): + tuple[why: ExceptionGoto, where: int] = + let raisedType = exc.typ.skipTypes(abstractPtrs) + + while f.safePoints.len > 0: + var pc = f.safePoints.pop() + + var matched = false + var pcEndExcept = pc + + # Scan the chain of exceptions starting at pc. + # The structure is the following: + # pc - opcExcept, <end of this block> + # - opcExcept, <pattern1> + # - opcExcept, <pattern2> + # ... + # - opcExcept, <patternN> + # - Exception handler body + # - ... more opcExcept blocks may follow + # - ... an optional opcFinally block may follow + # + # Note that the exception handler body already contains a jump to the + # finally block or, if that's not present, to the point where the execution + # should continue. + # Also note that opcFinally blocks are the last in the chain. + while c.code[pc].opcode == opcExcept: + # Where this Except block ends + pcEndExcept = pc + c.code[pc].regBx - wordExcess + inc pc + + # A series of opcExcept follows for each exception type matched + while c.code[pc].opcode == opcExcept: + let excIndex = c.code[pc].regBx - wordExcess + let exceptType = + if excIndex > 0: c.types[excIndex].skipTypes(abstractPtrs) + else: nil + + # echo typeToString(exceptType), " ", typeToString(raisedType) + + # Determine if the exception type matches the pattern + if exceptType.isNil or inheritanceDiff(raisedType, exceptType) <= 0: + matched = true + break + + inc pc + + # Skip any further ``except`` pattern and find the first instruction of + # the handler body + while c.code[pc].opcode == opcExcept: + inc pc + + if matched: + break + + # If no handler in this chain is able to catch this exception we check if + # the "parent" chains are able to. If this chain ends with a `finally` + # block we must execute it before continuing. + pc = pcEndExcept + + # Where the handler body starts + let pcBody = pc + + if matched: + return (ExceptionGotoHandler, pcBody) + elif c.code[pc].opcode == opcFinally: + # The +1 here is here because we don't want to execute it since we've + # already pop'd this statepoint from the stack. + return (ExceptionGotoFinally, pc + 1) + + return (ExceptionGotoUnhandled, 0) proc cleanUpOnReturn(c: PCtx; f: PStackFrame): int = - if f.safePoints.isNil: return -1 - for s in f.safePoints: - var pc = s + # Walk up the chain of safepoints and return the PC of the first `finally` + # block we find or -1 if no such block is found. + # Note that the safepoint is removed once the function returns! + result = -1 + + # Traverse the stack starting from the end in order to execute the blocks in + # the intended order + for i in 1..f.safePoints.len: + var pc = f.safePoints[^i] + # Skip the `except` blocks while c.code[pc].opcode == opcExcept: - pc = pc + c.code[pc].regBx - wordExcess + pc += c.code[pc].regBx - wordExcess if c.code[pc].opcode == opcFinally: - return pc - return -1 + discard f.safePoints.pop + return pc + 1 proc opConv(c: PCtx; dest: var TFullReg, src: TFullReg, desttyp, srctyp: PType): bool = + result = false if desttyp.kind == tyString: - if dest.kind != rkNode: - myreset(dest) - dest.kind = rkNode + dest.ensureKind(rkNode) dest.node = newNode(nkStrLit) let styp = srctyp.skipTypes(abstractRange) case styp.kind of tyEnum: let n = styp.n let x = src.intVal.int - if x <% n.len and (let f = n.sons[x].sym; f.position == x): + if x <% n.len and (let f = n[x].sym; f.position == x): dest.node.strVal = if f.ast.isNil: f.name.s else: f.ast.strVal else: for i in 0..<n.len: - if n.sons[i].kind != nkSym: internalError(c.config, "opConv for enum") - let f = n.sons[i].sym + if n[i].kind != nkSym: internalError(c.config, "opConv for enum") + let f = n[i].sym if f.position == x: dest.node.strVal = if f.ast.isNil: f.name.s else: f.ast.strVal return @@ -345,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 = "" @@ -361,40 +426,57 @@ 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, abstractRange).kind + let desttyp = skipTypes(desttyp, abstractVarRange) + case desttyp.kind of tyInt..tyInt64: - if dest.kind != rkInt: - myreset(dest); dest.kind = rkInt + dest.ensureKind(rkInt) case skipTypes(srctyp, abstractRange).kind of tyFloat..tyFloat64: dest.intVal = int(src.floatVal) else: dest.intVal = src.intVal - if dest.intVal < firstOrd(c.config, desttyp) or dest.intVal > lastOrd(c.config, desttyp): + if toInt128(dest.intVal) < firstOrd(c.config, desttyp) or toInt128(dest.intVal) > lastOrd(c.config, desttyp): return true of tyUInt..tyUInt64: - if dest.kind != rkInt: - myreset(dest); dest.kind = rkInt - case skipTypes(srctyp, abstractRange).kind + dest.ensureKind(rkInt) + let styp = srctyp.skipTypes(abstractRange) # skip distinct types(dest type could do this too if needed) + case styp.kind of tyFloat..tyFloat64: dest.intVal = int(src.floatVal) else: - let srcDist = (sizeof(src.intVal) - srctyp.size) * 8 - let destDist = (sizeof(dest.intVal) - desttyp.size) * 8 - when system.cpuEndian == bigEndian: - dest.intVal = (src.intVal shr srcDist) shl srcDist - dest.intVal = (dest.intVal shr destDist) shl destDist - else: - dest.intVal = (src.intVal shl srcDist) shr srcDist - dest.intVal = (dest.intVal shl destDist) shr destDist + let destSize = getSize(c.config, desttyp) + let destDist = (sizeof(dest.intVal) - destSize) * 8 + var value = cast[BiggestUInt](src.intVal) + 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: + dest.ensureKind(rkInt) + dest.intVal = + case skipTypes(srctyp, abstractRange).kind + of tyFloat..tyFloat64: int(src.floatVal != 0.0) + else: int(src.intVal != 0) of tyFloat..tyFloat64: - if dest.kind != rkFloat: - myreset(dest); dest.kind = rkFloat - case skipTypes(srctyp, abstractRange).kind + dest.ensureKind(rkFloat) + 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: + if srctyp.skipTypes(abstractVarRange).kind != tyObject: + internalError(c.config, "invalid object-to-object conversion") + # A object-to-object conversion is essentially a no-op + moveConst(dest, src) else: asgnComplex(dest, src) @@ -406,198 +488,446 @@ proc compile(c: PCtx, s: PSym): int = template handleJmpBack() {.dirty.} = if c.loopIterations <= 0: if allowInfiniteLoops in c.features: - c.loopIterations = MaxLoopIterations + 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) + globalError(c.config, c.debug[pc], errTooManyIterations % $c.config.maxLoopIterationsVM) dec(c.loopIterations) proc recSetFlagIsRef(arg: PNode) = - arg.flags.incl(nfIsRef) - for i in 0 ..< arg.safeLen: - arg.sons[i].recSetFlagIsRef + if arg.kind notin {nkStrLit..nkTripleStrLit}: + arg.flags.incl(nfIsRef) + for i in 0..<arg.safeLen: + arg[i].recSetFlagIsRef proc setLenSeq(c: PCtx; node: PNode; newLen: int; info: TLineInfo) = - # FIXME: this doesn't attempt to solve incomplete - # support of tyPtr, tyRef in VM. let typ = node.typ.skipTypes(abstractInst+{tyRange}-{tyTypeDesc}) - let typeEntry = typ.sons[0].skipTypes(abstractInst+{tyRange}-{tyTypeDesc}) - let typeKind = case typeEntry.kind - of tyUInt..tyUInt64: nkUIntLit - of tyRange, tyEnum, tyBool, tyChar, tyInt..tyInt64: nkIntLit - of tyFloat..tyFloat128: nkFloatLit - of tyString: nkStrLit - of tyObject: nkObjConstr - of tySequence: nkNilLit - of tyProc, tyTuple: nkTupleConstr - else: nkEmpty - let oldLen = node.len setLen(node.sons, newLen) if oldLen < newLen: - # TODO: This is still not correct for tyPtr, tyRef default value - for i in oldLen ..< newLen: - node.sons[i] = newNodeI(typeKind, info) + for i in oldLen..<newLen: + node[i] = getNullValue(c, typ.elementType, info, c.config) const - errIndexOutOfBounds = "index out of bounds" errNilAccess = "attempt to access a nil address" errOverOrUnderflow = "over- or underflow" errConstantDivisionByZero = "division by zero" errIllegalConvFromXtoY = "illegal conversion from '$1' to '$2'" errTooManyIterations = "interpretation requires too many iterations; " & - "if you are sure this is not a bug in your code edit " & - "compiler/vmdef.MaxLoopIterations and rebuild the compiler" + "if you are sure this is not a bug in your code, compile with `--maxLoopIterationsVM:number` (current value: $1)" errFieldXNotFound = "node lacks field: " + +template maybeHandlePtr(node2: PNode, reg: TFullReg, isAssign2: bool): bool = + let node = node2 # prevent double evaluation + if node.kind == nkNilLit: + stackTrace(c, tos, pc, errNilAccess) + let typ = node.typ + 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.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)) + true + else: + false + +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 - var regs: seq[TFullReg] # alias to tos.slots for performance - move(regs, tos.slots) + # Used to keep track of where the execution is resumed. + var savedPC = -1 + var savedFrame: PStackFrame = nil + when defined(gcArc) or defined(gcOrc) or defined(gcAtomicArc): + template updateRegsAlias = discard + template regs: untyped = tos.slots + else: + template updateRegsAlias = + move(regs, tos.slots) + var regs: seq[TFullReg] # alias to tos.slots for performance + updateRegsAlias #echo "NEW RUN ------------------------" while true: #{.computedGoto.} let instr = c.code[pc] let ra = instr.regA - #if c.traceActive: - when traceCode: - echo "PC ", pc, " ", c.code[pc].opcode, " ra ", ra, " rb ", instr.regB, " rc ", instr.regC - # message(c.config, c.debug[pc], warnUser, "Trace") + when traceCode: + template regDescr(name, r): string = + let kind = if r < regs.len: $regs[r].kind else: "" + let ret = name & ": " & $r & " " & $kind + alignLeft(ret, 15) + echo "PC:$pc $opcode $ra $rb $rc" % [ + "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: - # XXX perform any cleanup actions - pc = tos.comesFrom - tos = tos.next - let retVal = regs[0] - if tos.isNil: - #echo "RET ", retVal.rendertree - return retVal - - move(regs, tos.slots) - assert c.code[pc].opcode in {opcIndCall, opcIndCallAsgn} - if c.code[pc].opcode == opcIndCallAsgn: - regs[c.code[pc].regA] = retVal - #echo "RET2 ", retVal.rendertree, " ", c.code[pc].regA + let newPc = c.cleanUpOnReturn(tos) + # Perform any cleanup action before returning + if newPc < 0: + pc = tos.comesFrom + let retVal = regs[0] + tos = tos.next + if tos.isNil: + return retVal + + updateRegsAlias + assert c.code[pc].opcode in {opcIndCall, opcIndCallAsgn} + if c.code[pc].opcode == opcIndCallAsgn: + regs[c.code[pc].regA] = retVal + else: + savedPC = pc + savedFrame = tos + # The -1 is needed because at the end of the loop we increment `pc` + pc = newPc - 1 of opcYldYoid: assert false of opcYldVal: assert false of opcAsgnInt: decodeB(rkInt) - regs[ra].intVal = regs[rb].intVal - of opcAsgnStr: - decodeBC(rkNode) - createStrKeepNode regs[ra], rc != 0 - regs[ra].node.strVal = regs[rb].node.strVal + 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 + of opcCastFloatToInt32: + let rb = instr.regB + ensureKind(rkInt) + regs[ra].intVal = cast[int32](float32(regs[rb].floatVal)) + of opcCastFloatToInt64: + let rb = instr.regB + ensureKind(rkInt) + regs[ra].intVal = cast[int64](regs[rb].floatVal) + of opcCastIntToFloat32: + let rb = instr.regB + ensureKind(rkFloat) + regs[ra].floatVal = cast[float32](regs[rb].intVal) + of opcCastIntToFloat64: + let rb = instr.regB + ensureKind(rkFloat) + regs[ra].floatVal = cast[float64](regs[rb].intVal) + + of opcCastPtrToInt: # RENAME opcCastPtrOrRefToInt + decodeBImm(rkInt) + case imm + of 1: # PtrLikeKinds + case regs[rb].kind + of rkNode: + 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 + regs[ra].intVal = cast[int](regs[rb].node) + else: assert false, $imm + of opcCastIntToPtr: + let rb = instr.regB + let typ = regs[ra].node.typ + let node2 = newNodeIT(nkIntLit, c.debug[pc], typ) + case regs[rb].kind + of rkInt: node2.intVal = regs[rb].intVal + of rkNode: + if regs[rb].node.typ.kind notin PtrLikeKinds: + stackTrace(c, tos, pc, "opcCastIntToPtr: regs[rb].node.typ: " & $regs[rb].node.typ.kind) + node2.intVal = regs[rb].node.intVal + else: stackTrace(c, tos, pc, "opcCastIntToPtr: regs[rb].kind: " & $regs[rb].kind) + regs[ra].node = node2 of opcAsgnComplex: asgnComplex(regs[ra], regs[instr.regB]) + of opcFastAsgnComplex: + fastAsgnComplex(regs[ra], regs[instr.regB]) of opcAsgnRef: asgnRef(regs[ra], regs[instr.regB]) - of opcRegToNode: - decodeB(rkNode) - putIntoNode(regs[ra].node, regs[rb]) 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) if regs[rc].intVal > high(int): - stackTrace(c, tos, pc, errIndexOutOfBounds) + 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 else: - stackTrace(c, tos, pc, errIndexOutOfBounds) + stackTrace(c, tos, pc, formatErrorIndexBound(idx, src.strVal.len-1)) elif src.kind notin {nkEmpty..nkFloat128Lit} and idx <% src.len: - regs[ra].node = src.sons[idx] + regs[ra].node = src[idx] else: - stackTrace(c, tos, pc, errIndexOutOfBounds) + stackTrace(c, tos, pc, formatErrorIndexBound(idx, src.safeLen-1)) + of opcLdArrAddr: + # a = addr(b[c]) + decodeBC(rkNodeAddr) + if regs[rc].intVal > high(int): + stackTrace(c, tos, pc, formatErrorIndexBound(regs[rc].intVal, high(int))) + let idx = regs[rc].intVal.int + let src = if regs[rb].kind == rkNode: regs[rb].node else: regs[rb].nodeAddr[] + 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: + 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 - if s.isNil: - stackTrace(c, tos, pc, errNilAccess) - elif idx <=% s.len: + let s {.cursor.} = regs[rb].node.strVal + if idx <% s.len: regs[ra].intVal = s[idx].ord else: - stackTrace(c, tos, pc, errIndexOutOfBounds) + stackTrace(c, tos, pc, formatErrorIndexBound(idx, s.len-1)) + of opcLdStrIdxAddr: + # a = addr(b[c]); similar to opcLdArrAddr + decodeBC(rkNode) + if regs[rc].intVal > high(int): + stackTrace(c, tos, pc, formatErrorIndexBound(regs[rc].intVal, high(int))) + let idx = regs[rc].intVal.int + let s = regs[rb].node.strVal.addr # or `byaddr` + if idx <% s[].len: + 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: - stackTrace(c, tos, pc, errIndexOutOfBounds) + stackTrace(c, tos, pc, formatErrorIndexBound(idx, arr.strVal.len-1)) elif idx <% arr.len: - putIntoNode(arr.sons[idx], regs[rc]) + writeField(arr[idx], regs[rc]) else: - stackTrace(c, tos, pc, errIndexOutOfBounds) + stackTrace(c, tos, pc, formatErrorIndexBound(idx, arr.safeLen-1)) of opcLdObj: # a = b.c decodeBC(rkNode) - let src = regs[rb].node - if src.kind notin {nkEmpty..nkNilLit}: - let n = src.sons[rc + ord(src.kind == nkObjConstr)].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 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) + let src = if regs[rb].kind == rkNode: regs[rb].node else: regs[rb].nodeAddr[] + case src.kind + of nkEmpty..nkNilLit: stackTrace(c, tos, pc, errNilAccess) + of nkObjConstr: + let n = src.sons[rc + 1] + if n.kind == nkExprColonExpr: + takeAddress regs[ra], n.sons[1] + else: + takeAddress regs[ra], src.sons[rc + 1] + else: + takeAddress regs[ra], src.sons[rc] of opcWrObj: # a.b = c decodeBC(rkNode) + assert regs[ra].node != nil let shiftedRb = rb + ord(regs[ra].node.kind == nkObjConstr) let dest = regs[ra].node if dest.kind == nkNilLit: stackTrace(c, tos, pc, errNilAccess) - elif dest.sons[shiftedRb].kind == nkExprColonExpr: - putIntoNode(dest.sons[shiftedRb].sons[1], regs[rc]) + elif dest[shiftedRb].kind == nkExprColonExpr: + writeField(dest[shiftedRb][1], regs[rc]) + dest[shiftedRb][1].flags.incl nfSkipFieldChecking else: - putIntoNode(dest.sons[shiftedRb], regs[rc]) + writeField(dest[shiftedRb], regs[rc]) + dest[shiftedRb].flags.incl nfSkipFieldChecking of opcWrStrIdx: decodeBC(rkNode) let idx = regs[rb].intVal.int if idx <% regs[ra].node.strVal.len: regs[ra].node.strVal[idx] = chr(regs[rc].intVal) else: - stackTrace(c, tos, pc, errIndexOutOfBounds) + stackTrace(c, tos, pc, formatErrorIndexBound(idx, regs[ra].node.strVal.len-1)) of opcAddrReg: decodeB(rkRegisterAddr) regs[ra].regAddr = addr(regs[rb]) of opcAddrNode: decodeB(rkNodeAddr) - if regs[rb].kind == rkNode: - regs[ra].nodeAddr = addr(regs[rb].node) + case regs[rb].kind + of rkNode: + takeAddress regs[ra], regs[rb].node + of rkNodeAddr: # bug #14339 + regs[ra].nodeAddr = regs[rb].nodeAddr else: - stackTrace(c, tos, pc, "limited VM support for 'addr'") + stackTrace(c, tos, pc, "limited VM support for 'addr', got kind: " & $regs[rb].kind) of opcLdDeref: # a = b[] let ra = instr.regA @@ -610,23 +940,35 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = ensureKind(regs[rb].regAddr.kind) regs[ra] = regs[rb].regAddr[] of rkNode: - if regs[rb].node.kind == nkNilLit: - stackTrace(c, tos, pc, errNilAccess) if regs[rb].node.kind == nkRefTy: - regs[ra].node = regs[rb].node.sons[0] - else: + regs[ra].node = regs[rb].node[0] + elif not maybeHandlePtr(regs[rb].node, regs[ra], false): + ## e.g.: typ.kind = tyObject ensureKind(rkNode) regs[ra].node = regs[rb].node else: - stackTrace(c, tos, pc, errNilAccess) + stackTrace(c, tos, pc, errNilAccess & " kind: " & $regs[rb].kind) of opcWrDeref: # a[] = c; b unused let ra = instr.regA let rc = instr.regC case regs[ra].kind - of rkNodeAddr: putIntoNode(regs[ra].nodeAddr[], regs[rc]) + of rkNodeAddr: + let n = regs[rc].regToNode + # `var object` parameters are sent as rkNodeAddr. When they are mutated + # vmgen generates opcWrDeref, which means that we must dereference + # twice. + # TODO: This should likely be handled differently in vmgen. + let nAddr = regs[ra].nodeAddr + if nAddr[] == nil: stackTrace(c, tos, pc, "opcWrDeref internal error") # refs bug #16613 + if (nfIsRef notin nAddr[].flags and nfIsRef notin n.flags): nAddr[][] = n[] + else: nAddr[] = n of rkRegisterAddr: regs[ra].regAddr[] = regs[rc] - of rkNode: putIntoNode(regs[ra].node, regs[rc]) + of rkNode: + # xxx: also check for nkRefTy as in opcLdDeref? + if not maybeHandlePtr(regs[ra].node, regs[rc], true): + regs[ra].node[] = regs[rc].regToNode[] + regs[ra].node.flags.incl nfIsRef else: stackTrace(c, tos, pc, errNilAccess) of opcAddInt: decodeBC(rkInt) @@ -673,36 +1015,50 @@ 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 regs[ra].intVal = regs[rb].node.strVal.len - imm + of opcLenCstring: + decodeBImm(rkInt) + assert regs[rb].kind == rkNode + 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 if not inSet(regs[ra].node, b): - addSon(regs[ra].node, copyTree(b)) + regs[ra].node.add copyTree(b) of opcInclRange: decodeBC(rkNode) var r = newNode(nkRange) r.add regs[rb].regToNode r.add regs[rc].regToNode - addSon(regs[ra].node, r.copyTree) + regs[ra].node.add r.copyTree of opcExcl: decodeB(rkNode) var b = newNodeIT(nkCurly, regs[ra].node.info, regs[ra].node.typ) - addSon(b, regs[rb].regToNode) + b.add regs[rb].regToNode var r = diffSets(c.config, regs[ra].node, b) discardSons(regs[ra].node) - for i in countup(0, sonsLen(r) - 1): addSon(regs[ra].node, r.sons[i]) + for i in 0..<r.len: regs[ra].node.add r[i] of opcCard: decodeB(rkInt) regs[ra].intVal = nimsets.cardSet(c.config, regs[rb].node) @@ -742,10 +1098,16 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = regs[ra].floatVal = regs[rb].floatVal / regs[rc].floatVal of opcShrInt: decodeBC(rkInt) - regs[ra].intVal = regs[rb].intVal shr regs[rc].intVal + let b = cast[uint64](regs[rb].intVal) + let c = cast[uint64](regs[rc].intVal) + let a = cast[int64](b shr c) + regs[ra].intVal = a of opcShlInt: decodeBC(rkInt) regs[ra].intVal = regs[rb].intVal shl regs[rc].intVal + of opcAshrInt: + decodeBC(rkInt) + regs[ra].intVal = ashr(regs[rb].intVal, regs[rc].intVal) of opcBitandInt: decodeBC(rkInt) regs[ra].intVal = regs[rb].intVal and regs[rc].intVal @@ -795,30 +1157,61 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = decodeBC(rkInt) regs[ra].intVal = ord(regs[rb].intVal <% regs[rc].intVal) of opcEqRef: + var ret = false decodeBC(rkInt) - if regs[rb].kind == rkNodeAddr: - if regs[rc].kind == rkNodeAddr: - regs[ra].intVal = ord(regs[rb].nodeAddr == regs[rc].nodeAddr) + 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) + case n2.kind + of nkNilLit: return p1 == 0 + of nkIntLit: # TODO: nkPtrLit + # for example, n1.kind == nkFloatLit (ptr float) + # the problem is that n1.typ == nil so we can't compare n1.typ and n2.typ + # this is the best we can do (pending making sure we assign a valid n1.typ to nodeAddr's) + let t2 = n2.getTyp + return t2.kind in PtrLikeKinds and n2.intVal == p1 + else: return false + + let rbReg = skipRegisterAddr(regs[rb]) + let rcReg = skipRegisterAddr(regs[rc]) + + if rbReg.kind == rkNodeAddr: + if rcReg.kind == rkNodeAddr: + ret = rbReg.nodeAddr == rcReg.nodeAddr else: - assert regs[rc].kind == rkNode - # we know these cannot be equal - regs[ra].intVal = ord(false) - elif regs[rc].kind == rkNodeAddr: - assert regs[rb].kind == rkNode - # we know these cannot be equal - regs[ra].intVal = ord(false) + ret = ptrEquality(rbReg.nodeAddr, rcReg.node) + elif rcReg.kind == rkNodeAddr: + ret = ptrEquality(rcReg.nodeAddr, rbReg.node) else: - regs[ra].intVal = ord((regs[rb].node.kind == nkNilLit and - regs[rc].node.kind == nkNilLit) or - regs[rb].node == regs[rc].node) - of opcEqNimrodNode: + 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 != 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 + let tb = nb.getTyp + let tc = nc.getTyp + ret = tb.kind in PtrLikeKinds and tc.kind == tb.kind + regs[ra].intVal = ord(ret) + of opcEqNimNode: decodeBC(rkInt) regs[ra].intVal = ord(exprStructuralEquivalent(regs[rb].node, regs[rc].node, 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) @@ -845,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) @@ -877,11 +1276,6 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = createSet(regs[ra]) move(regs[ra].node.sons, nimsets.diffSets(c.config, regs[rb].node, regs[rc].node).sons) - of opcSymdiffSet: - decodeBC(rkNode) - createSet(regs[ra]) - move(regs[ra].node.sons, - nimsets.symdiffSets(c.config, regs[rb].node, regs[rc].node).sons) of opcConcatStr: decodeBC(rkNode) createStr regs[ra] @@ -890,11 +1284,9 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = regs[ra].node.strVal.add getstr(regs[i]) of opcAddStrCh: decodeB(rkNode) - #createStrKeepNode regs[ra] regs[ra].node.strVal.add(regs[rb].intVal.chr) of opcAddStrStr: decodeB(rkNode) - #createStrKeepNode regs[ra] regs[ra].node.strVal.add(regs[rb].node.strVal) of opcAddSeqElem: decodeB(rkNode) @@ -904,45 +1296,88 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = stackTrace(c, tos, pc, errNilAccess) of opcGetImpl: decodeB(rkNode) - let a = regs[rb].node + var a = regs[rb].node + if a.kind == nkVarTy: a = a[0] if a.kind == nkSym: regs[ra].node = if a.sym.ast.isNil: newNode(nkNilLit) else: copyTree(a.sym.ast) + regs[ra].node.flags.incl nfIsRef + else: + stackTrace(c, tos, pc, "node is not a symbol") + of opcGetImplTransf: + decodeB(rkNode) + let a = regs[rb].node + if a.kind == nkSym: + regs[ra].node = + if a.sym.ast.isNil: + newNode(nkNilLit) + else: + 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, {useCache, force}) + ast.copyTree() + of opcSymOwner: + decodeB(rkNode) + let a = regs[rb].node + if a.kind == nkSym: + regs[ra].node = if a.sym.owner.isNil: newNode(nkNilLit) + else: newSymNode(a.sym.skipGenericOwner) + regs[ra].node.flags.incl nfIsRef else: stackTrace(c, tos, pc, "node is not a symbol") + of opcSymIsInstantiationOf: + decodeBC(rkInt) + let a = regs[rb].node + let b = regs[rc].node + 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.instantiatedFrom == b.sym: 1 + else: 0 + else: + stackTrace(c, tos, pc, "node is not a proc symbol") of opcEcho: let rb = instr.regB - if rb == 1: - msgWriteln(c.config, regs[ra].node.strVal, {msgStdout}) + template fn(s) = msgWriteln(c.config, s, {msgStdout, msgNoUnitSep}) + if rb == 1: fn(regs[ra].node.strVal) else: var outp = "" for i in ra..ra+rb-1: #if regs[i].kind != rkNode: debug regs[i] outp.add(regs[i].node.strVal) - msgWriteln(c.config, outp, {msgStdout}) + fn(outp) 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: - myreset(regs[rc]) - regs[rc].kind = rkFloat - regs[ra].intVal = parseBiggestFloat(regs[rb].node.strVal, - rcAddr.floatVal, regs[rd].intVal.int) + regs[rc] = TFullReg(kind: rkFloat) + + 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 @@ -956,24 +1391,35 @@ 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 - let prc = if not isClosure: bb.sym else: bb.sons[0].sym + 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( - VmArgs(ra: ra, rb: rb, rc: rc, slots: cast[pointer](regs), - currentException: c.currentExceptionB, - currentLineInfo: c.debug[pc])) - elif sfImportc in prc.flags: - if allowFFI notin c.features: - globalError(c.config, c.debug[pc], "VM not allowed to do FFI") + 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]) + ) + elif importcCond(c, prc): + if compiletimeFFI notin c.config.features: + globalError(c.config, c.debug[pc], "VM not allowed to do FFI, see `compiletimeFFI`") # we pass 'tos.slots' instead of 'regs' so that the compiler can keep # 'regs' in a register: when hasFFI: - let prcValue = c.globals.sons[prc.position-1] + if prc.position - 1 < 0: + globalError(c.config, c.debug[pc], + "VM call invalid: prc.position: " & $prc.position) + let prcValue = c.globals[prc.position-1] if prcValue.kind == nkEmpty: globalError(c.config, c.debug[pc], "cannot run " & prc.name.s) - let newValue = callForeignFunction(prcValue, prc.typ, tos.slots, + 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, rb+1, rc-1, c.debug[pc]) if newValue.kind != nkEmpty: assert instr.opcode == opcIndCallAsgn @@ -988,15 +1434,14 @@ 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.sons[0]) or prc.kind == skMacro: - putIntoReg(newFrame.slots[0], getNullValue(prc.typ.sons[0], prc.info, c.config)) - for i in 1 .. rc-1: + 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: - newFrame.slots[rc].kind = rkNode - newFrame.slots[rc].node = regs[rb].node.sons[1] + newFrame.slots[rc] = TFullReg(kind: rkNode, node: regs[rb].node[1]) tos = newFrame - move(regs, newFrame.slots) + updateRegsAlias # -1 for the following 'inc pc' pc = newPc-1 else: @@ -1007,11 +1452,14 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = c.module var macroCall = newNodeI(nkCall, c.debug[pc]) macroCall.add(newSymNode(prc)) - for i in 1 .. rc-1: + 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) + 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] a.recSetFlagIsRef ensureKind(rkNode) @@ -1038,8 +1486,8 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = # we know the next instruction is a 'fjmp': let branch = c.constants[instr.regBx-wordExcess] var cond = false - for j in countup(0, sonsLen(branch) - 2): - if overlap(regs[ra].regToNode, branch.sons[j]): + for j in 0..<branch.len - 1: + if overlap(regs[ra].regToNode, branch[j]): cond = true break assert c.code[pc+1].opcode == opcFJmp @@ -1055,48 +1503,72 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = tos.pushSafePoint(pc + rbx) assert c.code[pc+rbx].opcode in {opcExcept, opcFinally} of opcExcept: - # just skip it; it's followed by a jump; - # we'll execute in the 'raise' handler - let rbx = instr.regBx - wordExcess - 1 # -1 for the following 'inc pc' - inc pc, rbx - while c.code[pc+1].opcode == opcExcept: - let rbx = c.code[pc+1].regBx - wordExcess - 1 - inc pc, rbx - #assert c.code[pc+1].opcode in {opcExcept, opcFinally} - if c.code[pc+1].opcode != opcFinally: - # in an except handler there is no active safe point for the 'try': - tos.popSafePoint() + # This opcode is never executed, it only holds information for the + # exception handling routines. + raiseAssert "unreachable" of opcFinally: - # just skip it; it's followed by the code we need to execute anyway + # Pop the last safepoint introduced by a opcTry. This opcode is only + # executed _iff_ no exception was raised in the body of the `try` + # statement hence the need to pop the safepoint here. + doAssert(savedPC < 0) tos.popSafePoint() of opcFinallyEnd: - if c.currentExceptionA != nil: - # we are in a cleanup run: - let (newPc, newTos) = cleanUpOnException(c, tos) - if newPc-1 < 0: - bailOut(c, tos) - return - pc = newPc-1 - if tos != newTos: - tos = newTos - move(regs, tos.slots) + # The control flow may not resume at the next instruction since we may be + # raising an exception or performing a cleanup. + if savedPC >= 0: + pc = savedPC - 1 + savedPC = -1 + if tos != savedFrame: + tos = savedFrame + updateRegsAlias of opcRaise: - let raised = regs[ra].node + let raised = + # Empty `raise` statement - reraise current exception + if regs[ra].kind == rkNone: + c.currentExceptionA + else: + regs[ra].node c.currentExceptionA = raised + # Set the `name` field of the exception + 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 - let (newPc, newTos) = cleanUpOnException(c, tos) - # -1 because of the following 'inc' - if newPc-1 < 0: + + var frame = tos + var jumpTo = findExceptionHandler(c, frame, raised) + while jumpTo.why == ExceptionGotoUnhandled and not frame.next.isNil: + frame = frame.next + jumpTo = findExceptionHandler(c, frame, raised) + + case jumpTo.why + of ExceptionGotoHandler: + # Jump to the handler, do nothing when the `finally` block ends. + savedPC = -1 + pc = jumpTo.where - 1 + if tos != frame: + tos = frame + updateRegsAlias + of ExceptionGotoFinally: + # Jump to the `finally` block first then re-jump here to continue the + # traversal of the exception chain + savedPC = pc + savedFrame = tos + pc = jumpTo.where - 1 + if tos != frame: + tos = frame + updateRegsAlias + of ExceptionGotoUnhandled: + # Nobody handled this exception, error out. bailOut(c, tos) - return - pc = newPc-1 - if tos != newTos: - tos = newTos - move(regs, tos.slots) 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] @@ -1107,8 +1579,8 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = regs[ra].node = newNodeI(nkBracket, c.debug[pc]) regs[ra].node.typ = typ newSeq(regs[ra].node.sons, count) - for i in 0 ..< count: - regs[ra].node.sons[i] = getNullValue(typ.sons[0], c.debug[pc], c.config) + for i in 0..<count: + 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]) @@ -1120,10 +1592,10 @@ 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 wether + # depends on whether regs[ra] represents the variable itself or whether # it holds the indirection! Due to the way registers are re-used we cannot # say for sure here! --> The codegen has to deal with it # via 'genAsgnPatch'. @@ -1138,16 +1610,16 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = regs[ra].intVal = 0 of opcLdConst: let rb = instr.regBx - wordExcess - let cnst = c.constants.sons[rb] + let cnst = c.constants[rb] if fitsRegister(cnst.typ): - myreset(regs[ra]) + reset(regs[ra]) putIntoReg(regs[ra], cnst) else: ensureKind(rkNode) regs[ra].node = cnst of opcAsgnConst: let rb = instr.regBx - wordExcess - let cnst = c.constants.sons[rb] + let cnst = c.constants[rb] if fitsRegister(cnst.typ): putIntoReg(regs[ra], cnst) else: @@ -1156,21 +1628,49 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcLdGlobal: let rb = instr.regBx - wordExcess - 1 ensureKind(rkNode) - regs[ra].node = c.globals.sons[rb] + regs[ra].node = c.globals[rb] + of opcLdGlobalDerefFFI: + let rb = instr.regBx - wordExcess - 1 + let node = c.globals[rb] + let typ = node.typ + doAssert node.kind == nkIntLit, $(node.kind) + if typ.kind == tyPtr: + ensureKind(rkNode) + # use nkPtrLit once this is added + let node2 = newNodeIT(nkIntLit, c.debug[pc], typ) + node2.intVal = cast[ptr int](node.intVal)[] + 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.elementType.kind)) + of opcLdGlobalAddrDerefFFI: + let rb = instr.regBx - wordExcess - 1 + let node = c.globals[rb] + let typ = node.typ + var node2 = newNodeIT(nkIntLit, node.info, typ) + node2.intVal = node.intVal + node2.flags.incl nfIsPtr + ensureKind(rkNode) + regs[ra].node = node2 of opcLdGlobalAddr: let rb = instr.regBx - wordExcess - 1 ensureKind(rkNodeAddr) - regs[ra].nodeAddr = addr(c.globals.sons[rb]) + regs[ra].nodeAddr = addr(c.globals[rb]) 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) - msgQuit(int8(getOrdValue(regs[ra].regToNode))) + msgQuit(int8(toInt(getOrdValue(regs[ra].regToNode, onError = toInt128(1))))) else: return TFullReg(kind: rkNone) + of opcInvalidField: + 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] @@ -1178,7 +1678,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcOf: decodeBC(rkInt) let typ = c.types[regs[rc].intVal.int] - regs[ra].intVal = ord(inheritanceDiff(regs[rb].node.typ, typ) >= 0) + regs[ra].intVal = ord(inheritanceDiff(regs[rb].node.typ, typ) <= 0) of opcIs: decodeBC(rkInt) let t1 = regs[rb].node.typ.skipTypes({tyTypeDesc}) @@ -1192,8 +1692,6 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = let newLen = regs[rb].intVal.int if regs[ra].node.isNil: stackTrace(c, tos, pc, errNilAccess) else: c.setLenSeq(regs[ra].node, newLen, c.debug[pc]) - of opcReset: - internalError(c.config, c.debug[pc], "too implement") of opcNarrowS: decodeB(rkInt) let min = -(1.BiggestInt shl (rb-1)) @@ -1203,47 +1701,83 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcNarrowU: decodeB(rkInt) regs[ra].intVal = regs[ra].intVal and ((1'i64 shl rb)-1) + of opcSignExtend: + # like opcNarrowS, but no out of range possible + decodeB(rkInt) + let imm = 64 - rb + regs[ra].intVal = ashr(regs[ra].intVal shl imm, imm) of opcIsNil: decodeB(rkInt) let node = regs[rb].node - regs[ra].intVal = ord(node.kind == nkNilLit or - (node.kind in {nkStrLit..nkTripleStrLit} and node.strVal.isNil)) + regs[ra].intVal = ord( + # Note that `nfIsRef` + `nkNilLit` represents an allocated + # 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.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: + + # bindSym with static input decodeBx(rkNode) - regs[ra].node = copyTree(c.constants.sons[rbx]) + regs[ra].node = copyTree(c.constants[rbx]) + regs[ra].node.flags.incl nfIsRef + of opcNDynBindSym: + # experimental bindSym + let + rb = instr.regB + rc = instr.regC + idx = int(regs[rb+rc-1].intVal) + 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]) + callback(args) + regs[ra].node.flags.incl nfIsRef of opcNChild: decodeBC(rkNode) let idx = regs[rc].intVal.int let src = regs[rb].node - if src.kind notin {nkEmpty..nkNilLit} and idx <% src.len: - regs[ra].node = src.sons[idx] + if src.kind in {nkEmpty..nkNilLit}: + stackTrace(c, tos, pc, "cannot get child of node kind: n" & $src.kind) + elif idx >=% src.len: + stackTrace(c, tos, pc, formatErrorIndexBound(idx, src.len-1)) else: - stackTrace(c, tos, pc, errIndexOutOfBounds) + regs[ra].node = src[idx] of opcNSetChild: decodeBC(rkNode) let idx = regs[rb].intVal.int var dest = regs[ra].node - if dest.kind notin {nkEmpty..nkNilLit} and idx <% dest.len: - dest.sons[idx] = regs[rc].node + if nfSem in dest.flags and allowSemcheckedAstModification notin c.config.legacyFeatures: + stackTrace(c, tos, pc, "typechecked nodes may not be modified") + elif dest.kind in {nkEmpty..nkNilLit}: + stackTrace(c, tos, pc, "cannot set child of node kind: n" & $dest.kind) + elif idx >=% dest.len: + stackTrace(c, tos, pc, formatErrorIndexBound(idx, dest.len-1)) else: - stackTrace(c, tos, pc, errIndexOutOfBounds) + dest[idx] = regs[rc].node of opcNAdd: decodeBC(rkNode) var u = regs[rb].node - if u.kind notin {nkEmpty..nkNilLit}: - u.add(regs[rc].node) + if nfSem in u.flags and allowSemcheckedAstModification notin c.config.legacyFeatures: + stackTrace(c, tos, pc, "typechecked nodes may not be modified") + elif u.kind in {nkEmpty..nkNilLit}: + stackTrace(c, tos, pc, "cannot add to node kind: n" & $u.kind) else: - stackTrace(c, tos, pc, "cannot add to node kind: " & $u.kind) + u.add(regs[rc].node) regs[ra].node = u of opcNAddMultiple: decodeBC(rkNode) let x = regs[rc].node var u = regs[rb].node - if u.kind notin {nkEmpty..nkNilLit}: - # XXX can be optimized: - for i in 0..<x.len: u.add(x.sons[i]) + if nfSem in u.flags and allowSemcheckedAstModification notin c.config.legacyFeatures: + stackTrace(c, tos, pc, "typechecked nodes may not be modified") + elif u.kind in {nkEmpty..nkNilLit}: + stackTrace(c, tos, pc, "cannot add to node kind: n" & $u.kind) else: - stackTrace(c, tos, pc, "cannot add to node kind: " & $u.kind) + for i in 0..<x.len: u.add(x[i]) regs[ra].node = u of opcNKind: decodeB(rkInt) @@ -1260,9 +1794,12 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcNIntVal: decodeB(rkInt) let a = regs[rb].node - case a.kind - of nkCharLit..nkUInt64Lit: regs[ra].intVal = a.intVal - else: stackTrace(c, tos, pc, errFieldXNotFound & "intVal") + if a.kind in {nkCharLit..nkUInt64Lit}: + regs[ra].intVal = a.intVal + elif a.kind == nkSym and a.sym.kind == skEnumField: + regs[ra].intVal = a.sym.position + else: + stackTrace(c, tos, pc, errFieldXNotFound & "intVal") of opcNFloatVal: decodeB(rkFloat) let a = regs[rb].node @@ -1283,15 +1820,23 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = regs[ra].node = copyNode(a) else: stackTrace(c, tos, pc, errFieldXNotFound & "ident") + of opcNodeId: + decodeB(rkInt) + when defined(useNodeIds): + regs[ra].intVal = regs[rb].node.id + else: + regs[ra].intVal = -1 of opcNGetType: let rb = instr.regB let rc = instr.regC - case rc: + case rc of 0: # getType opcode: ensureKind(rkNode) if regs[rb].kind == rkNode and regs[rb].node.typ != nil: - regs[ra].node = opMapTypeToAst(c.cache, regs[rb].node.typ, c.debug[pc]) + regs[ra].node = opMapTypeToAst(c.cache, regs[rb].node.typ, c.debug[pc], c.idgen) + elif regs[rb].kind == rkNode and regs[rb].node.kind == nkSym and regs[rb].node.sym.typ != nil: + regs[ra].node = opMapTypeToAst(c.cache, regs[rb].node.sym.typ, c.debug[pc], c.idgen) else: stackTrace(c, tos, pc, "node has no type") of 1: @@ -1299,28 +1844,55 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = ensureKind(rkInt) if regs[rb].kind == rkNode and regs[rb].node.typ != nil: regs[ra].intVal = ord(regs[rb].node.typ.kind) + elif regs[rb].kind == rkNode and regs[rb].node.kind == nkSym and regs[rb].node.sym.typ != nil: + regs[ra].intVal = ord(regs[rb].node.sym.typ.kind) #else: # stackTrace(c, tos, pc, "node has no type") of 2: # getTypeInst opcode: ensureKind(rkNode) if regs[rb].kind == rkNode and regs[rb].node.typ != nil: - regs[ra].node = opMapTypeInstToAst(c.cache, regs[rb].node.typ, c.debug[pc]) + regs[ra].node = opMapTypeInstToAst(c.cache, regs[rb].node.typ, c.debug[pc], c.idgen) + elif regs[rb].kind == rkNode and regs[rb].node.kind == nkSym and regs[rb].node.sym.typ != nil: + regs[ra].node = opMapTypeInstToAst(c.cache, regs[rb].node.sym.typ, c.debug[pc], c.idgen) else: stackTrace(c, tos, pc, "node has no type") else: # getTypeImpl opcode: ensureKind(rkNode) if regs[rb].kind == rkNode and regs[rb].node.typ != nil: - regs[ra].node = opMapTypeImplToAst(c.cache, regs[rb].node.typ, c.debug[pc]) + regs[ra].node = opMapTypeImplToAst(c.cache, regs[rb].node.typ, c.debug[pc], c.idgen) + elif regs[rb].kind == rkNode and regs[rb].node.kind == nkSym and regs[rb].node.sym.typ != nil: + regs[ra].node = opMapTypeImplToAst(c.cache, regs[rb].node.sym.typ, c.debug[pc], c.idgen) else: stackTrace(c, tos, pc, "node has no type") + of opcNGetSize: + decodeBImm(rkInt) + let n = regs[rb].node + case imm + of 0: # size + if n.typ == nil: + stackTrace(c, tos, pc, "node has no type") + else: + regs[ra].intVal = getSize(c.config, n.typ) + of 1: # align + if n.typ == nil: + stackTrace(c, tos, pc, "node has no type") + else: + regs[ra].intVal = getAlign(c.config, n.typ) + else: # offset + if n.kind != nkSym: + stackTrace(c, tos, pc, "node is not a symbol") + elif n.sym.kind != skField: + stackTrace(c, tos, pc, "symbol is not a field (nskField)") + else: + regs[ra].intVal = n.sym.offset of opcNStrVal: decodeB(rkNode) createStr regs[ra] let a = regs[rb].node case a.kind - of {nkStrLit..nkTripleStrLit}: + of nkStrLit..nkTripleStrLit: regs[ra].node.strVal = a.strVal of nkCommentStmt: regs[ra].node.strVal = a.comment @@ -1330,58 +1902,73 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = regs[ra].node.strVal = a.sym.name.s else: stackTrace(c, tos, pc, errFieldXNotFound & "strVal") + of opcNSigHash: + decodeB(rkNode) + createStr regs[ra] + 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, c.config) of opcSlurp: decodeB(rkNode) createStr regs[ra] regs[ra].node.strVal = opSlurp(regs[rb].node.strVal, c.debug[pc], c.module, c.config) of opcGorge: - when defined(nimcore): - decodeBC(rkNode) - inc pc - let rd = c.code[pc].regA - - createStr regs[ra] - regs[ra].node.strVal = opGorge(regs[rb].node.strVal, - regs[rc].node.strVal, regs[rd].node.strVal, - c.debug[pc], c.config)[0] + decodeBC(rkNode) + inc pc + let rd = c.code[pc].regA + createStr regs[ra] + if defined(nimsuggest) or c.config.cmd == cmdCheck: + discard "don't run staticExec for 'nim suggest'" + regs[ra].node.strVal = "" else: - globalError(c.config, c.debug[pc], "VM is not built with 'gorge' support") - of opcNError: + when defined(nimcore): + regs[ra].node.strVal = opGorge(regs[rb].node.strVal, + regs[rc].node.strVal, regs[rd].node.strVal, + c.debug[pc], c.config)[0] + else: + regs[ra].node.strVal = "" + globalError(c.config, c.debug[pc], "VM is not built with 'gorge' support") + of opcNError, opcNWarning, opcNHint: decodeB(rkNode) let a = regs[ra].node let b = regs[rb].node - stackTrace(c, tos, pc, a.strVal, if b.kind == nkNilLit: nil else: b) - of opcNWarning: - message(c.config, c.debug[pc], warnUser, regs[ra].node.strVal) - of opcNHint: - message(c.config, c.debug[pc], hintUser, regs[ra].node.strVal) + let info = if b.kind == nkNilLit: c.debug[pc] else: b.info + if instr.opcode == opcNError: + stackTrace(c, tos, pc, a.strVal, info) + elif instr.opcode == opcNWarning: + message(c.config, info, warnUser, a.strVal) + 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, + regs[rc].node.strVal, 0, proc (conf: ConfigRef; info: TLineInfo; msg: TMsgKind; arg: string) = - if error.isNil and msg <= errMax: + if error.len == 0 and msg <= errMax: error = formatMsg(conf, info, msg, arg)) - if not error.isNil: + + regs[ra].node = newNode(nkEmpty) + if error.len > 0: c.errorFlag = error - elif sonsLen(ast) != 1: + elif ast.len != 1: c.errorFlag = formatMsg(c.config, c.debug[pc], errGenerated, "expected expression, but got multiple statements") else: - regs[ra].node = ast.sons[0] + 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, + regs[rc].node.strVal, 0, proc (conf: ConfigRef; info: TLineInfo; msg: TMsgKind; arg: string) = - if error.isNil and msg <= errMax: + if error.len == 0 and msg <= errMax: error = formatMsg(conf, info, msg, arg)) - if not error.isNil: + if error.len > 0: c.errorFlag = error + regs[ra].node = newNode(nkEmpty) else: regs[ra].node = ast of opcQueryErrorFlag: @@ -1392,36 +1979,57 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = ensureKind(rkNode) if c.callsite != nil: regs[ra].node = c.callsite else: stackTrace(c, tos, pc, errFieldXNotFound & "callsite") - of opcNGetFile: - decodeB(rkNode) + of opcNGetLineInfo: + decodeBImm(rkNode) let n = regs[rb].node - regs[ra].node = newStrNode(nkStrLit, toFilename(c.config, n.info)) + case imm + of 0: # getFile + regs[ra].node = newStrNode(nkStrLit, toFullPath(c.config, n.info)) + of 1: # getLine + regs[ra].node = newIntNode(nkIntLit, n.info.line.int) + of 2: # getColumn + 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 opcNGetLine: + of opcNCopyLineInfo: decodeB(rkNode) - let n = regs[rb].node - regs[ra].node = newIntNode(nkIntLit, n.info.line.int) - regs[ra].node.info = n.info - regs[ra].node.typ = n.typ - of opcNGetColumn: + regs[ra].node.info = regs[rb].node.info + of opcNSetLineInfoLine: decodeB(rkNode) - let n = regs[rb].node - regs[ra].node = newIntNode(nkIntLit, n.info.col) - regs[ra].node.info = n.info - regs[ra].node.typ = n.typ + 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 - let aNode = regs[rb].node - let bNode = regs[rc].node - # these are cstring to prevent string copy, and cmpIgnoreStyle from - # takes cstring arguments + var aNode = regs[rb].node + var bNode = regs[rc].node + # Skipping both, `nkPostfix` and `nkAccQuoted` for both + # arguments. `nkPostfix` exists only to tag exported symbols + # and therefor it can be safely skipped. Nim has no postfix + # operator. `nkAccQuoted` is used to quote an identifier that + # wouldn't be allowed to use in an unquoted context. + if aNode.kind == nkPostfix: + aNode = aNode[1] + if aNode.kind == nkAccQuoted: + aNode = aNode[0] + if bNode.kind == nkPostfix: + bNode = bNode[1] + if bNode.kind == nkAccQuoted: + bNode = bNode[0] + # These vars are of type `cstring` to prevent unnecessary string copy. var aStrVal: cstring = nil var bStrVal: cstring = nil # extract strVal from argument ``a`` case aNode.kind - of {nkStrLit..nkTripleStrLit}: + of nkStrLit..nkTripleStrLit: aStrVal = aNode.strVal.cstring of nkIdent: aStrVal = aNode.ident.s.cstring @@ -1433,7 +2041,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = discard # extract strVal from argument ``b`` case bNode.kind - of {nkStrLit..nkTripleStrLit}: + of nkStrLit..nkTripleStrLit: bStrVal = bNode.strVal.cstring of nkIdent: bStrVal = bNode.ident.s.cstring @@ -1443,10 +2051,9 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = bStrVal = bNode[0].sym.name.s.cstring else: discard - # set result regs[ra].intVal = if aStrVal != nil and bStrVal != nil: - ord(idents.cmpIgnoreStyle(aStrVal,bStrVal,high(int)) == 0) + ord(idents.cmpIgnoreStyle(aStrVal, bStrVal, high(int)) == 0) else: 0 @@ -1457,10 +2064,15 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = else: regs[ra].node = newNodeI(nkIdent, c.debug[pc]) regs[ra].node.ident = getIdent(c.cache, regs[rb].node.strVal) + regs[ra].node.flags.incl nfIsRef of opcSetType: + let typ = c.types[instr.regBx - wordExcess] if regs[ra].kind != rkNode: - internalError(c.config, c.debug[pc], "cannot set type") - regs[ra].node.typ = c.types[instr.regBx - wordExcess] + let temp = regToNode(regs[ra]) + ensureKind(rkNode) + regs[ra].node = temp + regs[ra].node.info = c.debug[pc] + regs[ra].node.typ = typ of opcConv: let rb = instr.regB inc pc @@ -1480,8 +2092,10 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = let srctyp = c.types[c.code[pc].regBx - wordExcess] when hasFFI: - let dest = fficast(regs[rb], desttyp) - asgnRef(regs[ra], dest) + let dest = fficast(c.config, regs[rb].node, desttyp) + # todo: check whether this is correct + # asgnRef(regs[ra], dest) + putIntoReg(regs[ra], dest) else: globalError(c.config, c.debug[pc], "cannot evaluate cast") of opcNSetIntVal: @@ -1490,6 +2104,8 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = if dest.kind in {nkCharLit..nkUInt64Lit} and regs[rb].kind in {rkInt}: dest.intVal = regs[rb].intVal + elif dest.kind == nkSym and dest.sym.kind == skEnumField: + stackTrace(c, tos, pc, "`intVal` cannot be changed for an enum symbol.") else: stackTrace(c, tos, pc, errFieldXNotFound & "intVal") of opcNSetFloatVal: @@ -1514,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 @@ -1560,7 +2170,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcNDel: decodeBC(rkNode) let bb = regs[rb].intVal.int - for i in countup(0, regs[rc].intVal.int-1): + for i in 0..<regs[rc].intVal.int: delSon(regs[ra].node, bb) of opcGenSym: decodeBC(rkNode) @@ -1569,35 +2179,37 @@ 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), 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 - let destKey = regs[ra].node.strVal - let by = regs[instr.regB].intVal + declBC() + let destKey {.cursor.} = regs[rb].node.strVal + let by = regs[rc].intVal let v = getOrDefault(g.cacheCounters, destKey) g.cacheCounters[destKey] = v+by recordInc(c, c.debug[pc], destKey, by) of opcNcsAdd: let g = c.graph - let destKey = regs[ra].node.strVal - let val = regs[instr.regB].node + declBC() + let destKey {.cursor.} = regs[rb].node.strVal + let val = regs[rc].node if not contains(g.cacheSeqs, destKey): g.cacheSeqs[destKey] = newTree(nkStmtList, val) - # newNodeI(nkStmtList, c.debug[pc]) else: g.cacheSeqs[destKey].add val recordAdd(c, c.debug[pc], destKey, val) of opcNcsIncl: let g = c.graph - let destKey = regs[ra].node.strVal - let val = regs[instr.regB].node + declBC() + let destKey {.cursor.} = regs[rb].node.strVal + let val = regs[rc].node if not contains(g.cacheSeqs, destKey): g.cacheSeqs[destKey] = newTree(nkStmtList, val) else: @@ -1610,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, errIndexOutOfBounds) + 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]() @@ -1637,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) @@ -1655,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)) @@ -1664,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) @@ -1679,46 +2291,27 @@ 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.sons[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)) - of opcMarshalStore: - decodeB(rkNode) - inc pc - let typ = c.types[c.code[pc].regBx - wordExcess] - createStrKeepNode(regs[ra]) - if regs[ra].node.strVal.isNil: regs[ra].node.strVal = newStringOfCap(1000) - storeAny(regs[ra].node.strVal, typ, regs[rb].regToNode, c.config) - of opcToNarrowInt: - decodeBC(rkInt) - let mask = (1'i64 shl rc) - 1 # 0xFF - let signbit = 1'i64 shl (rc - 1) # 0x80 - let toggle = mask - signbit # 0x7F - # algorithm: -((i8 and 0xFF) xor 0x7F) + 0x7F - # mask off higher bits. - # uses two's complement to sign-extend integer. - # reajust integer into desired range. - regs[ra].intVal = -((regs[rb].intVal and mask) xor toggle) + toggle + + c.profiler.leave(c) inc pc 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) @@ -1727,19 +2320,20 @@ proc execProc*(c: PCtx; sym: PSym; args: openArray[PNode]): PNode = newSeq(tos.slots, maxSlots) # setup parameters: - if not isEmptyType(sym.typ.sons[0]) or sym.kind == skMacro: - putIntoReg(tos.slots[0], getNullValue(sym.typ.sons[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) proc evalStmt*(c: PCtx, n: PNode) = - let n = transformExpr(c.graph, c.module, n) + let n = transformExpr(c.graph, c.idgen, c.module, n) let start = genStmt(c, n) # execute new instructions; this redundant opcEof check saves us lots # of allocations in 'execute': @@ -1747,36 +2341,42 @@ proc evalStmt*(c: PCtx, n: PNode) = discard execute(c, start) proc evalExpr*(c: PCtx, n: PNode): PNode = - let n = transformExpr(c.graph, c.module, n) + # deadcode + # `nim --eval:"expr"` might've used it at some point for idetools; could + # be revived for nimsuggest + let n = transformExpr(c.graph, c.idgen, c.module, n) let start = genExpr(c, n) assert c.code[start].opcode != opcEof result = execute(c, start) proc getGlobalValue*(c: PCtx; s: PSym): PNode = internalAssert c.config, s.kind in {skLet, skVar} and sfGlobal in s.flags - result = c.globals.sons[s.position-1] + 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) = +proc setupGlobalCtx*(module: PSym; graph: ModuleGraph; idgen: IdGenerator) = if graph.vm.isNil: - graph.vm = newCtx(module, graph.cache, graph) + graph.vm = newCtx(module, graph.cache, graph, idgen) registerAdditionalOps(PCtx graph.vm) else: - refresh(PCtx graph.vm, module) + refresh(PCtx graph.vm, module, idgen) -proc myOpen(graph: ModuleGraph; module: PSym): PPassContext = +proc setupEvalGen*(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext = #var c = newEvalContext(module, emRepl) - #c.features = {allowCast, allowFFI, allowInfiniteLoops} + #c.features = {allowCast, allowInfiniteLoops} #pushStackFrame(c, newStackFrame()) # XXX produce a new 'globals' environment here: - setupGlobalCtx(module, graph) + setupGlobalCtx(module, graph, idgen) result = PCtx graph.vm - when hasFFI: - PCtx(graph.vm).features = {allowFFI, allowCast} -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: @@ -1786,69 +2386,98 @@ proc myProcess(c: PPassContext, n: PNode): PNode = result = n c.oldErrorCount = c.config.errorCounter -proc myClose(graph: ModuleGraph; c: PPassContext, n: PNode): PNode = - myProcess(c, n) - -const evalPass* = makePass(myOpen, myProcess, myClose) - -proc evalConstExprAux(module: PSym; +proc evalConstExprAux(module: PSym; idgen: IdGenerator; g: ModuleGraph; prc: PSym, n: PNode, mode: TEvalMode): PNode = - let n = transformExpr(g, module, n) - setupGlobalCtx(module, g) + 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) var c = PCtx g.vm let oldMode = c.mode - defer: c.mode = oldMode c.mode = mode let start = genExpr(c, n, requiresValue = mode!=emStaticStmt) if c.code[start].opcode == opcEof: return newNodeI(nkEmpty, n.info) assert c.code[start].opcode != opcEof when debugEchoCode: c.echoCode start 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 + +proc evalConstExpr*(module: PSym; idgen: IdGenerator; g: ModuleGraph; e: PNode): PNode = + result = evalConstExprAux(module, idgen, g, nil, e, emConst) + +proc evalStaticExpr*(module: PSym; idgen: IdGenerator; g: ModuleGraph; e: PNode, prc: PSym): PNode = + result = evalConstExprAux(module, idgen, g, prc, e, emStaticExpr) + +proc evalStaticStmt*(module: PSym; idgen: IdGenerator; g: ModuleGraph; e: PNode, prc: PSym) = + discard evalConstExprAux(module, idgen, g, prc, e, emStaticStmt) + +proc setupCompileTimeVar*(module: PSym; idgen: IdGenerator; g: ModuleGraph; n: PNode) = + discard evalConstExprAux(module, idgen, g, nil, n, emStaticStmt) -proc evalConstExpr*(module: PSym; g: ModuleGraph; e: PNode): PNode = - result = evalConstExprAux(module, g, nil, e, emConst) +proc prepareVMValue(arg: PNode): PNode = + ## strip nkExprColonExpr from tuple values recursively. That is how + ## they are expected to be stored in the VM. -proc evalStaticExpr*(module: PSym; g: ModuleGraph; e: PNode, prc: PSym): PNode = - result = evalConstExprAux(module, g, prc, e, emStaticExpr) + # Early abort without copy. No transformation takes place. + if arg.kind in nkLiterals: + return arg -proc evalStaticStmt*(module: PSym; g: ModuleGraph; e: PNode, prc: PSym) = - discard evalConstExprAux(module, g, prc, e, emStaticStmt) + 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 -proc setupCompileTimeVar*(module: PSym; g: ModuleGraph; n: PNode) = - discard evalConstExprAux(module, g, nil, n, emStaticStmt) + result = copyNode(arg) + if arg.kind == nkTupleConstr: + for child in arg: + if child.kind == nkExprColonExpr: + result.add prepareVMValue(child[1]) + else: + result.add prepareVMValue(child) + else: + for child in arg: + result.add prepareVMValue(child) proc setupMacroParam(x: PNode, typ: PType): TFullReg = case typ.kind of tyStatic: - putIntoReg(result, x) - of tyTypeDesc: - putIntoReg(result, x) + result = TFullReg(kind: rkNone) + putIntoReg(result, prepareVMValue(x)) else: - result.kind = rkNode var n = x - if n.kind in {nkHiddenSubConv, nkHiddenStdConv}: n = n.sons[1] - n = n.canonValue + if n.kind in {nkHiddenSubConv, nkHiddenStdConv}: n = n[1] n.flags.incl nfIsRef n.typ = x.typ - result.node = n + result = TFullReg(kind: rkNode, node: n) iterator genericParamsInMacroCall*(macroSym: PSym, call: PNode): (PSym, PNode) = let gp = macroSym.ast[genericParamsPos] - for i in 0 ..< gp.len: + for i in 0..<gp.len: let genericParam = gp[i].sym - let posInCall = macroSym.typ.len + i - yield (genericParam, call[posInCall]) + 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 evalMacroCall*(module: PSym; g: ModuleGraph; +#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 = + #if g.config.errorCounter > 0: return errorNode(idgen, module, n) + # XXX globalError() is ugly here, but I don't know a better solution for now inc(g.config.evalMacroCounter) if g.config.evalMacroCounter > evalMacroLimit: @@ -1856,15 +2485,18 @@ proc evalMacroCall*(module: PSym; g: ModuleGraph; # 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) + setupGlobalCtx(module, g, idgen) var c = PCtx g.vm + let oldMode = c.mode + c.mode = emStaticStmt c.comesFromHeuristic.line = 0'u16 - c.callsite = nOrig + c.templInstCounter = templInstCounter let start = genProc(c, sym) var tos = PStackFrame(prc: sym, comesFrom: 0, next: nil) @@ -1878,32 +2510,27 @@ proc evalMacroCall*(module: PSym; g: ModuleGraph; #InternalAssert tos.slots.len >= L # return value: - tos.slots[0].kind = rkNode - tos.slots[0].node = newNodeI(nkEmpty, n.info) + 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.sons[i], sym.typ.sons[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: - if sfImmediate notin sym.flags: - let idx = sym.typ.len + i - if idx < n.len: - tos.slots[idx] = setupMacroParam(n.sons[idx], gp[i].sym.typ) - else: - dec(g.config.evalMacroCounter) - c.callsite = nil - localError(c.config, n.info, "expected " & $gp.len & - " generic parameter(s)") - elif gp[i].sym.typ.kind in {tyStatic, tyTypeDesc}: + for i in 0..<gp.len: + let idx = sym.typ.signatureLen + i + if idx < n.len: + tos.slots[idx] = setupMacroParam(n[idx], gp[i].sym.typ) + else: dec(g.config.evalMacroCounter) c.callsite = nil - globalError(c.config, n.info, "static[T] or typedesc nor supported for .immediate macros") + localError(c.config, n.info, "expected " & $gp.len & + " generic parameter(s)") # temporary storage: - #for i in L ..< maxSlots: tos.slots[i] = newNode(nkEmpty) + #for i in L..<maxSlots: tos.slots[i] = newNode(nkEmpty) result = rawExecute(c, start, tos).regToNode if result.info.line < 0: result.info = n.info if cyclicTree(result): globalError(c.config, n.info, "macro produced a cyclic tree") dec(g.config.evalMacroCounter) c.callsite = nil + c.mode = oldMode diff --git a/compiler/vmconv.nim b/compiler/vmconv.nim new file mode 100644 index 000000000..45d925df0 --- /dev/null +++ b/compiler/vmconv.nim @@ -0,0 +1,57 @@ +import ast except elementType +import idents, lineinfos, astalgo +import vmdef +import std/times + +template elementType*(T: typedesc): typedesc = + typeof(block: + var a: T + for ai in a: ai) + +proc fromLit*(a: PNode, T: typedesc): auto = + ## generic PNode => type + ## see also reverse operation `toLit` + when T is set: + result = default(T) + type Ti = elementType(T) + for ai in a: + result.incl Ti(ai.intVal) + else: + static: raiseAssert "not yet supported: " & $T # add as needed + +proc toLit*[T](a: T): PNode = + ## generic type => PNode + ## see also reverse operation `fromLit` + when T is string: newStrNode(nkStrLit, a) + elif T is Ordinal: newIntNode(nkIntLit, a.ord) + elif T is (proc): newNode(nkNilLit) + elif T is ref: + if a == nil: newNode(nkNilLit) + else: toLit(a[]) + elif T is tuple: + result = newTree(nkTupleConstr) + for ai in fields(a): result.add toLit(ai) + elif T is seq: + result = newNode(nkBracket) + for ai in a: + result.add toLit(ai) + elif T is object: + result = newTree(nkObjConstr) + result.add(newNode(nkEmpty)) + for k, ai in fieldPairs(a): + let reti = newNode(nkExprColonExpr) + reti.add k.toLit + reti.add ai.toLit + result.add reti + else: + 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 cec61ade5..bdb0aeed1 100644 --- a/compiler/vmdef.nim +++ b/compiler/vmdef.nim @@ -10,20 +10,44 @@ ## 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 ast, passes, msgs, idents, intsets, options, modulegraphs, lineinfos, - tables, btrees +import std/[tables, strutils] + +import ast, idents, options, modulegraphs, lineinfos + +type TInstrType* = uint64 const + regOBits = 8 # Opcode + regABits = 16 + regBBits = 16 + regCBits = 16 + regBxBits = 24 + byteExcess* = 128 # we use excess-K for immediates - wordExcess* = 32768 - MaxLoopIterations* = 1_000_000_000 # max iterations of all loops +# Calculate register shifts, masks and ranges +const + regOShift* = 0.TInstrType + regAShift* = (regOShift + regOBits) + regBShift* = (regAShift + regABits) + regCShift* = (regBShift + regBBits) + regBxShift* = (regAShift + regABits) + + regOMask* = ((1.TInstrType shl regOBits) - 1) + regAMask* = ((1.TInstrType shl regABits) - 1) + regBMask* = ((1.TInstrType shl regBBits) - 1) + regCMask* = ((1.TInstrType shl regCBits) - 1) + regBxMask* = ((1.TInstrType shl regBxBits) - 1) + + wordExcess* = 1 shl (regBxBits-1) + regBxMin* = -wordExcess+1 + regBxMax* = wordExcess-1 type - TRegister* = range[0..255] - TDest* = range[-1 .. 255] - TInstr* = distinct uint32 + TRegister* = range[0..regAMask.int] + TDest* = range[-1..regAMask.int] + TInstr* = distinct TInstrType TOpcode* = enum opcEof, # end of code @@ -32,16 +56,23 @@ type opcYldVal, # yield with a value opcAsgnInt, - opcAsgnStr, opcAsgnFloat, opcAsgnRef, opcAsgnComplex, - opcRegToNode, + opcCastIntToFloat32, # int and float must be of the same byte size + opcCastIntToFloat64, # int and float must be of the same byte size + opcCastFloatToInt32, # int and float must be of the same byte size + opcCastFloatToInt64, # int and float must be of the same byte size + opcCastPtrToInt, + opcCastIntToPtr, + opcFastAsgnComplex, opcNodeToReg, opcLdArr, # a = b[c] + opcLdArrAddr, # a = addr(b[c]) opcWrArr, # a[b] = c opcLdObj, # a = b.c + opcLdObjAddr, # a = addr(b.c) opcWrObj, # a.b = c opcAddrReg, opcAddrNode, @@ -49,6 +80,8 @@ type opcWrDeref, opcWrStrIdx, opcLdStrIdx, # a = b[c] + opcLdStrIdxAddr, # a = addr(b[c]) + opcSlice, # toOpenArray(collection, left, right) opcAddInt, opcAddImmInt, @@ -56,21 +89,24 @@ type opcSubImmInt, opcLenSeq, opcLenStr, + opcLenCstring, opcIncl, opcInclRange, opcExcl, opcCard, opcMulInt, opcDivInt, opcModInt, - opcAddFloat, opcSubFloat, opcMulFloat, opcDivFloat, opcShrInt, opcShlInt, + opcAddFloat, opcSubFloat, opcMulFloat, opcDivFloat, + opcShrInt, opcShlInt, opcAshrInt, opcBitandInt, opcBitorInt, opcBitxorInt, opcAddu, opcSubu, opcMulu, opcDivu, opcModu, opcEqInt, opcLeInt, opcLtInt, opcEqFloat, opcLeFloat, opcLtFloat, opcLeu, opcLtu, - opcEqRef, opcEqNimrodNode, opcSameNodeType, + opcEqRef, opcEqNimNode, opcSameNodeType, opcXor, opcNot, opcUnaryMinusInt, opcUnaryMinusFloat, opcBitnotInt, - opcEqStr, opcLeStr, opcLtStr, opcEqSet, opcLeSet, opcLtSet, - opcMulSet, opcPlusSet, opcMinusSet, opcSymdiffSet, opcConcatStr, + opcEqStr, opcEqCString, opcLeStr, opcLtStr, opcEqSet, opcLeSet, opcLtSet, + opcMulSet, opcPlusSet, opcMinusSet, opcConcatStr, opcContainsSet, opcRepr, opcSetLenStr, opcSetLenSeq, opcIsNil, opcOf, opcIs, - opcSubStr, opcParseFloat, opcConv, opcCast, - opcQuit, opcReset, + opcParseFloat, opcConv, opcCast, + opcQuit, opcInvalidField, opcNarrowS, opcNarrowU, + opcSignExtend, opcAddStrCh, opcAddStrStr, @@ -87,13 +123,15 @@ type opcNIdent, opcNGetType, opcNStrVal, + opcNSigHash, + opcNGetSize, opcNSetIntVal, - opcNSetFloatVal, opcNSetSymbol, opcNSetIdent, opcNSetType, opcNSetStrVal, + opcNSetFloatVal, opcNSetSymbol, opcNSetIdent, opcNSetStrVal, opcNNewNimNode, opcNCopyNimNode, opcNCopyNimTree, opcNDel, opcGenSym, opcNccValue, opcNccInc, opcNcsAdd, opcNcsIncl, opcNcsLen, opcNcsAt, - opcNctPut, opcNctLen, opcNctGet, opcNctHasNext, opcNctNext, + opcNctPut, opcNctLen, opcNctGet, opcNctHasNext, opcNctNext, opcNodeId, opcSlurp, opcGorge, @@ -103,10 +141,12 @@ type opcNError, opcNWarning, opcNHint, - opcNGetLine, opcNGetColumn, opcNGetFile, + opcNGetLineInfo, opcNCopyLineInfo, opcNSetLineInfoLine, + opcNSetLineInfoColumn, opcNSetLineInfoFile opcEqIdent, opcStrToIdent, opcGetImpl, + opcGetImplTransf opcEcho, opcIndCall, # dest = call regStart, n; where regStart = fn, arg1, ... @@ -135,13 +175,15 @@ type opcAsgnConst, # dest = copy(constants[Bx]) opcLdGlobal, # dest = globals[Bx] opcLdGlobalAddr, # dest = addr(globals[Bx]) + opcLdGlobalDerefFFI, # dest = globals[Bx][] + opcLdGlobalAddrDerefFFI, # globals[Bx][] = ... opcLdImmInt, # dest = immediate value - opcNBindSym, + opcNBindSym, opcNDynBindSym, opcSetType, # dest.typ = types[Bx] opcTypeTrait, - opcMarshalLoad, opcMarshalStore, - opcToNarrowInt + opcSymOwner, + opcSymIsInstantiationOf TBlock* = object label*: PSym @@ -158,7 +200,6 @@ type TSandboxFlag* = enum ## what the evaluation engine should allow allowCast, ## allow unsafe language feature: 'cast' - allowFFI, ## allow the FFI allowInfiniteLoops ## allow endless loops TSandboxFlags* = set[TSandboxFlag] @@ -176,21 +217,32 @@ type slotTempComplex, # some complex temporary (s.node field is used) slotTempPerm # slot is temporary but permanent (hack) + TRegisterKind* = enum + rkNone, rkNode, rkInt, rkFloat, rkRegisterAddr, rkNodeAddr + TFullReg* = object # with a custom mark proc, we could use the same + # data representation as LuaJit (tagged NaNs). + case kind*: TRegisterKind + of rkNone: nil + of rkInt: intVal*: BiggestInt + of rkFloat: floatVal*: BiggestFloat + of rkNode: node*: PNode + of rkRegisterAddr: regAddr*: ptr TFullReg + of rkNodeAddr: nodeAddr*: ptr PNode + 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 - slots*: pointer + slots*: ptr UncheckedArray[TFullReg] currentException*: PNode currentLineInfo*: TLineInfo VmCallback* = proc (args: VmArgs) {.closure.} PCtx* = ref TCtx - TCtx* = object of passes.TPassContext # code gen context + TCtx* = object of TPassContext # code gen context code*: seq[TInstr] debug*: seq[TLineInfo] # line info for every instruction; kept separate # to not slow down interpretation @@ -207,47 +259,77 @@ 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 graph*: ModuleGraph oldErrorCount*: int + 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* {.acyclic.} = object + prc*: PSym # current prc; proc that is evaluated + slots*: seq[TFullReg] # parameters passed to the proc + locals; + # parameters come first + next*: PStackFrame # for stacking + comesFrom*: int + safePoints*: seq[int] # used for exception handling + # XXX 'break' should perform cleanup actions + # What does the C backend do for it? + Profiler* = object + tEnter*: float + tos*: PStackFrame TPosition* = distinct int PEvalContext* = PCtx -proc newCtx*(module: PSym; cache: IdentCache; g: ModuleGraph): PCtx = +proc newCtx*(module: PSym; cache: IdentCache; g: ModuleGraph; idgen: IdGenerator): PCtx = PCtx(code: @[], debug: @[], globals: newNode(nkStmtListExpr), constants: newNode(nkStmtList), types: @[], - prc: PProc(blocks: @[]), module: module, loopIterations: MaxLoopIterations, - comesFromHeuristic: unknownLineInfo(), callbacks: @[], errorFlag: "", - cache: cache, config: g.config, graph: g) + prc: PProc(blocks: @[]), module: module, loopIterations: g.config.maxLoopIterationsVM, + comesFromHeuristic: unknownLineInfo, callbacks: @[], callbackIndex: initTable[string, int](), errorFlag: "", + cache: cache, config: g.config, graph: g, idgen: idgen) -proc refresh*(c: PCtx, module: PSym) = +proc refresh*(c: PCtx, module: PSym; idgen: IdGenerator) = c.module = module c.prc = PProc(blocks: @[]) - c.loopIterations = MaxLoopIterations - -proc registerCallback*(c: PCtx; name: string; callback: VmCallback) = - c.callbacks.add((name, callback)) + 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(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} # flag is used to signal opcSeqLen if node is NimNode. const nimNodeFlag* = 16 -template opcode*(x: TInstr): TOpcode = TOpcode(x.uint32 and 0xff'u32) -template regA*(x: TInstr): TRegister = TRegister(x.uint32 shr 8'u32 and 0xff'u32) -template regB*(x: TInstr): TRegister = TRegister(x.uint32 shr 16'u32 and 0xff'u32) -template regC*(x: TInstr): TRegister = TRegister(x.uint32 shr 24'u32) -template regBx*(x: TInstr): int = (x.uint32 shr 16'u32).int +template opcode*(x: TInstr): TOpcode = TOpcode(x.TInstrType shr regOShift and regOMask) +template regA*(x: TInstr): TRegister = TRegister(x.TInstrType shr regAShift and regAMask) +template regB*(x: TInstr): TRegister = TRegister(x.TInstrType shr regBShift and regBMask) +template regC*(x: TInstr): TRegister = TRegister(x.TInstrType shr regCShift and regCMask) +template regBx*(x: TInstr): int = (x.TInstrType shr regBxShift and regBxMask).int template jmpDiff*(x: TInstr): int = regBx(x) - wordExcess diff --git a/compiler/vmdeps.nim b/compiler/vmdeps.nim index 865ecd36e..294aaaa79 100644 --- a/compiler/vmdeps.nim +++ b/compiler/vmdeps.nim @@ -7,24 +7,31 @@ # distribution, for details about the copyright. # -import ast, types, msgs, os, streams, 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 if not fileExists(filename): - filename = findFile(conf, file) + filename = findFile(conf, file).string result = readFile(filename) # we produce a fake include statement for every slurped filename, so that # the module dependencies are accurate: - appendToModule(module, newNode(nkIncludeStmt, info, @[ - newStrNode(nkStrLit, filename)])) + discard conf.fileInfoIdx(AbsoluteFile filename) + appendToModule(module, newTreeI(nkIncludeStmt, info, newStrNode(nkStrLit, filename))) except IOError: localError(conf, info, "cannot open file: " & file) result = "" -proc atomicTypeX(cache: IdentCache; name: string; m: TMagic; t: PType; info: TLineInfo): PNode = - let sym = newSym(skType, getIdent(cache, name), t.owner, info) +proc atomicTypeX(cache: IdentCache; name: string; m: TMagic; t: PType; info: TLineInfo; + idgen: IdGenerator): PNode = + let sym = newSym(skType, getIdent(cache, name), idgen, t.owner, info) sym.magic = m sym.typ = t result = newSymNode(sym) @@ -34,44 +41,46 @@ proc atomicTypeX(s: PSym; info: TLineInfo): PNode = result = newSymNode(s) result.info = info -proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; +proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; idgen: IdGenerator; inst=false; allowRecursionX=false): PNode proc mapTypeToBracketX(cache: IdentCache; name: string; m: TMagic; t: PType; info: TLineInfo; + idgen: IdGenerator; inst=false): PNode = result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) - result.add atomicTypeX(cache, name, m, t, info) - for i in 0 ..< t.len: - if t.sons[i] == nil: - let void = atomicTypeX(cache, "void", mVoid, t, info) - void.typ = newType(tyVoid, t.owner) - result.add void + result.add atomicTypeX(cache, name, m, t, info, idgen) + 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.sons[i], info, inst) + result.add mapTypeToAstX(cache, a, info, idgen, inst) -proc objectNode(cache: IdentCache; n: PNode): PNode = +proc objectNode(cache: IdentCache; n: PNode; idgen: IdGenerator): PNode = if n.kind == nkSym: result = newNodeI(nkIdentDefs, n.info) result.add n # name - result.add mapTypeToAstX(cache, n.sym.typ, n.info, true, false) # type + result.add mapTypeToAstX(cache, n.sym.typ, n.info, idgen, true, false) # type result.add newNodeI(nkEmpty, n.info) # no assigned value else: result = copyNode(n) - for i in 0 ..< n.safeLen: - result.add objectNode(cache, n[i]) + for i in 0..<n.safeLen: + result.add objectNode(cache, n[i], idgen) proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; + idgen: IdGenerator; inst=false; allowRecursionX=false): PNode = var allowRecursion = allowRecursionX - template atomicType(name, m): untyped = atomicTypeX(cache, name, m, t, info) + 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, inst) - template mapTypeToAstR(t,info): untyped = mapTypeToAstX(cache, t, info, inst, true) - template mapTypeToAst(t,i,info): untyped = - if i<t.len and t.sons[i]!=nil: mapTypeToAstX(cache, t.sons[i], info, inst) + 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 = - mapTypeToBracketX(cache, name, m, t, info, inst) + mapTypeToBracketX(cache, name, m, t, info, idgen, inst) template newNodeX(kind): untyped = newNodeIT(kind, if t.n.isNil: info else: t.n.info, t) template newIdentDefs(n,t): untyped = @@ -82,34 +91,35 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; id template newIdentDefs(s): untyped = newIdentDefs(s, s.typ) - if inst: - if t.sym != nil: # if this node has a symbol - if not allowRecursion: # getTypeInst behavior: return symbol - return atomicType(t.sym) - #else: # getTypeImpl behavior: turn off recursion - # allowRecursion = false + if inst and not allowRecursion and t.sym != nil: + # getTypeInst behavior: return symbol + return atomicType(t.sym) case t.kind of tyNone: result = atomicType("none", mNone) of tyBool: result = atomicType("bool", mBool) of tyChar: result = atomicType("char", mChar) of tyNil: result = atomicType("nil", mNil) - of tyExpr: result = atomicType("expr", mExpr) - of tyStmt: result = atomicType("stmt", mStmt) + of tyUntyped: result = atomicType("untyped", mExpr) + of tyTyped: result = atomicType("typed", mStmt) of tyVoid: result = atomicType("void", mVoid) of tyEmpty: result = atomicType("empty", mNone) + of tyUncheckedArray: + result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) + result.add atomicType("UncheckedArray", mUncheckedArray) + 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.sons[0].kind == tyRange: + if inst and t.indexType.kind == tyRange: var rng = newNodeX(nkInfix) rng.add newIdentNode(getIdent(cache, ".."), info) - rng.add t.sons[0].n.sons[0].copyTree - rng.add t.sons[0].n.sons[1].copyTree + rng.add t.indexType.n[0].copyTree + rng.add t.indexType.n[1].copyTree result.add rng else: - result.add mapTypeToAst(t.sons[0], info) - result.add mapTypeToAst(t.sons[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) @@ -119,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.sons[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.sons[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, 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, 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.sons[0], info) + result.add mapTypeToAst(t.skipModifier, info) else: if allowRecursion or t.sym == nil: result = mapTypeToBracket("distinct", mDistinct, t, info) @@ -156,24 +170,28 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; of tyObject: if inst: result = newNodeX(nkObjectTy) - result.add newNodeI(nkEmpty, info) # pragmas not reconstructed yet - if t.sons[0] == nil: result.add newNodeI(nkEmpty, info) # handle parent object - else: + var objectDef = t.sym.ast[2] + if objectDef.kind == nkRefTy: + objectDef = objectDef[0] + result.add objectDef[0].copyTree # copy object pragmas + if t.baseClass == nil: + result.add newNodeI(nkEmpty, info) + else: # handle parent object var nn = newNodeX(nkOfInherit) - nn.add mapTypeToAst(t.sons[0], info) + nn.add mapTypeToAst(t.baseClass, info) result.add nn if t.n.len > 0: - result.add objectNode(cache, t.n) + result.add objectNode(cache, t.n, idgen) else: result.add newNodeI(nkEmpty, info) else: 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.sons[0] == nil: + if t.baseClass == nil: result.add newNodeI(nkEmpty, info) else: - result.add mapTypeToAst(t.sons[0], info) + result.add mapTypeToAst(t.baseClass, info) result.add copyTree(t.n) else: result = atomicType(t.sym) @@ -187,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) @@ -199,48 +217,63 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; of tyPtr: if inst: result = newNodeX(nkPtrTy) - result.add mapTypeToAst(t.sons[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.sons[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.sons[0], info) + result.add mapTypeToAst(t.elementType, info) else: result = mapTypeToBracket("var", mVar, t, info) of tyLent: result = mapTypeToBracket("lent", mBuiltinType, t, info) of tySink: result = mapTypeToBracket("sink", mBuiltinType, t, info) of tySequence: result = mapTypeToBracket("seq", mSeq, t, info) - of tyOpt: result = mapTypeToBracket("opt", mOpt, 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.sons[0] == nil: + if t.returnType == nil: fp.add newNodeI(nkEmpty, info) else: - fp.add mapTypeToAst(t.sons[0], t.n[0].info) - for i in 1..<t.sons.len: - fp.add newIdentDefs(t.n[i], t.sons[i]) + 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 newNodeI(nkEmpty, info) # pragmas aren't reconstructed yet + 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) of tyRange: result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) result.add atomicType("range", mRange) - result.add t.n.sons[0].copyTree - result.add t.n.sons[1].copyTree + if inst and t.n.len == 2: + let rng = newNodeX(nkInfix) + rng.add newIdentNode(getIdent(cache, ".."), info) + rng.add t.n[0].copyTree + rng.add t.n[1].copyTree + result.add rng + else: + result.add t.n[0].copyTree + if t.n.len > 1: + 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) @@ -250,18 +283,18 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; of tyFloat32: result = atomicType("float32", mFloat32) of tyFloat64: result = atomicType("float64", mFloat64) of tyFloat128: result = atomicType("float128", mFloat128) - of tyUInt: result = atomicType("uint", mUint) - of tyUInt8: result = atomicType("uint8", mUint8) - of tyUInt16: result = atomicType("uint16", mUint16) - of tyUInt32: result = atomicType("uint32", mUint32) - of tyUInt64: result = atomicType("uint64", mUint64) + of tyUInt: result = atomicType("uint", mUInt) + of tyUInt8: result = atomicType("uint8", mUInt8) + of tyUInt16: result = atomicType("uint16", mUInt16) + 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 @@ -270,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 @@ -281,17 +315,20 @@ proc mapTypeToAstX(cache: IdentCache; t: PType; info: TLineInfo; result.add atomicType("static", mNone) if t.n != nil: result.add t.n.copyTree - of tyUnused, tyOptAsRef: assert(false, "mapTypeToAstX") + of tyOwned: result = mapTypeToBracket("owned", mBuiltinType, t, info) + of tyConcept: + result = mapTypeToBracket("concept", mNone, t, info) + result.add t.n.copyTree -proc opMapTypeToAst*(cache: IdentCache; t: PType; info: TLineInfo): PNode = - result = mapTypeToAstX(cache, t, info, false, true) +proc opMapTypeToAst*(cache: IdentCache; t: PType; info: TLineInfo; idgen: IdGenerator): PNode = + result = mapTypeToAstX(cache, t, info, idgen, inst=false, allowRecursionX=true) # the "Inst" version includes generic parameters in the resulting type tree # and also tries to look like the corresponding Nim type declaration -proc opMapTypeInstToAst*(cache: IdentCache; t: PType; info: TLineInfo): PNode = - result = mapTypeToAstX(cache, t, info, true, false) +proc opMapTypeInstToAst*(cache: IdentCache; t: PType; info: TLineInfo; idgen: IdGenerator): PNode = + result = mapTypeToAstX(cache, t, info, idgen, inst=true, allowRecursionX=false) # the "Impl" version includes generic parameters in the resulting type tree # and also tries to look like the corresponding Nim type implementation -proc opMapTypeImplToAst*(cache: IdentCache; t: PType; info: TLineInfo): PNode = - result = mapTypeToAstX(cache, t, info, true, true) +proc opMapTypeImplToAst*(cache: IdentCache; t: PType; info: TLineInfo; idgen: IdGenerator): PNode = + result = mapTypeToAstX(cache, t, info, idgen, inst=true, allowRecursionX=true) diff --git a/compiler/vmgen.nim b/compiler/vmgen.nim index d2243376c..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,23 +26,41 @@ # 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, astalgo, types, msgs, renderer, vmdef, - trees, intsets, magicsys, options, lowerings, lineinfos -import platform -from os import splitFile + 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) + +when debugEchoCode: + import std/private/asciitables when hasFFI: import evalffi type - TGenFlag = enum gfAddrOf, gfFieldAccess + TGenFlag = enum + 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 = - result = toFilename(c.config, info).splitFile.name & ":" & $info.line + result = toFileLineCol(c.config, info) proc codeListing(c: PCtx, result: var string, start=0; last = -1) = + ## for debugging purposes # first iteration: compute all necessary labels: var jumpTargets = initIntSet() let last = if last < 0: c.code.len-1 else: min(last, c.code.len-1) @@ -52,7 +69,9 @@ proc codeListing(c: PCtx, result: var string, start=0; last = -1) = if x.opcode in relativeJumps: jumpTargets.incl(i+x.regBx-wordExcess) - # for debugging purposes + template toStr(opc: TOpcode): string = ($opc).substr(3) + + result.add "code listing:\n" var i = start while i <= last: if i in jumpTargets: result.addf("L$1:\n", i) @@ -60,48 +79,52 @@ proc codeListing(c: PCtx, result: var string, start=0; last = -1) = result.add($i) let opc = opcode(x) - if opc in {opcConv, opcCast}: + if opc in {opcIndCall, opcIndCallAsgn}: + result.addf("\t$#\tr$#, r$#, nargs:$#", opc.toStr, x.regA, + x.regB, x.regC) + elif opc in {opcConv, opcCast}: let y = c.code[i+1] let z = c.code[i+2] - result.addf("\t$#\tr$#, r$#, $#, $#", ($opc).substr(3), x.regA, x.regB, + result.addf("\t$#\tr$#, r$#, $#, $#", opc.toStr, x.regA, x.regB, c.types[y.regBx-wordExcess].typeToString, c.types[z.regBx-wordExcess].typeToString) inc i, 2 elif opc < firstABxInstr: - result.addf("\t$#\tr$#, r$#, r$#", ($opc).substr(3), x.regA, + result.addf("\t$#\tr$#, r$#, r$#", opc.toStr, x.regA, x.regB, x.regC) - elif opc in relativeJumps: - result.addf("\t$#\tr$#, L$#", ($opc).substr(3), x.regA, + elif opc in relativeJumps + {opcTry}: + result.addf("\t$#\tr$#, L$#", opc.toStr, x.regA, i+x.regBx-wordExcess) + elif opc in {opcExcept}: + let idx = x.regBx-wordExcess + result.addf("\t$#\t$#, $#", opc.toStr, x.regA, $idx) elif opc in {opcLdConst, opcAsgnConst}: let idx = x.regBx-wordExcess - result.addf("\t$#\tr$#, $# ($#)", ($opc).substr(3), x.regA, + 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).substr(3), x.regA, x.regB, - c.types[y.regBx-wordExcess].typeToString) - inc i else: - result.addf("\t$#\tr$#, $#", ($opc).substr(3), x.regA, x.regBx-wordExcess) - result.add("\t#") + result.addf("\t$#\tr$#, $#", opc.toStr, x.regA, x.regBx-wordExcess) + result.add("\t# ") result.add(debugInfo(c, c.debug[i])) result.add("\n") inc i + when debugEchoCode: + result = result.alignTable proc echoCode*(c: PCtx; start=0; last = -1) {.deprecated.} = var buf = "" 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 assert opc.ord < 255 - let ins = (opc.uint32 or (a.uint32 shl 8'u32) or - (b.uint32 shl 16'u32) or - (c.uint32 shl 24'u32)).TInstr + let ins = (opc.TInstrType or (a.TInstrType shl regAShift) or + (b.TInstrType shl regBShift) or + (c.TInstrType shl regCShift)).TInstr when false: if ctx.code.len == 43: writeStackTrace() @@ -110,13 +133,13 @@ proc gABC(ctx: PCtx; n: PNode; opc: TOpcode; a, b, c: TRegister = 0) = ctx.debug.add(n.info) proc gABI(c: PCtx; n: PNode; opc: TOpcode; a, b: TRegister; imm: BiggestInt) = - # Takes the `b` register and the immediate `imm`, appies the operation `opc`, + # Takes the `b` register and the immediate `imm`, applies the operation `opc`, # and stores the output value into `a`. # `imm` is signed and must be within [-128, 127] if imm >= -128 and imm <= 127: - let ins = (opc.uint32 or (a.uint32 shl 8'u32) or - (b.uint32 shl 16'u32) or - (imm+byteExcess).uint32 shl 24'u32).TInstr + let ins = (opc.TInstrType or (a.TInstrType shl regAShift) or + (b.TInstrType shl regBShift) or + (imm+byteExcess).TInstrType shl regCShift).TInstr c.code.add(ins) c.debug.add(n.info) else: @@ -125,20 +148,20 @@ proc gABI(c: PCtx; n: PNode; opc: TOpcode; a, b: TRegister; imm: BiggestInt) = proc gABx(c: PCtx; n: PNode; opc: TOpcode; a: TRegister = 0; bx: int) = # Applies `opc` to `bx` and stores it into register `a` - # `bx` must be signed and in the range [-32768, 32767] + # `bx` must be signed and in the range [regBxMin, regBxMax] when false: if c.code.len == 43: writeStackTrace() echo "generating ", opc - if bx >= -32768 and bx <= 32767: - let ins = (opc.uint32 or a.uint32 shl 8'u32 or - (bx+wordExcess).uint32 shl 16'u32).TInstr + if bx >= regBxMin-1 and bx <= regBxMax: + let ins = (opc.TInstrType or a.TInstrType shl regAShift or + (bx+wordExcess).TInstrType shl regBxShift).TInstr c.code.add(ins) c.debug.add(n.info) else: localError(c.config, n.info, - "VM: immediate value does not fit into an int16") + "VM: immediate value does not fit into regBx") proc xjmp(c: PCtx; n: PNode; opc: TOpcode; a: TRegister = 0): TPosition = #assert opc in {opcJmp, opcFJmp, opcTJmp} @@ -151,7 +174,7 @@ proc genLabel(c: PCtx): TPosition = proc jmpBack(c: PCtx, n: PNode, p = TPosition(0)) = let dist = p.int - c.code.len - internalAssert(c.config, -0x7fff < dist and dist < 0x7fff) + internalAssert(c.config, regBxMin < dist and dist < regBxMax) gABx(c, n, opcJmpBack, 0, dist) proc patch(c: PCtx, p: TPosition) = @@ -159,17 +182,17 @@ proc patch(c: PCtx, p: TPosition) = let p = p.int let diff = c.code.len - p #c.jumpTargets.incl(c.code.len) - internalAssert(c.config, -0x7fff < diff and diff < 0x7fff) + internalAssert(c.config, regBxMin < diff and diff < regBxMax) let oldInstr = c.code[p] # opcode and regA stay the same: - c.code[p] = ((oldInstr.uint32 and 0xffff'u32).uint32 or - uint32(diff+wordExcess) shl 16'u32).TInstr + c.code[p] = ((oldInstr.TInstrType and regBxMask).TInstrType or + TInstrType(diff+wordExcess) shl regBxShift).TInstr 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 @@ -180,56 +203,75 @@ const HighRegisterPressure = 40 proc bestEffort(c: PCtx): TLineInfo = - (if c.prc == nil: c.module.info else: c.prc.sym.info) + if c.prc != nil and c.prc.sym != nil: + c.prc.sym.info + else: + c.module.info -proc getTemp(cc: PCtx; tt: PType): TRegister = - let typ = tt.skipTypesOrNil({tyStatic}) +proc getFreeRegister(cc: PCtx; k: TSlotKind; start: int): TRegister = let c = cc.prc # 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]: - let k = if typ.isNil: slotTempComplex else: typ.getSlotKind - for i in 0 .. 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 >= HighRegisterPressure and false: - for i in 0 .. 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(c.maxSlots) - c.slots[c.maxSlots] = (inUse: true, kind: k) - inc c.maxSlots + 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}) + # 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]: + let k = if typ.isNil: slotTempComplex else: typ.getSlotKind + result = getFreeRegister(cc, k, start = 0) + when false: + # enable this to find "register" leaks: + if result == 4: + echo "begin ---------------" + writeStackTrace() + echo "end ----------------" proc freeTemp(c: PCtx; r: TRegister) = let c = c.prc - if c.slots[r].kind in {slotSomeTemp..slotTempComplex}: c.slots[r].inUse = false + if r < c.regInfo.len and c.regInfo[r].kind in {slotSomeTemp..slotTempComplex}: + # this seems to cause https://github.com/nim-lang/Nim/issues/10647 + c.regInfo[r].inUse = false proc getTempRange(cc: PCtx; n: int; kind: TSlotKind): TRegister = # if register pressure is high, we re-use more aggressively: let c = cc.prc - if c.maxSlots >= HighRegisterPressure or c.maxSlots+n >= high(TRegister): - for i in 0 .. c.maxSlots-n: - if not c.slots[i].inUse: + # we could also customize via the following (with proper caching in ConfigRef): + # let highRegisterPressure = cc.config.getConfigVar("vm.highRegisterPressure", "40").parseInt + 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 + for j in i+1..i+n-1: + 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)) + for i in start..start+n-1: c.freeTemp(TRegister(i)) template withTemp(tmp, typ, body: untyped) {.dirty.} = var tmp = getTemp(c, typ) @@ -256,7 +298,9 @@ proc gen(c: PCtx; n: PNode; dest: TRegister; flags: TGenFlags = {}) = proc gen(c: PCtx; n: PNode; flags: TGenFlags = {}) = var tmp: TDest = -1 gen(c, n, tmp, flags) - #if n.typ.isEmptyType: InternalAssert tmp < 0 + if tmp >= 0: + freeTemp(c, tmp) + #if n.typ.isEmptyType: internalAssert tmp < 0 proc genx(c: PCtx; n: PNode; flags: TGenFlags = {}): TRegister = var tmp: TDest = -1 @@ -264,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. @@ -273,112 +319,139 @@ proc clearDest(c: PCtx; n: PNode; dest: var TDest) {.inline.} = dest = -1 proc isNotOpr(n: PNode): bool = - n.kind in nkCallKinds and n.sons[0].kind == nkSym and - n.sons[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 + n.kind in nkCallKinds and n[0].kind == nkSym and + n[0].sym.magic == mNot proc genWhile(c: PCtx; n: PNode) = - # L1: + # lab1: # cond, tmp - # fjmp tmp, L2 + # fjmp tmp, lab2 # body - # jmp L1 - # L2: - let L1 = c.genLabel + # jmp lab1 + # lab2: + let lab1 = c.genLabel withBlock(nil): - if isTrue(n.sons[0]): - c.gen(n.sons[1]) - c.jmpBack(n, L1) - elif isNotOpr(n.sons[0]): - var tmp = c.genx(n.sons[0].sons[1]) - let L2 = c.xjmp(n, opcTJmp, tmp) + if isTrue(n[0]): + c.gen(n[1]) + c.jmpBack(n, lab1) + elif isNotOpr(n[0]): + var tmp = c.genx(n[0][1]) + let lab2 = c.xjmp(n, opcTJmp, tmp) c.freeTemp(tmp) - c.gen(n.sons[1]) - c.jmpBack(n, L1) - c.patch(L2) + c.gen(n[1]) + c.jmpBack(n, lab1) + c.patch(lab2) else: - var tmp = c.genx(n.sons[0]) - let L2 = c.xjmp(n, opcFJmp, tmp) + var tmp = c.genx(n[0]) + let lab2 = c.xjmp(n, opcFJmp, tmp) c.freeTemp(tmp) - c.gen(n.sons[1]) - c.jmpBack(n, L1) - c.patch(L2) + c.gen(n[1]) + c.jmpBack(n, lab1) + c.patch(lab2) proc genBlock(c: PCtx; n: PNode; dest: var TDest) = - withBlock(n.sons[0].sym): - c.gen(n.sons[1], dest) + let oldRegisterCount = c.prc.regInfo.len + withBlock(n[0].sym): + c.gen(n[1], dest) + + 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.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) proc genBreak(c: PCtx; n: PNode) = - let L1 = c.xjmp(n, opcJmp) - if n.sons[0].kind == nkSym: - #echo cast[int](n.sons[0].sym) + let lab1 = c.xjmp(n, opcJmp) + if n[0].kind == nkSym: + #echo cast[int](n[0].sym) for i in countdown(c.prc.blocks.len-1, 0): - if c.prc.blocks[i].label == n.sons[0].sym: - c.prc.blocks[i].fixups.add L1 + if c.prc.blocks[i].label == n[0].sym: + c.prc.blocks[i].fixups.add lab1 return globalError(c.config, n.info, "VM problem: cannot find 'break' target") else: - c.prc.blocks[c.prc.blocks.high].fixups.add L1 + c.prc.blocks[c.prc.blocks.high].fixups.add lab1 proc genIf(c: PCtx, n: PNode; dest: var TDest) = - # if (!expr1) goto L1; + # if (!expr1) goto lab1; # thenPart # goto LEnd - # L1: - # if (!expr2) goto L2; + # lab1: + # if (!expr2) goto lab2; # thenPart2 # goto LEnd - # L2: + # lab2: # elsePart # Lend: if dest < 0 and not isEmptyType(n.typ): dest = getTemp(c, n.typ) var endings: seq[TPosition] = @[] - for i in countup(0, len(n) - 1): - var it = n.sons[i] + for i in 0..<n.len: + var it = n[i] if it.len == 2: - withTemp(tmp, it.sons[0].typ): + withTemp(tmp, it[0].typ): var elsePos: TPosition - if isNotOpr(it.sons[0]): - c.gen(it.sons[0].sons[1], tmp) - elsePos = c.xjmp(it.sons[0].sons[1], opcTJmp, tmp) # if true + if isNotOpr(it[0]): + c.gen(it[0][1], tmp) + elsePos = c.xjmp(it[0][1], opcTJmp, tmp) # if true else: - c.gen(it.sons[0], tmp) - elsePos = c.xjmp(it.sons[0], opcFJmp, tmp) # if false + c.gen(it[0], tmp) + elsePos = c.xjmp(it[0], opcFJmp, tmp) # if false c.clearDest(n, dest) - c.gen(it.sons[1], dest) # then part - if i < sonsLen(n)-1: - endings.add(c.xjmp(it.sons[1], opcJmp, 0)) + 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.sons[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.regInfo[dest].kind >= slotTempUnknown + proc genAndOr(c: PCtx; n: PNode; opc: TOpcode; dest: var TDest) = # asgn dest, a - # tjmp|fjmp L1 + # tjmp|fjmp lab1 # asgn dest, b - # L1: - if dest < 0: dest = getTemp(c, n.typ) - c.gen(n.sons[1], dest) - let L1 = c.xjmp(n, opc, dest) - c.gen(n.sons[2], dest) - c.patch(L1) - -proc canonValue*(n: PNode): PNode = - result = n + # lab1: + let copyBack = dest < 0 or not isTemp(c, dest) + let tmp = if copyBack: + getTemp(c, n.typ) + else: + TRegister dest + c.gen(n[1], tmp) + let lab1 = c.xjmp(n, opc, tmp) + c.gen(n[2], tmp) + c.patch(lab1) + if dest < 0: + dest = tmp + elif copyBack: + c.gABC(n, opcAsgnInt, dest, tmp) + freeTemp(c, tmp) proc rawGenLiteral(c: PCtx; n: PNode): int = result = c.constants.len #assert(n.kind != nkCall) n.flags.incl nfAllConst - c.constants.add n.canonValue - internalAssert c.config, result < 0x7fff + n.flags.excl nfIsRef + c.constants.add n + internalAssert c.config, result < regBxMax proc sameConstant*(a, b: PNode): bool = result = false @@ -389,19 +462,24 @@ proc sameConstant*(a, b: PNode): bool = of nkSym: result = a.sym == b.sym of nkIdent: result = a.ident.id == b.ident.id of nkCharLit..nkUInt64Lit: result = a.intVal == b.intVal - of nkFloatLit..nkFloat64Lit: result = a.floatVal == b.floatVal + of nkFloatLit..nkFloat64Lit: + result = cast[uint64](a.floatVal) == cast[uint64](b.floatVal) + # refs bug #16469 + # if we wanted to only distinguish 0.0 vs -0.0: + # if a.floatVal == 0.0: result = cast[uint64](a.floatVal) == cast[uint64](b.floatVal) + # else: result = a.floatVal == b.floatVal of nkStrLit..nkTripleStrLit: result = a.strVal == b.strVal of nkType, nkNilLit: result = a.typ == b.typ of nkEmpty: result = true else: - if sonsLen(a) == sonsLen(b): - for i in countup(0, sonsLen(a) - 1): - if not sameConstant(a.sons[i], b.sons[i]): return + if a.len == b.len: + for i in 0..<a.len: + if not sameConstant(a[i], b[i]): return result = true proc genLiteral(c: PCtx; n: PNode): int = # types do not matter here: - for i in 0 ..< c.constants.len: + for i in 0..<c.constants.len: if sameConstant(c.constants[i], n): return i result = rawGenLiteral(c, n) @@ -411,14 +489,14 @@ proc unused(c: PCtx; n: PNode; x: TDest) {.inline.} = globalError(c.config, n.info, "not unused") proc genCase(c: PCtx; n: PNode; dest: var TDest) = - # if (!expr1) goto L1; + # if (!expr1) goto lab1; # thenPart # goto LEnd - # L1: - # if (!expr2) goto L2; + # lab1: + # if (!expr2) goto lab2; # thenPart2 # goto LEnd - # L2: + # lab2: # elsePart # Lend: if not isEmptyType(n.typ): @@ -426,22 +504,33 @@ proc genCase(c: PCtx; n: PNode; dest: var TDest) = else: unused(c, n, dest) var endings: seq[TPosition] = @[] - withTemp(tmp, n.sons[0].typ): - c.gen(n.sons[0], tmp) + withTemp(tmp, n[0].typ): + c.gen(n[0], tmp) # branch tmp, codeIdx # fjmp elseLabel - for i in 1 ..< n.len: - let it = n.sons[i] + for i in 1..<n.len: + let it = n[i] if it.len == 1: # else stmt: - c.gen(it.sons[0], dest) + 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 + 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) - if i < sonsLen(n)-1: - endings.add(c.xjmp(it.lastSon, opcJmp, 0)) + 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(body, opcJmp, 0)) c.patch(elsePos) c.clearDest(n, dest) for endPos in endings: c.patch(endPos) @@ -451,51 +540,61 @@ proc genType(c: PCtx; typ: PType): int = if sameType(t, typ): return i result = c.types.len c.types.add(typ) - internalAssert(c.config, result <= 0x7fff) + internalAssert(c.config, result <= regBxMax) proc genTry(c: PCtx; n: PNode; dest: var TDest) = if dest < 0 and not isEmptyType(n.typ): dest = getTemp(c, n.typ) var endings: seq[TPosition] = @[] - let elsePos = c.xjmp(n, opcTry, 0) - c.gen(n.sons[0], dest) + let ehPos = c.xjmp(n, opcTry, 0) + 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) - c.patch(elsePos) - for i in 1 ..< n.len: - let it = n.sons[i] + # Add a jump past the exception handling code + let jumpToFinally = c.xjmp(n, opcJmp, 0) + # This signals where the body ends and where the exception handling begins + c.patch(ehPos) + for i in 1..<n.len: + let it = n[i] if it.kind != nkFinally: - var blen = len(it) # first opcExcept contains the end label of the 'except' block: let endExcept = c.xjmp(it, opcExcept, 0) - for j in countup(0, blen - 2): - assert(it.sons[j].kind == nkType) - let typ = it.sons[j].typ.skipTypes(abstractPtrs-{tyTypeDesc}) + for j in 0..<it.len - 1: + assert(it[j].kind == nkType) + let typ = it[j].typ.skipTypes(abstractPtrs-{tyTypeDesc}) c.gABx(it, opcExcept, 0, c.genType(typ)) - if blen == 1: + 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 < sonsLen(n)-1: + if i < n.len: endings.add(c.xjmp(it, opcJmp, 0)) c.patch(endExcept) - for endPos in endings: c.patch(endPos) let fin = lastSon(n) # we always generate an 'opcFinally' as that pops the safepoint - # from the stack + # from the stack if no exception is raised in the body. + c.patch(jumpToFinally) c.gABx(fin, opcFinally, 0, 0) + for endPos in endings: c.patch(endPos) if fin.kind == nkFinally: - c.gen(fin.sons[0]) + c.gen(fin[0]) c.clearDest(n, dest) c.gABx(fin, opcFinallyEnd, 0, 0) proc genRaise(c: PCtx; n: PNode) = - let dest = genx(c, n.sons[0]) + let dest = genx(c, n[0]) c.gABC(n, opcRaise, dest) c.freeTemp(dest) proc genReturn(c: PCtx; n: PNode) = - if n.sons[0].kind != nkEmpty: - gen(c, n.sons[0]) + if n[0].kind != nkEmpty: + gen(c, n[0]) c.gABC(n, opcRet) @@ -504,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) @@ -514,19 +613,25 @@ proc genCall(c: PCtx; n: PNode; dest: var TDest) = #if n.typ != nil and n.typ.sym != nil and n.typ.sym.magic == mPNimrodNode: # genLit(c, n, dest) # return + # bug #10901: do not produce code for wrong call expressions: + if n.len == 0 or n[0].typ.isNil: return if dest < 0 and not isEmptyType(n.typ): dest = getTemp(c, n.typ) let x = c.getTempRange(n.len, slotTempUnknown) # varargs need 'opcSetType' for the FFI support: - let fntyp = skipTypes(n.sons[0].typ, abstractInst) + let fntyp = skipTypes(n[0].typ, abstractInst) for i in 0..<n.len: - #if i > 0 and i < sonsLen(fntyp): - # let paramType = fntyp.n.sons[i] - # if paramType.typ.isCompileTimeOnly: continue var r: TRegister = x+i - c.gen(n.sons[i], r) - 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.sons[i].typ)) + 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: @@ -544,74 +649,95 @@ proc genField(c: PCtx; n: PNode): TRegister = if n.kind != nkSym or n.sym.kind != skField: globalError(c.config, n.info, "no field symbol") let s = n.sym - if s.position > high(result): + if s.position > high(typeof(result)): globalError(c.config, n.info, "too large offset! cannot generate code for: " & s.name.s) result = s.position proc genIndex(c: PCtx; n: PNode; arr: PType): TRegister = if arr.skipTypes(abstractInst).kind == tyArray and (let x = firstOrd(c.config, arr); - x != 0): + x != Zero): let tmp = c.genx(n) # freeing the temporary here means we can produce: regA = regA - Imm c.freeTemp(tmp) result = c.getTemp(n.typ) - c.gABI(n, opcSubImmInt, result, tmp, x.int) + c.gABI(n, opcSubImmInt, result, tmp, toInt(x)) else: result = c.genx(n) +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.sons[0], {gfAddrOf, gfFieldAccess}) - let idx = c.genIndex(le.sons[1], le.sons[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 nkDotExpr, nkCheckedFieldExpr: - # XXX field checks here - let left = if le.kind == nkDotExpr: le else: le.sons[0] - let dest = c.genx(left.sons[0], {gfAddrOf, gfFieldAccess}) - let idx = genField(c, left.sons[1]) - c.gABC(left, opcWrObj, dest, idx, value) + of nkCheckedFieldExpr: + var objR: TDest = -1 + genCheckedObjAccessAux(c, le, objR, {gfNode}) + let idx = genField(c, le[0][1]) + c.gABC(le[0], opcWrObj, objR, idx, value) + c.freeTemp(objR) + of nkDotExpr: + let dest = c.genx(le[0], {gfNode}) + let idx = genField(c, le[1]) + c.gABC(le, opcWrObj, dest, idx, value) c.freeTemp(dest) of nkDerefExpr, nkHiddenDeref: - let dest = c.genx(le.sons[0], {gfAddrOf}) + let dest = c.genx(le[0], {gfNode}) c.gABC(le, opcWrDeref, dest, 0, value) c.freeTemp(dest) of nkSym: if le.sym.isGlobal: - let dest = c.genx(le, {gfAddrOf}) + 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 proc genNew(c: PCtx; n: PNode) = - let dest = if needsAsgnPatch(n.sons[1]): c.getTemp(n.sons[1].typ) - else: c.genx(n.sons[1]) + let dest = if needsAsgnPatch(n[1]): c.getTemp(n[1].typ) + else: c.genx(n[1]) # we use the ref's base type here as the VM conflates 'ref object' # and 'object' since internally we already have a pointer. c.gABx(n, opcNew, dest, - c.genType(n.sons[1].typ.skipTypes(abstractVar-{tyTypeDesc}).sons[0])) - c.genAsgnPatch(n.sons[1], dest) + c.genType(n[1].typ.skipTypes(abstractVar-{tyTypeDesc})[0])) + c.genAsgnPatch(n[1], dest) c.freeTemp(dest) proc genNewSeq(c: PCtx; n: PNode) = - let t = n.sons[1].typ - let dest = if needsAsgnPatch(n.sons[1]): c.getTemp(t) - else: c.genx(n.sons[1]) - let tmp = c.genx(n.sons[2]) + let t = n[1].typ + let dest = if needsAsgnPatch(n[1]): c.getTemp(t) + else: c.genx(n[1]) + let tmp = c.genx(n[2]) c.gABx(n, opcNewSeq, dest, c.genType(t.skipTypes( abstractVar-{tyTypeDesc}))) c.gABx(n, opcNewSeq, tmp, 0) c.freeTemp(tmp) - c.genAsgnPatch(n.sons[1], dest) + c.genAsgnPatch(n[1], dest) c.freeTemp(dest) proc genNewSeqOfCap(c: PCtx; n: PNode; dest: var TDest) = let t = n.typ - let tmp = c.getTemp(n.sons[1].typ) + if dest < 0: + dest = c.getTemp(n.typ) + let tmp = c.getTemp(n[1].typ) c.gABx(n, opcLdNull, dest, c.genType(t)) c.gABx(n, opcLdImmInt, tmp, 0) c.gABx(n, opcNewSeq, dest, c.genType(t.skipTypes( @@ -620,21 +746,22 @@ proc genNewSeqOfCap(c: PCtx; n: PNode; dest: var TDest) = c.freeTemp(tmp) proc genUnaryABC(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode) = - let tmp = c.genx(n.sons[1]) + let tmp = c.genx(n[1]) if dest < 0: dest = c.getTemp(n.typ) c.gABC(n, opc, dest, tmp) c.freeTemp(tmp) proc genUnaryABI(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode; imm: BiggestInt=0) = - let tmp = c.genx(n.sons[1]) + let tmp = c.genx(n[1]) if dest < 0: dest = c.getTemp(n.typ) c.gABI(n, opc, dest, tmp, imm) c.freeTemp(tmp) + proc genBinaryABC(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode) = let - tmp = c.genx(n.sons[1]) - tmp2 = c.genx(n.sons[2]) + tmp = c.genx(n[1]) + tmp2 = c.genx(n[2]) if dest < 0: dest = c.getTemp(n.typ) c.gABC(n, opc, dest, tmp, tmp2) c.freeTemp(tmp) @@ -642,9 +769,9 @@ proc genBinaryABC(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode) = proc genBinaryABCD(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode) = let - tmp = c.genx(n.sons[1]) - tmp2 = c.genx(n.sons[2]) - tmp3 = c.genx(n.sons[3]) + tmp = c.genx(n[1]) + tmp2 = c.genx(n[2]) + tmp3 = c.genx(n[3]) if dest < 0: dest = c.getTemp(n.typ) c.gABC(n, opc, dest, tmp, tmp2) c.gABC(n, opc, tmp3) @@ -652,22 +779,27 @@ proc genBinaryABCD(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode) = c.freeTemp(tmp2) c.freeTemp(tmp3) +template sizeOfLikeMsg(name): string = + "'$1' requires '.importc' types to be '.completeStruct'" % [name] + 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) @@ -684,69 +816,87 @@ proc genSetType(c: PCtx; n: PNode; dest: TRegister) = proc genBinarySet(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode) = let - tmp = c.genx(n.sons[1]) - tmp2 = c.genx(n.sons[2]) + tmp = c.genx(n[1]) + tmp2 = c.genx(n[2]) if dest < 0: dest = c.getTemp(n.typ) - c.genSetType(n.sons[1], tmp) - c.genSetType(n.sons[2], tmp2) + c.genSetType(n[1], tmp) + c.genSetType(n[2], tmp2) c.gABC(n, opc, dest, tmp, tmp2) c.freeTemp(tmp) c.freeTemp(tmp2) proc genBinaryStmt(c: PCtx; n: PNode; opc: TOpcode) = let - dest = c.genx(n.sons[1]) - tmp = c.genx(n.sons[2]) + dest = c.genx(n[1]) + tmp = c.genx(n[2]) c.gABC(n, opc, dest, tmp, 0) c.freeTemp(tmp) + c.freeTemp(dest) proc genBinaryStmtVar(c: PCtx; n: PNode; opc: TOpcode) = - var x = n.sons[1] - if x.kind in {nkAddr, nkHiddenAddr}: x = x.sons[0] + var x = n[1] + if x.kind in {nkAddr, nkHiddenAddr}: x = x[0] let dest = c.genx(x) - tmp = c.genx(n.sons[2]) + tmp = c.genx(n[2]) c.gABC(n, opc, dest, tmp, 0) - #c.genAsgnPatch(n.sons[1], dest) + #c.genAsgnPatch(n[1], dest) c.freeTemp(tmp) + c.freeTemp(dest) proc genUnaryStmt(c: PCtx; n: PNode; opc: TOpcode) = - let tmp = c.genx(n.sons[1]) + let tmp = c.genx(n[1]) c.gABC(n, opc, tmp, 0, 0) c.freeTemp(tmp) proc genVarargsABC(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode) = if dest < 0: dest = getTemp(c, n.typ) var x = c.getTempRange(n.len-1, slotTempStr) - for i in 1..n.len-1: + for i in 1..<n.len: var r: TRegister = x+i-1 - c.gen(n.sons[i], r) + 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.sons[2].isInt8Lit: - let tmp = c.genx(n.sons[1]) + if n[2].isInt8Lit: + let tmp = c.genx(n[1]) if dest < 0: dest = c.getTemp(n.typ) - c.gABI(n, succ(opc), dest, tmp, n.sons[2].intVal) + c.gABI(n, succ(opc), dest, tmp, n[2].intVal) c.freeTemp(tmp) else: 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) @@ -755,54 +905,94 @@ proc genConv(c: PCtx; n, arg: PNode; dest: var TDest; opc=opcConv) = c.freeTemp(tmp) proc genCard(c: PCtx; n: PNode; dest: var TDest) = - let tmp = c.genx(n.sons[1]) + let tmp = c.genx(n[1]) if dest < 0: dest = c.getTemp(n.typ) - c.genSetType(n.sons[1], tmp) + c.genSetType(n[1], tmp) c.gABC(n, opcCard, dest, tmp) c.freeTemp(tmp) -proc genIntCast(c: PCtx; n: PNode; dest: var TDest) = - const allowedIntegers = {tyInt..tyInt64, tyUInt..tyUInt64, tyChar} - var signedIntegers = {tyInt8..tyInt32} - var unsignedIntegers = {tyUInt8..tyUInt32, tyChar} - let src = n.sons[1].typ.skipTypes(abstractRange)#.kind - let dst = n.sons[0].typ.skipTypes(abstractRange)#.kind - let src_size = getSize(c.config, src) - - if c.config.target.intSize < 8: - signedIntegers.incl(tyInt) - unsignedIntegers.incl(tyUInt) - if src_size == getSize(c.config, dst) and src.kind in allowedIntegers and - dst.kind in allowedIntegers: - let tmp = c.genx(n.sons[1]) - var tmp2 = c.getTemp(n.sons[1].typ) - let tmp3 = c.getTemp(n.sons[1].typ) +proc genCastIntFloat(c: PCtx; n: PNode; dest: var TDest) = + template isSigned(typ: PType): bool {.dirty.} = + typ.kind == tyEnum and firstOrd(c.config, typ) < 0 or + typ.kind in {tyInt..tyInt64} + template isUnsigned(typ: PType): bool {.dirty.} = + typ.kind == tyEnum and firstOrd(c.config, typ) >= 0 or + typ.kind in {tyUInt..tyUInt64, tyChar, tyBool} + + const allowedIntegers = {tyInt..tyInt64, tyUInt..tyUInt64, tyChar, tyEnum, tyBool} + + 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) - proc mkIntLit(ival: int): int = - result = genLiteral(c, newIntTypeNode(nkIntLit, ival, getSysType(c.graph, n.info, tyInt))) - if src.kind in unsignedIntegers and dst.kind in signedIntegers: - # cast unsigned to signed integer of same size - # signedVal = (unsignedVal xor offset) -% offset - let offset = 1 shl (src_size * 8 - 1) - c.gABx(n, opcLdConst, tmp2, mkIntLit(offset)) - c.gABC(n, opcBitxorInt, tmp3, tmp, tmp2) - c.gABC(n, opcSubInt, dest, tmp3, tmp2) - elif src.kind in signedIntegers and dst.kind in unsignedIntegers: - # cast signed to unsigned integer of same size - # unsignedVal = (offset +% signedVal +% 1) and offset - let offset = (1 shl (src_size * 8)) - 1 - c.gABx(n, opcLdConst, tmp2, mkIntLit(offset)) - c.gABx(n, opcLdConst, dest, mkIntLit(offset+1)) - c.gABC(n, opcAddu, tmp3, tmp, dest) - c.gABC(n, opcNarrowU, tmp3, TRegister(src_size*8)) - c.gABC(n, opcBitandInt, dest, tmp3, tmp2) + c.gABC(n, opcAsgnInt, dest, tmp) + if dstSize != sizeof(BiggestInt): # don't do anything on biggest int types + 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 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 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: + c.gABC(n, opcCastIntToFloat32, dest, tmp) else: - c.gABC(n, opcAsgnInt, dest, tmp) + c.gABC(n, opcCastIntToFloat64, dest, tmp) c.freeTemp(tmp) - c.freeTemp(tmp2) - c.freeTemp(tmp3) + + 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 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)) + else: + c.gABC(n, opcCastFloatToInt64, dest, tmp) + # narrowing for 64 bits not needed (no extended sign bits available). + c.freeTemp(tmp) + elif src.kind in PtrLikeKinds + {tyRef} and dst.kind == tyInt: + let tmp = c.genx(n[1]) + if dest < 0: dest = c.getTemp(n[0].typ) + var imm: BiggestInt = if src.kind in PtrLikeKinds: 1 else: 2 + c.gABI(n, opcCastPtrToInt, dest, tmp, imm) + c.freeTemp(tmp) + elif src.kind in PtrLikeKinds + {tyInt} and dst.kind in PtrLikeKinds: + let tmp = c.genx(n[1]) + if dest < 0: dest = c.getTemp(n[0].typ) + c.gABx(n, opcSetType, dest, c.genType(dst)) + c.gABC(n, opcCastIntToPtr, dest, tmp) + c.freeTemp(tmp) + elif src.kind == tyNil and dst.kind in NilableTypes: + # supports casting nil literals to NilableTypes in VM + # see #16024 + if dest < 0: dest = c.getTemp(n[0].typ) + genLit(c, n[1], dest) else: - globalError(c.config, n.info, "VM is only allowed to 'cast' between integers of same size") + # todo: support cast from tyInt to tyRef + globalError(c.config, n.info, "VM does not support 'cast' from " & $src.kind & " to " & $dst.kind) proc genVoidABC(c: PCtx, n: PNode, dest: TDest, opcode: TOpcode) = unused(c, n, dest) @@ -815,33 +1005,91 @@ proc genVoidABC(c: PCtx, n: PNode, dest: TDest, opcode: TOpcode) = c.freeTemp(tmp2) c.freeTemp(tmp3) -proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = +proc genBindSym(c: PCtx; n: PNode; dest: var TDest) = + # nah, cannot use c.config.features because sempass context + # can have local experimental switch + # if dynamicBindSym notin c.config.features: + if n.len == 2: # hmm, reliable? + # bindSym with static input + if n[1].kind in {nkClosedSymChoice, nkOpenSymChoice, nkSym}: + let idx = c.genLiteral(n[1]) + if dest < 0: dest = c.getTemp(n.typ) + c.gABx(n, opcNBindSym, dest, idx) + else: + localError(c.config, n.info, "invalid bindSym usage") + else: + # experimental bindSym + if dest < 0: dest = c.getTemp(n.typ) + let x = c.getTempRange(n.len, slotTempUnknown) + + # callee symbol + var tmp0 = TDest(x) + c.genLit(n[0], tmp0) + + # original parameters + for i in 1..<n.len-2: + var r = TRegister(x+i) + c.gen(n[i], r) + + # info node + var tmp1 = TDest(x+n.len-2) + c.genLit(n[^2], tmp1) + + # payload idx + var tmp2 = TDest(x+n.len-1) + c.genLit(n[^1], tmp2) + + c.gABC(n, opcNDynBindSym, dest, x, n.len) + c.freeTempRange(x, n.len) + +proc fitsRegister*(t: PType): bool = + assert t != nil + t.skipTypes(abstractInst + {tyStatic} - {tyTypeDesc}).kind in { + tyRange, tyEnum, tyBool, tyInt..tyUInt64, tyChar} + +proc ldNullOpcode(t: PType): TOpcode = + assert t != nil + if fitsRegister(t): opcLdNullReg else: opcLdNull + +proc whichAsgnOpc(n: PNode; requiresCopy = true): TOpcode = + case n.typ.skipTypes(abstractRange+{tyOwned}-{tyTypeDesc}).kind + of tyBool, tyChar, tyEnum, tyOrdinal, tyInt..tyInt64, tyUInt..tyUInt64: + opcAsgnInt + of tyFloat..tyFloat128: + opcAsgnFloat + of tyRef, tyNil, tyVar, tyLent, tyPtr: + opcAsgnRef + else: + (if requiresCopy: opcAsgnComplex else: opcFastAsgnComplex) + +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) - of mUnaryLt: - let tmp = c.genx(n.sons[1]) - if dest < 0: dest = c.getTemp(n.typ) - c.gABI(n, opcSubImmInt, dest, tmp, 1) - c.freeTemp(tmp) of mPred, mSubI: c.genAddSubInt(n, dest, opcSubInt) of mSucc, mAddI: c.genAddSubInt(n, dest, opcAddInt) of mInc, mDec: unused(c, n, dest) - let opc = if m == mInc: opcAddInt else: opcSubInt - let d = c.genx(n.sons[1]) - if n.sons[2].isInt8Lit: - c.gABI(n, succ(opc), d, d, n.sons[2].intVal) + let isUnsigned = n[1].typ.skipTypes(abstractVarRange).kind in {tyUInt..tyUInt64} + let opc = if not isUnsigned: + if m == mInc: opcAddInt else: opcSubInt + else: + if m == mInc: opcAddu else: opcSubu + let d = c.genx(n[1]) + if n[2].isInt8Lit and not isUnsigned: + c.gABI(n, succ(opc), d, d, n[2].intVal) else: - let tmp = c.genx(n.sons[2]) + let tmp = c.genx(n[2]) c.gABC(n, opc, d, d, tmp) c.freeTemp(tmp) - c.genNarrow(n.sons[1], d) - c.genAsgnPatch(n.sons[1], d) + c.genNarrow(n[1], d) + c.genAsgnPatch(n[1], d) c.freeTemp(d) - of mOrd, mChr, mArrToSeq: c.gen(n.sons[1], dest) + of mOrd, mChr, mArrToSeq, mUnown: c.gen(n[1], dest) + of generatedMagics: + genCall(c, n, dest) of mNew, mNewFinalize: unused(c, n, dest) c.genNew(n) @@ -854,23 +1102,38 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = # XXX buggy of mNewStringOfCap: # we ignore the 'cap' argument and translate it as 'newString(0)'. - # eval n.sons[1] for possible side effects: - c.freeTemp(c.genx(n.sons[1])) - var tmp = c.getTemp(n.sons[1].typ) + # eval n[1] for possible side effects: + c.freeTemp(c.genx(n[1])) + var tmp = c.getTemp(n[1].typ) c.gABx(n, opcLdImmInt, tmp, 0) if dest < 0: dest = c.getTemp(n.typ) c.gABC(n, opcNewStr, dest, tmp) c.freeTemp(tmp) # XXX buggy - of mLengthOpenArray, mLengthArray, mLengthSeq, mXLenSeq: + of mLengthOpenArray, mLengthArray, mLengthSeq: genUnaryABI(c, n, dest, opcLenSeq) - of mLengthStr, mXLenStr: - genUnaryABI(c, n, dest, opcLenStr) + of mLengthStr: + case n[1].typ.skipTypes(abstractVarRange).kind + of tyString: genUnaryABI(c, n, dest, opcLenStr) + 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.sons[1]) - var tmp = c.genx(n.sons[2]) - c.genSetType(n.sons[1], d) + var d = c.genx(n[1]) + var tmp = c.genx(n[2]) + c.genSetType(n[1], d) c.gABC(n, if m == mIncl: opcIncl else: opcExcl, d, tmp) c.freeTemp(d) c.freeTemp(tmp) @@ -883,26 +1146,28 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = of mMulF64: genBinaryABC(c, n, dest, opcMulFloat) of mDivF64: genBinaryABC(c, n, dest, opcDivFloat) of mShrI: - # the idea here is to narrow type if needed before executing right shift - # inlined modified: genNarrowU(c, n, dest) - 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 tmp = c.genx(n.sons[1]) - if t.kind in {tyUInt8..tyUInt32, tyInt8..tyInt32}: - c.gABC(n, opcNarrowU, tmp, TRegister(t.size*8)) - - # inlined modified: genBinaryABC(c, n, dest, opcShrInt) - let tmp2 = c.genx(n.sons[2]) + # modified: genBinaryABC(c, n, dest, opcShrInt) + # narrowU is applied to the left operandthe idea here is to narrow the left operand + let tmp = c.genx(n[1]) + c.genNarrowU(n, tmp) + let tmp2 = c.genx(n[2]) if dest < 0: dest = c.getTemp(n.typ) c.gABC(n, opcShrInt, dest, tmp, tmp2) c.freeTemp(tmp) c.freeTemp(tmp2) - - of mShlI: genBinaryABCnarrowU(c, n, dest, opcShlInt) - of mBitandI: genBinaryABCnarrowU(c, n, dest, opcBitandInt) - of mBitorI: genBinaryABCnarrowU(c, n, dest, opcBitorInt) - of mBitxorI: genBinaryABCnarrowU(c, n, dest, opcBitxorInt) + of mShlI: + genBinaryABC(c, n, dest, opcShlInt) + # genNarrowU modified + let t = skipTypes(n.typ, abstractVar-{tyTypeDesc}) + let size = getSize(c.config, t) + if t.kind in {tyUInt8..tyUInt32} or (t.kind == tyUInt and size < 8): + c.gABC(n, opcNarrowU, 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) + of mBitxorI: genBinaryABC(c, n, dest, opcBitxorInt) of mAddU: genBinaryABCnarrowU(c, n, dest, opcAddu) of mSubU: genBinaryABCnarrowU(c, n, dest, opcSubu) of mMulU: genBinaryABCnarrowU(c, n, dest, opcMulu) @@ -917,40 +1182,28 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = of mEqF64: genBinaryABC(c, n, dest, opcEqFloat) of mLeF64: genBinaryABC(c, n, dest, opcLeFloat) of mLtF64: genBinaryABC(c, n, dest, opcLtFloat) - of mLePtr, mLeU, mLeU64: genBinaryABC(c, n, dest, opcLeu) - of mLtPtr, mLtU, mLtU64: genBinaryABC(c, n, dest, opcLtu) - of mEqProc, mEqRef, mEqUntracedRef: + of mLePtr, mLeU: genBinaryABC(c, n, dest, opcLeu) + of mLtPtr, mLtU: genBinaryABC(c, n, dest, opcLtu) + of mEqProc, mEqRef: genBinaryABC(c, n, dest, opcEqRef) - of mXor: genBinaryABCnarrowU(c, n, dest, opcXor) + of mXor: genBinaryABC(c, n, dest, opcXor) of mNot: genUnaryABC(c, n, dest, opcNot) of mUnaryMinusI, mUnaryMinusI64: genUnaryABC(c, n, dest, opcUnaryMinusInt) genNarrow(c, n, dest) of mUnaryMinusF64: genUnaryABC(c, n, dest, opcUnaryMinusFloat) - of mUnaryPlusI, mUnaryPlusF64: gen(c, n.sons[1], dest) + of mUnaryPlusI, mUnaryPlusF64: gen(c, n[1], dest) of mBitnotI: genUnaryABC(c, n, dest, opcBitnotInt) - genNarrowU(c, n, dest) - of mToFloat, mToBiggestFloat, mToInt, - mToBiggestInt, mCharToStr, mBoolToStr, mIntToStr, mInt64ToStr, - mFloatToStr, mCStrToStr, mStrToStr, mEnumToStr: - genConv(c, n, n.sons[1], dest) - of mZe8ToI, mZe8ToI64, mZe16ToI, mZe16ToI64, mZe32ToI64, mZeIToI64: - #genNarrowU modified - let t = skipTypes(n.sons[1].typ, abstractVar-{tyTypeDesc}) - let tmp = c.genx(n.sons[1]) - c.gABC(n, opcNarrowU, tmp, TRegister(t.size*8)) - # assign result to dest register - if dest < 0: dest = c.getTemp(n.typ) - c.gABC(n, opcAsgnInt, dest, tmp) - c.freeTemp(tmp) - of mToU8, mToU16, mToU32: + #genNarrowU modified, do not narrow signed types let t = skipTypes(n.typ, abstractVar-{tyTypeDesc}) - var tmp = c.genx(n.sons[1]) - if dest < 0: dest = c.getTemp(n.typ) - c.gABC(n, opcToNarrowInt, dest, tmp, TRegister(t.size*8)) - c.freeTemp(tmp) - 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) @@ -959,102 +1212,73 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = of mMulSet: genBinarySet(c, n, dest, opcMulSet) of mPlusSet: genBinarySet(c, n, dest, opcPlusSet) of mMinusSet: genBinarySet(c, n, dest, opcMinusSet) - of mSymDiffSet: genBinarySet(c, n, dest, opcSymdiffSet) of mConStrStr: genVarargsABC(c, n, dest, opcConcatStr) of mInSet: genBinarySet(c, n, dest, opcContainsSet) of mRepr: genUnaryABC(c, n, dest, opcRepr) of mExit: unused(c, n, dest) - var tmp = c.genx(n.sons[1]) + var tmp = c.genx(n[1]) c.gABC(n, opcQuit, tmp) c.freeTemp(tmp) of mSetLengthStr, mSetLengthSeq: unused(c, n, dest) - var d = c.genx(n.sons[1]) - var tmp = c.genx(n.sons[2]) + var d = c.genx(n[1]) + var tmp = c.genx(n[2]) c.gABC(n, if m == mSetLengthStr: opcSetLenStr else: opcSetLenSeq, d, tmp) - c.genAsgnPatch(n.sons[1], d) + c.genAsgnPatch(n[1], d) c.freeTemp(tmp) + c.freeTemp(d) of mSwap: unused(c, n, dest) - c.gen(lowerSwap(c.graph, n, if c.prc == nil: c.module else: c.prc.sym)) + c.gen(lowerSwap(c.graph, n, c.idgen, if c.prc == nil or c.prc.sym == nil: c.module else: c.prc.sym)) of mIsNil: genUnaryABC(c, n, dest, opcIsNil) - of mCopyStr: - if dest < 0: dest = c.getTemp(n.typ) - var - tmp1 = c.genx(n.sons[1]) - tmp2 = c.genx(n.sons[2]) - tmp3 = c.getTemp(n.sons[2].typ) - c.gABC(n, opcLenStr, tmp3, tmp1) - c.gABC(n, opcSubStr, dest, tmp1, tmp2) - c.gABC(n, opcSubStr, tmp3) - c.freeTemp(tmp1) - c.freeTemp(tmp2) - c.freeTemp(tmp3) - of mCopyStrLast: - if dest < 0: dest = c.getTemp(n.typ) - var - tmp1 = c.genx(n.sons[1]) - tmp2 = c.genx(n.sons[2]) - tmp3 = c.genx(n.sons[3]) - c.gABC(n, opcSubStr, dest, tmp1, tmp2) - c.gABC(n, opcSubStr, tmp3) - c.freeTemp(tmp1) - c.freeTemp(tmp2) - c.freeTemp(tmp3) of mParseBiggestFloat: if dest < 0: dest = c.getTemp(n.typ) var d2: TRegister # skip 'nkHiddenAddr': - let d2AsNode = n.sons[2].sons[0] + let d2AsNode = n[2][0] if needsAsgnPatch(d2AsNode): d2 = c.getTemp(getSysType(c.graph, n.info, tyFloat)) else: d2 = c.genx(d2AsNode) var - tmp1 = c.genx(n.sons[1]) - tmp3 = c.genx(n.sons[3]) + tmp1 = c.genx(n[1]) 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.sons[1]) - c.gABC(n, opcReset, d) + 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: if dest < 0: dest = c.getTemp(n.typ) - var tmp = c.genx(n.sons[1]) + var tmp = c.genx(n[1]) var idx = c.getTemp(getSysType(c.graph, n.info, tyInt)) - var typ = n.sons[2].typ - if m == mOf: typ = typ.skipTypes(abstractPtrs-{tyTypeDesc}) + var typ = n[2].typ + if m == mOf: typ = typ.skipTypes(abstractPtrs) c.gABx(n, opcLdImmInt, idx, c.genType(typ)) c.gABC(n, if m == mOf: opcOf else: opcIs, dest, tmp, idx) c.freeTemp(tmp) c.freeTemp(idx) - of mSizeOf: - globalError(c.config, n.info, "cannot run in the VM: " & renderTree(n)) of mHigh: if dest < 0: dest = c.getTemp(n.typ) - let tmp = c.genx(n.sons[1]) - case n.sons[1].typ.skipTypes(abstractVar-{tyTypeDesc}).kind: - of tyString, tyCString: - c.gABI(n, opcLenStr, dest, tmp, 1) - else: - c.gABI(n, opcLenSeq, dest, tmp, 1) + 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) + else: c.gABI(n, opcLenSeq, dest, tmp, 1) c.freeTemp(tmp) of mEcho: unused(c, n, dest) let n = n[1].skipConv - let x = c.getTempRange(n.len, slotTempUnknown) - internalAssert c.config, n.kind == nkBracket - for i in 0..<n.len: - var r: TRegister = x+i - c.gen(n.sons[i], r) - c.gABC(n, opcEcho, x, n.len) - c.freeTempRange(x, n.len) + if n.kind == nkBracket: + # can happen for nim check, see bug #9609 + let x = c.getTempRange(n.len, slotTempUnknown) + for i in 0..<n.len: + var r: TRegister = x+i + c.gen(n[i], r) + c.gABC(n, opcEcho, x, n.len) + c.freeTempRange(x, n.len) of mAppendStrCh: unused(c, n, dest) genBinaryStmtVar(c, n, opcAddStrCh) @@ -1065,19 +1289,22 @@ 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.sons[1]) + let tmp = c.genx(n[1]) if dest < 0: dest = c.getTemp(n.typ) - c.gABx(n, opcSetType, tmp, c.genType(n.sons[1].typ)) + c.gABx(n, opcSetType, tmp, c.genType(n[1].typ)) c.gABC(n, opcTypeTrait, dest, tmp) c.freeTemp(tmp) of mSlurp: genUnaryABC(c, n, dest, opcSlurp) of mStaticExec: genBinaryABCD(c, n, dest, opcGorge) of mNLen: genUnaryABI(c, n, dest, opcLenSeq, nimNodeFlag) of mGetImpl: genUnaryABC(c, n, dest, opcGetImpl) + of mGetImplTransf: genUnaryABC(c, n, dest, opcGetImplTransf) + of mSymOwner: genUnaryABC(c, n, dest, opcSymOwner) + of mSymIsInstantiationOf: genBinaryABC(c, n, dest, opcSymIsInstantiationOf) of mNChild: genBinaryABC(c, n, dest, opcNChild) of mNSetChild: genVoidABC(c, n, dest, opcNSetChild) of mNDel: genVoidABC(c, n, dest, opcNDel) @@ -1103,7 +1330,7 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = of mNSymbol: genUnaryABC(c, n, dest, opcNSymbol) of mNIdent: genUnaryABC(c, n, dest, opcNIdent) of mNGetType: - let tmp = c.genx(n.sons[1]) + let tmp = c.genx(n[1]) if dest < 0: dest = c.getTemp(n.typ) let rc = case n[0].sym.name.s: of "getType": 0 @@ -1113,7 +1340,14 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = c.gABC(n, opcNGetType, dest, tmp, rc) c.freeTemp(tmp) #genUnaryABC(c, n, dest, opcNGetType) + of mNSizeOf: + let imm = case n[0].sym.name.s: + of "getSize": 0 + of "getAlign": 1 + else: 2 # "getOffset" + c.genUnaryABI(n, dest, opcNGetSize, imm) of mNStrVal: genUnaryABC(c, n, dest, opcNStrVal) + of mNSigHash: genUnaryABC(c, n , dest, opcNSigHash) of mNSetIntVal: unused(c, n, dest) genBinaryStmt(c, n, opcNSetIntVal) @@ -1126,42 +1360,45 @@ 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) of mNNewNimNode: genBinaryABC(c, n, dest, opcNNewNimNode) of mNCopyNimNode: genUnaryABC(c, n, dest, opcNCopyNimNode) of mNCopyNimTree: genUnaryABC(c, n, dest, opcNCopyNimTree) - of mNBindSym: - if n[1].kind in {nkClosedSymChoice, nkOpenSymChoice, nkSym}: - let idx = c.genLiteral(n[1]) - if dest < 0: dest = c.getTemp(n.typ) - c.gABx(n, opcNBindSym, dest, idx) - else: - localError(c.config, n.info, "invalid bindSym usage") + of mNBindSym: genBindSym(c, n, dest) of mStrToIdent: genUnaryABC(c, n, dest, opcStrToIdent) of mEqIdent: genBinaryABC(c, n, dest, opcEqIdent) - of mEqNimrodNode: genBinaryABC(c, n, dest, opcEqNimrodNode) + of mEqNimrodNode: genBinaryABC(c, n, dest, opcEqNimNode) of mSameNodeType: genBinaryABC(c, n, dest, opcSameNodeType) of mNLineInfo: case n[0].sym.name.s - of "getFile": - genUnaryABC(c, n, dest, opcNGetFile) - of "getLine": - genUnaryABC(c, n, dest, opcNGetLine) - of "getColumn": - genUnaryABC(c, n, dest, opcNGetColumn) - else: - internalAssert c.config, false + of "getFile": genUnaryABI(c, n, dest, opcNGetLineInfo, 0) + of "getLine": genUnaryABI(c, n, dest, opcNGetLineInfo, 1) + of "getColumn": genUnaryABI(c, n, dest, opcNGetLineInfo, 2) + of "copyLineInfo": + internalAssert c.config, n.len == 3 + unused(c, n, dest) + 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) - genUnaryStmt(c, n, opcNHint) + genBinaryStmt(c, n, opcNHint) of mNWarning: unused(c, n, dest) - genUnaryStmt(c, n, opcNWarning) + genBinaryStmt(c, n, opcNWarning) of mNError: if n.len <= 1: # query error condition: @@ -1174,13 +1411,12 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = if dest < 0: dest = c.getTemp(n.typ) c.gABC(n, opcCallSite, dest) of mNGenSym: genBinaryABC(c, n, dest, opcGenSym) - of mMinI, mMaxI, mAbsF64, mMinF64, mMaxF64, mAbsI, - mDotDot: + of mMinI, mMaxI, mAbsI, mDotDot: c.genCall(n, dest) of mExpandToAst: if n.len != 2: globalError(c.config, n.info, "expandToAst requires 1 argument") - let arg = n.sons[1] + let arg = n[1] if arg.kind in nkCallKinds: #if arg[0].kind != nkSym or arg[0].sym.kind notin {skTemplate, skMacro}: # "ExpandToAst: expanded symbol is no macro or template" @@ -1190,150 +1426,131 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = # produces a value else: globalError(c.config, n.info, "expandToAst requires a call expression") + of mSizeOf: + globalError(c.config, n.info, sizeOfLikeMsg("sizeof")) + of mAlignOf: + globalError(c.config, n.info, sizeOfLikeMsg("alignof")) + of mOffsetOf: + globalError(c.config, n.info, sizeOfLikeMsg("offsetof")) of mRunnableExamples: discard "just ignore any call to runnableExamples" + 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? + # 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) else: # 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.sons[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.sons[1]) - c.gABC(n, opcMarshalStore, dest, tmp) - c.gABx(n, opcMarshalStore, 0, c.genType(n.sons[1].typ)) - c.freeTemp(tmp) - -const - atomicTypes = {tyBool, tyChar, - tyExpr, tyStmt, tyTypeDesc, tyStatic, - tyEnum, - tyOrdinal, - tyRange, - tyProc, - tyPointer, tyOpenArray, - tyString, tyCString, - tyInt, tyInt8, tyInt16, tyInt32, tyInt64, - tyFloat, tyFloat32, tyFloat64, tyFloat128, - tyUInt, tyUInt8, tyUInt16, tyUInt32, tyUInt64} - -proc fitsRegister*(t: PType): bool = - assert t != nil - t.skipTypes(abstractInst-{tyTypeDesc}).kind in { - tyRange, tyEnum, tyBool, tyInt..tyUInt64, tyChar} - proc unneededIndirection(n: PNode): bool = - n.typ.skipTypes(abstractInst-{tyTypeDesc}).kind == tyRef + n.typ.skipTypes(abstractInstOwned-{tyTypeDesc}).kind == tyRef -proc canElimAddr(n: PNode): PNode = - case n.sons[0].kind +proc canElimAddr(n: PNode; idgen: IdGenerator): PNode = + result = nil + case n[0].kind of nkObjUpConv, nkObjDownConv, nkChckRange, nkChckRangeF, nkChckRange64: - var m = n.sons[0].sons[0] + var m = n[0][0] if m.kind in {nkDerefExpr, nkHiddenDeref}: # addr ( nkConv ( deref ( x ) ) ) --> nkConv(x) - result = copyNode(n.sons[0]) - result.add m.sons[0] + 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.sons[0].sons[1] + var m = n[0][1] if m.kind in {nkDerefExpr, nkHiddenDeref}: # addr ( nkConv ( deref ( x ) ) ) --> nkConv(x) - result = copyNode(n.sons[0]) - result.add m.sons[0] + 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.sons[0].kind in {nkDerefExpr, nkHiddenDeref}: + if n[0].kind in {nkDerefExpr, nkHiddenDeref}: # addr ( deref ( x )) --> x - result = n.sons[0].sons[0] + result = n[0][0] -proc genAddrDeref(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode; - flags: TGenFlags) = - # a nop for certain types - let isAddr = opc in {opcAddrNode, opcAddrReg} - if isAddr and (let m = canElimAddr(n); m != nil): +proc genAddr(c: PCtx, n: PNode, dest: var TDest, flags: TGenFlags) = + if (let m = canElimAddr(n, c.idgen); m != nil): gen(c, m, dest, flags) return - let af = if n[0].kind in {nkBracketExpr, nkDotExpr, nkCheckedFieldExpr}: {gfAddrOf, gfFieldAccess} - else: {gfAddrOf} - let newflags = if isAddr: flags+af else: flags - # consider: - # proc foo(f: var ref int) = - # f = new(int) - # proc blah() = - # var x: ref int - # foo x - # - # The type of 'f' is 'var ref int' and of 'x' is 'ref int'. Hence for - # nkAddr we must not use 'unneededIndirection', but for deref we use it. - if not isAddr and unneededIndirection(n.sons[0]): - gen(c, n.sons[0], dest, newflags) - if gfAddrOf notin flags and fitsRegister(n.typ): - c.gABC(n, opcNodeToReg, dest, dest) - elif isAddr and isGlobal(n.sons[0]): - gen(c, n.sons[0], dest, flags+af) + let newflags = flags-{gfNode}+{gfNodeAddr} + + if isGlobal(n[0]) or n[0].kind in {nkDotExpr, nkCheckedFieldExpr, nkBracketExpr}: + # checking for this pattern: addr(obj.field) / addr(array[i]) + gen(c, n[0], dest, newflags) else: - let tmp = c.genx(n.sons[0], newflags) + let tmp = c.genx(n[0], newflags) if dest < 0: dest = c.getTemp(n.typ) - if not isAddr: - gABC(c, n, opc, dest, tmp) - assert n.typ != nil - if gfAddrOf notin flags and fitsRegister(n.typ): - c.gABC(n, opcNodeToReg, dest, dest) - elif 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) -proc whichAsgnOpc(n: PNode): TOpcode = - case n.typ.skipTypes(abstractRange-{tyTypeDesc}).kind - of tyBool, tyChar, tyEnum, tyOrdinal, tyInt..tyInt64, tyUInt..tyUInt64: - opcAsgnInt - of tyString, tyCString: - opcAsgnStr - of tyFloat..tyFloat128: - opcAsgnFloat - of tyRef, tyNil, tyVar, tyLent, tyPtr: - opcAsgnRef +proc genDeref(c: PCtx, n: PNode, dest: var TDest, flags: TGenFlags) = + if unneededIndirection(n[0]): + gen(c, n[0], dest, flags) + if {gfNodeAddr, gfNode} * flags == {} and fitsRegister(n.typ): + c.gABC(n, opcNodeToReg, dest, dest) else: - opcAsgnComplex - -proc whichAsgnOpc(n: PNode; opc: TOpcode): TOpcode = opc + let tmp = c.genx(n[0], flags) + if dest < 0: dest = c.getTemp(n.typ) + gABC(c, n, opcLdDeref, dest, tmp) + assert n.typ != nil + if {gfNodeAddr, gfNode} * flags == {} and fitsRegister(n.typ): + c.gABC(n, opcNodeToReg, dest, dest) + c.freeTemp(tmp) proc genAsgn(c: PCtx; dest: TDest; ri: PNode; requiresCopy: bool) = let tmp = c.genx(ri) assert dest >= 0 - gABC(c, ri, whichAsgnOpc(ri), dest, tmp, 1-ord(requiresCopy)) + gABC(c, ri, whichAsgnOpc(ri, requiresCopy), dest, tmp) c.freeTemp(tmp) proc setSlot(c: PCtx; v: PSym) = # XXX generate type initialization here? if v.position == 0: - if c.prc.maxSlots == 0: c.prc.maxSlots = 1 - if c.prc.maxSlots >= high(TRegister): - globalError(c.config, v.info, "cannot generate code; too many registers required") - v.position = c.prc.maxSlots - c.prc.slots[v.position] = (inUse: true, - kind: if v.kind == skLet: slotFixedLet else: slotFixedVar) - inc c.prc.maxSlots - -proc cannotEval(c: PCtx; n: PNode) {.noinline.} = + v.position = getFreeRegister(c, if v.kind == skLet: slotFixedLet else: slotFixedVar, start = 1) + +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 @@ -1343,28 +1560,37 @@ proc getOwner(c: PCtx): PSym = result = c.prc.sym if result.isNil: result = c.module +proc importcCondVar*(s: PSym): bool {.inline.} = + # see also importcCond + if sfImportc in s.flags: + 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 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: - cannotEval(c, n) + # 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: cannotEval(c, n) -proc isTemp(c: PCtx; dest: TDest): bool = - result = dest >= 0 and c.prc.slots[dest].kind >= slotTempUnknown - template needsAdditionalCopy(n): untyped = not c.isTemp(dest) and not fitsRegister(n.typ) proc genAdditionalCopy(c: PCtx; n: PNode; opc: TOpcode; dest, idx, value: TRegister) = var cc = c.getTemp(n.typ) - c.gABC(n, whichAsgnOpc(n), cc, value, 0) + c.gABC(n, whichAsgnOpc(n), cc, value) c.gABC(n, opc, dest, idx, cc) c.freeTemp(cc) @@ -1382,146 +1608,199 @@ 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.sons[0], {gfAddrOf, gfFieldAccess}) - let idx = c.genIndex(le.sons[1], le.sons[0].typ) - let tmp = c.genx(ri) - if le.sons[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) - of nkDotExpr, nkCheckedFieldExpr: - # XXX field checks here - let left = if le.kind == nkDotExpr: le else: le.sons[0] - let dest = c.genx(left.sons[0], {gfAddrOf, gfFieldAccess}) - let idx = genField(c, left.sons[1]) + c.freeTemp(idx) + c.freeTemp(dest) + of nkCheckedFieldExpr: + var objR: TDest = -1 + genCheckedObjAccessAux(c, le, objR, {gfNode}) + let idx = genField(c, le[0][1]) let tmp = c.genx(ri) - c.preventFalseAlias(left, opcWrObj, dest, idx, tmp) + c.preventFalseAlias(le[0], opcWrObj, objR, idx, tmp) c.freeTemp(tmp) + # c.freeTemp(idx) # BUGFIX, see nkDotExpr + c.freeTemp(objR) + of nkDotExpr: + let dest = c.genx(le[0], {gfNode}) + let idx = genField(c, le[1]) + let tmp = c.genx(ri) + c.preventFalseAlias(le, opcWrObj, dest, idx, tmp) + # c.freeTemp(idx) # BUGFIX: idx is an immediate (field position), not a register + c.freeTemp(tmp) + c.freeTemp(dest) of nkDerefExpr, nkHiddenDeref: - let dest = c.genx(le.sons[0], {gfAddrOf}) + let dest = c.genx(le[0], {gfNode}) let tmp = c.genx(ri) c.preventFalseAlias(le, opcWrDeref, dest, 0, tmp) + c.freeTemp(dest) c.freeTemp(tmp) of nkSym: let s = le.sym checkCanEval(c, le) if s.isGlobal: withTemp(tmp, le.typ): - c.gen(le, tmp, {gfAddrOf}) + c.gen(le, tmp, {gfNodeAddr}) let val = c.genx(ri) c.preventFalseAlias(le, opcWrDeref, tmp, 0, val) c.freeTemp(val) else: if s.kind == skForVar: c.setSlot s internalAssert c.config, s.position > 0 or (s.position == 0 and - s.kind in {skParam,skResult}) + s.kind in {skParam, skResult}) var dest: TRegister = s.position + ord(s.kind == skParam) assert le.typ != nil if needsAdditionalCopy(le) and s.kind in {skResult, skVar, skParam}: var cc = c.getTemp(le.typ) gen(c, ri, cc) - c.gABC(le, whichAsgnOpc(le), dest, cc, 1) + c.gABC(le, whichAsgnOpc(le), dest, cc) 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, {gfAddrOf}) + let dest = c.genx(le, {gfNodeAddr}) genAsgn(c, dest, ri, requiresCopy) + c.freeTemp(dest) proc genTypeLit(c: PCtx; t: PType; dest: var TDest) = var n = newNode(nkType) 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 isEmptyBody(getBody(c.graph, s)) + proc importcSym(c: PCtx; info: TLineInfo; s: PSym) = when hasFFI: - if allowFFI in c.features: - c.globals.add(importcSymbol(s)) + if compiletimeFFI in c.config.features: + c.globals.add(importcSymbol(c.config, s)) s.position = c.globals.len else: - localError(c.config, info, "VM is not allowed to 'importc'") + localError(c.config, info, + "VM is not allowed to 'importc' without --experimental:compiletimeFFI") else: localError(c.config, info, - "cannot 'importc' variable at compile time") + "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: # var decls{.compileTime.}: seq[NimNode] = @[] let dest = c.getTemp(s.typ) c.gABx(n, opcLdGlobal, dest, s.position) - if s.ast != nil: - let tmp = c.genx(s.ast) + if s.astdef != nil: + let tmp = c.genx(s.astdef) c.genAdditionalCopy(n, opcWrDeref, dest, 0, tmp) c.freeTemp(dest) c.freeTemp(tmp) proc genRdVar(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = + # gfNodeAddr and gfNode are mutually exclusive + assert card(flags * {gfNodeAddr, gfNode}) < 2 let s = n.sym if s.isGlobal: - if sfCompileTime in s.flags or c.mode == emRepl: + let isImportcVar = importcCondVar(s) + if sfCompileTime in s.flags or c.mode == emRepl or isImportcVar: discard elif s.position == 0: cannotEval(c, n) if s.position == 0: - if sfImportc in s.flags: c.importcSym(n.info, s) + if importcCond(c, s) or isImportcVar: c.importcSym(n.info, s) else: genGlobalInit(c, n, s) if dest < 0: dest = c.getTemp(n.typ) assert s.typ != nil - if gfAddrOf notin flags and fitsRegister(s.typ): + + if gfNodeAddr in flags: + if isImportcVar: + c.gABx(n, opcLdGlobalAddrDerefFFI, dest, s.position) + else: + 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) c.gABC(n, opcNodeToReg, dest, cc) c.freeTemp(cc) - elif {gfAddrOf, gfFieldAccess} * flags == {gfAddrOf}: - c.gABx(n, opcLdGlobalAddr, dest, s.position) else: c.gABx(n, opcLdGlobal, dest, s.position) else: if s.kind == skForVar and c.mode == emRepl: c.setSlot(s) if s.position > 0 or (s.position == 0 and - s.kind in {skParam,skResult}): + 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: - genAsgn(c, dest, n, c.prc.slots[dest].kind >= slotSomeTemp) + let requiresCopy = c.prc.regInfo[dest].kind >= slotSomeTemp and + gfIsParam notin flags + genAsgn(c, dest, n, requiresCopy) else: # see tests/t99bott for an example that triggers it: cannotEval(c, n) template needsRegLoad(): untyped = - gfAddrOf notin flags and fitsRegister(n.typ.skipTypes({tyVar, tyLent})) + {gfNode, gfNodeAddr} * flags == {} and + fitsRegister(n.typ.skipTypes({tyVar, tyLent, tyStatic})) -proc genArrAccess2(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode; - flags: TGenFlags) = - let a = c.genx(n.sons[0], flags) - let b = c.genIndex(n.sons[1], n.sons[0].typ) +proc genArrAccessOpcode(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode; + flags: TGenFlags) = + let a = c.genx(n[0], flags) + let b = c.genIndex(n[1], n[0].typ) if dest < 0: dest = c.getTemp(n.typ) - if needsRegLoad(): + if opc in {opcLdArrAddr, opcLdStrIdxAddr} and gfNodeAddr in flags: + c.gABC(n, opc, dest, a, b) + elif needsRegLoad(): var cc = c.getTemp(n.typ) c.gABC(n, opc, cc, a, b) 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.sons[0], flags) - let b = genField(c, n.sons[1]) +proc genObjAccessAux(c: PCtx; n: PNode; a, b: int, dest: var TDest; flags: TGenFlags) = if dest < 0: dest = c.getTemp(n.typ) - if needsRegLoad(): + if {gfNodeAddr} * flags != {}: + c.gABC(n, opcLdObjAddr, dest, a, b) + elif needsRegLoad(): var cc = c.getTemp(n.typ) c.gABC(n, opcLdObj, cc, a, b) c.gABC(n, opcNodeToReg, dest, cc) @@ -1530,36 +1809,114 @@ 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 + let accessExpr = n[0] + # nkCall to check if the discriminant is valid + var checkExpr = n[1] + + let negCheck = checkExpr[0].sym.magic == mNot + if negCheck: + checkExpr = checkExpr[^1] + + # Discriminant symbol + let disc = checkExpr[2] + internalAssert c.config, disc.sym.kind == skField + + # Load the object in `dest` + c.gen(accessExpr[0], dest, flags) + # Load the discriminant + var discVal = c.getTemp(disc.typ) + c.gABC(n, opcLdObj, discVal, dest, genField(c, disc)) + # Check if its value is contained in the supplied set + 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(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 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, 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) = - # XXX implement field checks! - genObjAccess(c, n.sons[0], dest, flags) + var objR: TDest = -1 + genCheckedObjAccessAux(c, n, objR, flags) + + let accessExpr = n[0] + # Field symbol + var field = accessExpr[1] + internalAssert c.config, field.sym.kind == skField + + # Load the content now + if dest < 0: dest = c.getTemp(n.typ) + let fieldPos = genField(c, field) + + if {gfNodeAddr} * flags != {}: + c.gABC(n, opcLdObjAddr, dest, objR, fieldPos) + elif needsRegLoad(): + var cc = c.getTemp(accessExpr.typ) + c.gABC(n, opcLdObj, cc, objR, fieldPos) + c.gABC(n, opcNodeToReg, dest, cc) + c.freeTemp(cc) + else: + c.gABC(n, opcLdObj, dest, objR, fieldPos) + + c.freeTemp(objR) proc genArrAccess(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = - let arrayType = n.sons[0].typ.skipTypes(abstractVarRange-{tyTypeDesc}).kind - if arrayType in {tyString, tyCString}: - genArrAccess2(c, n, dest, opcLdStrIdx, {}) - elif arrayType == tyTypeDesc: + let arrayType = n[0].typ.skipTypes(abstractVarRange-{tyTypeDesc}).kind + case arrayType + of tyString, tyCstring: + let opc = if gfNodeAddr in flags: opcLdStrIdxAddr else: opcLdStrIdx + genArrAccessOpcode(c, n, dest, opc, flags) + of tyTuple: + c.genObjAccessAux(n, c.genx(n[0], flags), int n[1].intVal, dest, flags) + of tyTypeDesc: c.genTypeLit(n.typ, dest) else: - genArrAccess2(c, n, dest, opcLdArr, flags) + let opc = if gfNodeAddr in flags: opcLdArrAddr else: opcLdArr + genArrAccessOpcode(c, n, dest, opc, flags) -proc getNullValueAux(obj: PNode, result: PNode; conf: ConfigRef) = +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 countup(0, sonsLen(obj) - 1): getNullValueAux(obj.sons[i], result, conf) + for i in 0..<obj.len: getNullValueAux(c, nil, obj[i], result, conf, currPosition) of nkRecCase: - getNullValueAux(obj.sons[0], result, conf) - for i in countup(1, sonsLen(obj) - 1): - getNullValueAux(lastSon(obj.sons[i]), result, conf) + getNullValueAux(c, nil, obj[0], result, conf, currPosition) + for i in 1..<obj.len: + 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)) - addSon(result, field) + 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 = - var t = skipTypes(typ, abstractRange-{tyTypeDesc}) +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: result = newNodeIT(nkIntLit, info, t) @@ -1567,103 +1924,112 @@ 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, tyExpr, - tyStmt, tyTypeDesc, tyStatic, tyRef, tyNil: + of tyCstring, tyVar, tyLent, tyPointer, tyPtr, tyUntyped, + tyTyped, tyTypeDesc, tyRef, tyNil: result = newNodeIT(nkNilLit, info, t) of tyProc: if t.callConv != ccClosure: 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: - var base = t.sons[0] - while base != nil: - getNullValueAux(skipTypes(base, skipPtrs).n, result, conf) - base = base.sons[0] - getNullValueAux(t.n, result, conf) + # initialize inherited fields, and all in the correct order: + var currPosition = 0 + getNullValueAux(c, t, t.n, result, conf, currPosition) of tyArray: result = newNodeIT(nkBracket, info, t) - for i in countup(0, int(lengthOrd(conf, t)) - 1): - addSon(result, getNullValue(elemType(t), info, conf)) + for i in 0..<toInt(lengthOrd(conf, t)): + result.add getNullValue(c, elemType(t), info, conf) of tyTuple: result = newNodeIT(nkTupleConstr, info, t) - for i in countup(0, sonsLen(t) - 1): - addSon(result, getNullValue(t.sons[i], info, conf)) + for a in t.kids: + result.add getNullValue(c, a, info, conf) of tySet: result = newNodeIT(nkCurly, info, t) - of tyOpt: - result = newNodeIT(nkNilLit, info, t) - of tySequence: + of tySequence, tyOpenArray: result = newNodeIT(nkBracket, info, t) else: globalError(conf, info, "cannot create null element for: " & $t.kind) result = newNodeI(nkEmpty, info) -proc ldNullOpcode(t: PType): TOpcode = - assert t != nil - if fitsRegister(t): opcLdNullReg else: opcLdNull - proc genVarSection(c: PCtx; n: PNode) = for a in n: if a.kind == nkCommentStmt: continue - #assert(a.sons[0].kind == nkSym) can happen for transformed vars + #assert(a[0].kind == nkSym) can happen for transformed vars if a.kind == nkVarTuple: - for i in 0 .. a.len-3: - if not a[i].sym.isGlobal: setSlot(c, a[i].sym) - checkCanEval(c, a[i]) - c.gen(lowerTupleUnpacking(c.graph, a, c.getOwner)) - elif a.sons[0].kind == nkSym: - let s = a.sons[0].sym - checkCanEval(c, a.sons[0]) + for i in 0..<a.len-2: + if a[i].kind == nkSym: + if not a[i].sym.isGlobal: setSlot(c, a[i].sym) + checkCanEval(c, a[i]) + c.gen(lowerTupleUnpacking(c.graph, a, c.idgen, c.getOwner)) + elif a[0].kind == nkSym: + 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 sfImportc in s.flags: c.importcSym(a.info, s) + 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.sons[2].kind != nkEmpty: - let tmp = c.genx(a.sons[0], {gfAddrOf}) - let val = c.genx(a.sons[2]) - c.genAdditionalCopy(a.sons[2], opcWrDeref, tmp, 0, val) + 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.sons[2].kind == nkEmpty: + if a[2].kind == nkEmpty: c.gABx(a, ldNullOpcode(s.typ), s.position, c.genType(s.typ)) else: assert s.typ != nil if not fitsRegister(s.typ): c.gABx(a, ldNullOpcode(s.typ), s.position, c.genType(s.typ)) - let le = a.sons[0] + let le = a[0] assert le.typ != nil if not fitsRegister(le.typ) and s.kind in {skResult, skVar, skParam}: var cc = c.getTemp(le.typ) - gen(c, a.sons[2], cc) - c.gABC(le, whichAsgnOpc(le), s.position.TRegister, cc, 1) + gen(c, a[2], cc) + c.gABC(le, whichAsgnOpc(le), s.position.TRegister, cc) c.freeTemp(cc) else: - gen(c, a.sons[2], s.position.TRegister) + gen(c, a[2], s.position.TRegister) else: - # assign to a.sons[0]; happens for closures - if a.sons[2].kind == nkEmpty: - let tmp = genx(c, a.sons[0]) - c.gABx(a, ldNullOpcode(a[0].typ), tmp, c.genType(a.sons[0].typ)) + # assign to a[0]; happens for closures + if a[2].kind == nkEmpty: + let tmp = genx(c, a[0]) + c.gABx(a, ldNullOpcode(a[0].typ), tmp, c.genType(a[0].typ)) c.freeTemp(tmp) else: - genAsgn(c, a.sons[0], a.sons[2], true) + genAsgn(c, a[0], a[2], true) proc genArrayConstr(c: PCtx, n: PNode, dest: var TDest) = if dest < 0: dest = c.getTemp(n.typ) @@ -1683,7 +2049,7 @@ proc genArrayConstr(c: PCtx, n: PNode, dest: var TDest) = c.gABx(n, opcLdNullReg, tmp, c.genType(intType)) for x in n: let a = c.genx(x) - c.preventFalseAlias(n, whichAsgnOpc(x, opcWrArr), dest, tmp, a) + c.preventFalseAlias(n, opcWrArr, dest, tmp, a) c.gABI(n, opcAddImmInt, tmp, tmp, 1) c.freeTemp(a) c.freeTemp(tmp) @@ -1693,8 +2059,8 @@ proc genSetConstr(c: PCtx, n: PNode, dest: var TDest) = c.gABx(n, opcLdNull, dest, c.genType(n.typ)) for x in n: if x.kind == nkRange: - let a = c.genx(x.sons[0]) - let b = c.genx(x.sons[1]) + let a = c.genx(x[0]) + let b = c.genx(x[1]) c.gABC(n, opcInclRange, dest, a, b) c.freeTemp(b) c.freeTemp(a) @@ -1704,18 +2070,20 @@ 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-{tyTypeDesc}) + let t = n.typ.skipTypes(abstractRange+{tyOwned}-{tyTypeDesc}) if t.kind == tyRef: - c.gABx(n, opcNew, dest, c.genType(t.sons[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: - let it = n.sons[i] - if it.kind == nkExprColonExpr and it.sons[0].kind == nkSym: - let idx = genField(c, it.sons[0]) - let tmp = c.genx(it.sons[1]) - c.preventFalseAlias(it.sons[1], whichAsgnOpc(it.sons[1], opcWrObj), + let it = n[i] + if it.kind == nkExprColonExpr and it[0].kind == nkSym: + let idx = genField(c, it[0]) + let tmp = c.genx(it[1]) + c.preventFalseAlias(it[1], opcWrObj, dest, idx, tmp) c.freeTemp(tmp) else: @@ -1723,70 +2091,77 @@ proc genObjConstr(c: PCtx, n: PNode, dest: var TDest) = proc genTupleConstr(c: PCtx, n: PNode, dest: var TDest) = if dest < 0: dest = c.getTemp(n.typ) - c.gABx(n, opcLdNull, dest, c.genType(n.typ)) - # XXX x = (x.old, 22) produces wrong code ... stupid self assignments - for i in 0..<n.len: - let it = n.sons[i] - if it.kind == nkExprColonExpr: - let idx = genField(c, it.sons[0]) - let tmp = c.genx(it.sons[1]) - c.preventFalseAlias(it.sons[1], whichAsgnOpc(it.sons[1], opcWrObj), - dest, idx, tmp) - c.freeTemp(tmp) - else: - let tmp = c.genx(it) - c.preventFalseAlias(it, whichAsgnOpc(it, opcWrObj), dest, i.TRegister, tmp) - c.freeTemp(tmp) + if n.typ.kind != tyTypeDesc: + c.gABx(n, opcLdNull, dest, c.genType(n.typ)) + # XXX x = (x.old, 22) produces wrong code ... stupid self assignments + for i in 0..<n.len: + let it = n[i] + if it.kind == nkExprColonExpr: + let idx = genField(c, it[0]) + let tmp = c.genx(it[1]) + c.preventFalseAlias(it[1], opcWrObj, + dest, idx, tmp) + c.freeTemp(tmp) + else: + let tmp = c.genx(it) + c.preventFalseAlias(it, opcWrObj, dest, i.TRegister, tmp) + c.freeTemp(tmp) 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 - var L = y.len-1 - while L >= 0: - if s == nil or (y[L].cmpIgnoreStyle(s.name.s) != 0 and y[L] != "*"): - return false - s = s.owner - dec L - result = true - -proc matches(s: PSym; y: varargs[string]): bool = - var s = s - var L = y.len-1 - while L >= 0: - if s == nil or (y[L].cmpIgnoreStyle(s.name.s) != 0 and y[L] != "*"): - return false - s = if sfFromGeneric in s.flags: s.owner.owner else: s.owner - dec L - 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: + globalError(c.config, n.info, "Closure iterators are not supported by VM!") if procIsCallback(c, s): discard - elif sfImportc in s.flags: c.importcSym(n.info, s) + 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 @@ -1807,16 +2182,13 @@ proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = else: globalError(c.config, n.info, "cannot generate code for: " & s.name.s) of nkCallKinds: - if n.sons[0].kind == nkSym: - let s = n.sons[0].sym + if n[0].kind == nkSym: + let s = n[0].sym if s.magic != mNone: - genMagic(c, n, dest, s.magic) - 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) + 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") else: genCall(c, n, dest) clearDest(c, n, dest) @@ -1831,93 +2203,97 @@ 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.sons[0], n.sons[1], n.kind == nkAsgn) + genAsgn(c, n[0], n[1], n.kind == nkAsgn) of nkDotExpr: genObjAccess(c, n, dest, flags) of nkCheckedFieldExpr: genCheckedObjAccess(c, n, dest, flags) of nkBracketExpr: genArrAccess(c, n, dest, flags) - of nkDerefExpr, nkHiddenDeref: genAddrDeref(c, n, dest, opcLdDeref, flags) - of nkAddr, nkHiddenAddr: genAddrDeref(c, n, dest, opcAddrNode, flags) + of nkDerefExpr, nkHiddenDeref: genDeref(c, n, dest, flags) + of nkAddr, nkHiddenAddr: genAddr(c, n, dest, flags) of nkIfStmt, nkIfExpr: genIf(c, n, dest) of nkWhenStmt: # This is "when nimvm" node. Chose the first branch. - gen(c, n.sons[0].sons[1], dest) + gen(c, n[0][1], dest) of nkCaseStmt: genCase(c, n, dest) of nkWhileStmt: unused(c, n, dest) genWhile(c, n) of nkBlockExpr, nkBlockStmt: genBlock(c, n, dest) of nkReturnStmt: - unused(c, n, dest) genReturn(c, n) of nkRaiseStmt: genRaise(c, n) of nkBreakStmt: - unused(c, n, dest) genBreak(c, n) - of nkTryStmt: genTry(c, n, dest) + of nkTryStmt, nkHiddenTryStmt: genTry(c, n, dest) of nkStmtList: #unused(c, n, dest) # XXX Fix this bug properly, lexim triggers it for x in n: gen(c, x) of nkStmtListExpr: - let L = n.len-1 - for i in 0 ..< L: gen(c, n.sons[i]) - gen(c, n.sons[L], dest, flags) + for i in 0..<n.len-1: gen(c, n[i]) + gen(c, n[^1], dest, flags) of nkPragmaBlock: gen(c, n.lastSon, dest, flags) of nkDiscardStmt: unused(c, n, dest) - gen(c, n.sons[0]) + gen(c, n[0]) of nkHiddenStdConv, nkHiddenSubConv, nkConv: - genConv(c, n, n.sons[1], dest) + genConv(c, n, n[1], dest, flags) of nkObjDownConv: - genConv(c, n, n.sons[0], dest) + genConv(c, n, n[0], dest, flags) + of nkObjUpConv: + 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.sons[namePos].sym + #let s = n[namePos].sym #discard genProc(c, s) - genLit(c, newSymNode(n.sons[namePos].sym), dest) + genLit(c, newSymNode(n[namePos].sym), dest) of nkChckRangeF, nkChckRange64, nkChckRange: - let - tmp0 = c.genx(n.sons[0]) - tmp1 = c.genx(n.sons[1]) - tmp2 = c.genx(n.sons[2]) - c.gABC(n, opcRangeChck, tmp0, tmp1, tmp2) - c.freeTemp(tmp1) - c.freeTemp(tmp2) - if dest >= 0: - gABC(c, n, whichAsgnOpc(n), dest, tmp0, 1) - 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: + nkTemplateDef, nkIncludeStmt, nkImportStmt, nkFromStmt, nkExportStmt, + nkMixinStmt, nkBindStmt, declarativeDefs, nkMacroDef: unused(c, n, dest) of nkStringToCString, nkCStringToString: - gen(c, n.sons[0], dest) + gen(c, n[0], dest) of nkBracket: genArrayConstr(c, n, dest) of nkCurly: genSetConstr(c, n, dest) of nkObjConstr: genObjConstr(c, n, dest) of nkPar, nkClosure, nkTupleConstr: genTupleConstr(c, n, dest) of nkCast: if allowCast in c.features: - genConv(c, n, n.sons[1], dest, opcCast) + genConv(c, n, n[1], dest, flags, opcCast) else: - genIntCast(c, n, dest) + genCastIntFloat(c, n, dest) of nkTypeOfExpr: genTypeLit(c, n.typ, dest) of nkComesFrom: discard "XXX to implement for better stack traces" else: - globalError(c.config, n.info, "cannot generate VM code for " & $n) + if n.typ != nil and n.typ.isCompileTimeOnly: + genTypeLit(c, n.typ, dest) + else: + globalError(c.config, n.info, "cannot generate VM code for " & $n) proc removeLastEof(c: PCtx) = let last = c.code.len-1 @@ -1952,29 +2328,29 @@ 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, -0x7fff < diff and diff < 0x7fff) + internalAssert(c.config, regBxMin < diff and diff < regBxMax) let oldInstr = c.code[pc] # opcode and regA stay the same: - c.code[pc] = ((oldInstr.uint32 and 0xffff'u32).uint32 or - uint32(diff+wordExcess) shl 16'u32).TInstr + c.code[pc] = ((oldInstr.TInstrType and ((regOMask shl regOShift) or (regAMask shl regAShift))).TInstrType or + TInstrType(diff+wordExcess) shl regBxShift).TInstr proc genGenericParams(c: PCtx; gp: PNode) = - 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.sons[i].sym + 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 - for i in start ..< c.code.len: + for i in start..<c.code.len: let opc = c.code[i].opcode case opc of opcTJmp, opcFJmp: @@ -1982,8 +2358,8 @@ proc optimizeJumps(c: PCtx; start: int) = var d = i + c.code[i].jmpDiff for iters in countdown(maxIterations, 0): case c.code[d].opcode - of opcJmp, opcJmpBack: - d = d + c.code[d].jmpDiff + of opcJmp: + d += c.code[d].jmpDiff of opcTJmp, opcFJmp: if c.code[d].regA != reg: break # tjmp x, 23 @@ -1991,12 +2367,12 @@ proc optimizeJumps(c: PCtx; start: int) = # tjmp x, 12 # -- we know 'x' is true, and so can jump to 12+13: if c.code[d].opcode == opc: - d = d + c.code[d].jmpDiff + d += c.code[d].jmpDiff else: # tjmp x, 23 # fjmp x, 22 # We know 'x' is true so skip to the next instruction: - d = d + 1 + d += 1 else: break if d != i + c.code[i].jmpDiff: c.finalJumpTarget(i, d - i) @@ -2004,7 +2380,7 @@ proc optimizeJumps(c: PCtx; start: int) = var d = i + c.code[i].jmpDiff var iters = maxIterations while c.code[d].opcode == opcJmp and iters > 0: - d = d + c.code[d].jmpDiff + d += c.code[d].jmpDiff dec iters if c.code[d].opcode == opcRet: # optimize 'jmp to ret' to 'ret' here @@ -2014,26 +2390,30 @@ proc optimizeJumps(c: PCtx; start: int) = else: discard proc genProc(c: PCtx; s: PSym): int = - var x = s.ast.sons[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.sons[0] = newIntNode(nkIntLit, result) - s.ast.sons[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 = s.getBody + 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 @@ -2042,27 +2422,24 @@ proc genProc(c: PCtx; s: PSym): int = genParams(c, s.typ.n) # allocate additional space for any generically bound parameters - if s.kind == skMacro and - sfImmediate notin s.flags and - s.ast[genericParamsPos].kind != nkEmpty: + if s.kind == skMacro and s.isGenericRoutineStrict: genGenericParams(c, s.ast[genericParamsPos]) if tfCapturesEnv in s.typ.flags: - #let env = s.ast.sons[paramsPos].lastSon.sym + #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 - #if s.name.s == "calc": + 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 548a3af97..2d7ad63e7 100644 --- a/compiler/vmhooks.nim +++ b/compiler/vmhooks.nim @@ -7,13 +7,14 @@ # distribution, for details about the copyright. # +import pathutils + +when defined(nimPreviewSlimSystem): + import std/assertions + template setX(k, field) {.dirty.} = - var s: seq[TFullReg] - move(s, cast[seq[TFullReg]](a.slots)) - if s[a.ra].kind != k: - myreset(s[a.ra]) - s[a.ra].kind = k - s[a.ra].field = v + a.slots[a.ra].ensureKind(k) + a.slots[a.ra].field = v proc setResult*(a: VmArgs; v: BiggestInt) = setX(rkInt, intVal) proc setResult*(a: VmArgs; v: BiggestFloat) = setX(rkFloat, floatVal) @@ -22,49 +23,55 @@ proc setResult*(a: VmArgs; v: bool) = setX(rkInt, intVal) proc setResult*(a: VmArgs; v: string) = - var s: seq[TFullReg] - move(s, cast[seq[TFullReg]](a.slots)) - if s[a.ra].kind != rkNode: - myreset(s[a.ra]) - s[a.ra].kind = rkNode - s[a.ra].node = newNode(nkStrLit) - s[a.ra].node.strVal = v + a.slots[a.ra].ensureKind(rkNode) + a.slots[a.ra].node = newNode(nkStrLit) + a.slots[a.ra].node.strVal = v proc setResult*(a: VmArgs; n: PNode) = - var s: seq[TFullReg] - move(s, cast[seq[TFullReg]](a.slots)) - if s[a.ra].kind != rkNode: - myreset(s[a.ra]) - s[a.ra].kind = rkNode - s[a.ra].node = n + a.slots[a.ra].ensureKind(rkNode) + a.slots[a.ra].node = n + +proc setResult*(a: VmArgs; v: AbsoluteDir) = setResult(a, v.string) proc setResult*(a: VmArgs; v: seq[string]) = - var s: seq[TFullReg] - move(s, cast[seq[TFullReg]](a.slots)) - if s[a.ra].kind != rkNode: - myreset(s[a.ra]) - s[a.ra].kind = rkNode + a.slots[a.ra].ensureKind(rkNode) var n = newNode(nkBracket) for x in v: n.add newStrNode(nkStrLit, x) - s[a.ra].node = n + a.slots[a.ra].node = n + +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 getX(k, field) {.dirty.} = +template getReg(a, i): untyped = doAssert i < a.rc-1 - let s = cast[seq[TFullReg]](a.slots) - doAssert s[i+a.rb+1].kind == k - result = s[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 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 - let s = cast[seq[TFullReg]](a.slots) - doAssert s[i+a.rb+1].kind == rkNode - result = s[i+a.rb+1].node.strVal +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 getNode*(a: VmArgs; i: Natural): PNode = - doAssert i < a.rc-1 - let s = cast[seq[TFullReg]](a.slots) - doAssert s[i+a.rb+1].kind == rkNode - result = s[i+a.rb+1].node +proc getNodeAddr*(a: VmArgs; i: Natural): PNode = + let nodeAddr = getX(rkNodeAddr, nodeAddr) + doAssert nodeAddr != nil + result = nodeAddr[] diff --git a/compiler/vmmarshal.nim b/compiler/vmmarshal.nim index eb01b3514..0e67ededa 100644 --- a/compiler/vmmarshal.nim +++ b/compiler/vmmarshal.nim @@ -9,56 +9,58 @@ ## 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: - for i in countup(0, sonsLen(n) - 1): - result = getField(n.sons[i], position) + result = nil + for i in 0..<n.len: + result = getField(n[i], position) if result != nil: return of nkRecCase: - result = getField(n.sons[0], position) + result = getField(n[0], position) if result != nil: return - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind + for i in 1..<n.len: + case n[i].kind of nkOfBranch, nkElse: - result = getField(lastSon(n.sons[i]), position) + result = getField(lastSon(n[i]), position) if result != nil: return 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) proc storeObj(s: var string; typ: PType; x: PNode; stored: var IntSet; conf: ConfigRef) = assert x.kind == nkObjConstr let start = 1 - for i in countup(start, sonsLen(x) - 1): + for i in start..<x.len: if i > start: s.add(", ") - var it = x.sons[i] + var it = x[i] if it.kind == nkExprColonExpr: - if it.sons[0].kind == nkSym: - let field = it.sons[0].sym + if it[0].kind == nkSym: + let field = it[0].sym s.add(escapeJson(field.name.s)) s.add(": ") - storeAny(s, field.typ, it.sons[1], stored, conf) + storeAny(s, field.typ, it[1], stored, conf) elif typ.n != nil: let field = getField(typ.n, i) s.add(escapeJson(field.name.s)) s.add(": ") storeAny(s, field.typ, it, stored, conf) -proc skipColon*(n: PNode): PNode = - result = n - if n.kind == nkExprColonExpr: - result = n.sons[1] - proc storeAny(s: var string; t: PType; a: PNode; stored: var IntSet; conf: ConfigRef) = case t.kind @@ -74,17 +76,17 @@ proc storeAny(s: var string; t: PType; a: PNode; stored: var IntSet; if t.kind == tySequence and a.kind == nkNilLit: s.add("null") else: s.add("[") - for i in 0 .. a.len-1: + for i in 0..<a.len: if i > 0: s.add(", ") storeAny(s, t.elemType, a[i], stored, conf) 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.sons[i], a[i].skipColon, stored, conf) + storeAny(s, ti, a[i].skipColon, stored, conf) s.add("}") of tyObject: s.add("{") @@ -96,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): @@ -124,10 +127,10 @@ proc storeAny(s: var string; t: PType; a: PNode; stored: var IntSet; s.add("[") s.add($x.ptrToInt) s.add(", ") - storeAny(s, t.lastSon, a, stored, conf) + storeAny(s, t.elementType, a, stored, conf) s.add("]") - of tyString, tyCString: - if a.kind == nkNilLit or a.strVal.isNil: s.add("null") + 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) of tyFloat..tyFloat128: s.add($a.floatVal) @@ -141,9 +144,12 @@ proc storeAny*(s: var string; t: PType; a: PNode; conf: ConfigRef) = proc loadAny(p: var JsonParser, t: PType, tab: var Table[BiggestInt, PNode]; cache: IdentCache; - conf: ConfigRef): PNode = + 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) @@ -153,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) @@ -161,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: @@ -175,7 +185,7 @@ proc loadAny(p: var JsonParser, t: PType, next(p) result = newNode(nkBracket) while p.kind != jsonArrayEnd and p.kind != jsonEof: - result.add loadAny(p, t.elemType, tab, cache, conf) + result.add loadAny(p, t.elemType, tab, cache, conf, idgen) if p.kind == jsonArrayEnd: next(p) else: raiseParseErr(p, "']' end of array expected") of tySequence: @@ -187,23 +197,25 @@ proc loadAny(p: var JsonParser, t: PType, next(p) result = newNode(nkBracket) while p.kind != jsonArrayEnd and p.kind != jsonEof: - result.add loadAny(p, t.elemType, tab, cache, conf) + result.add loadAny(p, t.elemType, tab, cache, conf, idgen) 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.sons[i], tab, cache, conf) + result.add loadAny(p, t[i], tab, cache, conf, idgen) inc i if p.kind == jsonObjectEnd: next(p) else: raiseParseErr(p, "'}' end of object expected") @@ -221,12 +233,12 @@ proc loadAny(p: var JsonParser, t: PType, raiseParseErr(p, "unknown field for object of type " & typeToString(t)) next(p) let pos = field.position + 1 - if pos >= result.sons.len: + if pos >= result.len: setLen(result.sons, pos + 1) let fieldNode = newNode(nkExprColonExpr) - fieldNode.addSon(newSymNode(newSym(skField, ident, nil, unknownLineInfo()))) - fieldNode.addSon(loadAny(p, field.typ, tab, cache, conf)) - result.sons[pos] = fieldNode + 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) else: raiseParseErr(p, "'}' end of object expected") of tySet: @@ -234,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) - 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: @@ -249,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) + 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) @@ -267,28 +281,35 @@ 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) + 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): PNode = +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) + result = loadAny(p, t, tab, cache, conf, idgen) close(p) diff --git a/compiler/vmops.nim b/compiler/vmops.nim index a7d47d7a3..45194e633 100644 --- a/compiler/vmops.nim +++ b/compiler/vmops.nim @@ -7,13 +7,41 @@ # distribution, for details about the copyright. # -# Unforunately this cannot be a module yet: +# Unfortunately this cannot be a module yet: #import vmdeps, vm -from math import sqrt, ln, log10, log2, exp, round, arccos, arcsin, +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, fmod + floor, ceil, `mod`, cbrt, arcsinh, arccosh, arctanh, erf, erfc, gamma, + lgamma, divmod +from std/sequtils import toSeq +when declared(math.copySign): + # pending bug #18762, avoid renaming math + from std/math as math2 import copySign -from os import getEnv, existsEnv, dirExists, fileExists, putEnv, walkDir +when declared(math.signbit): + # ditto + from std/math as math3 import signbit + + +from std/envvars import getEnv, existsEnv, delEnv, putEnv, envPairs +from std/os import getAppFilename +from std/private/oscommon import dirExists, fileExists +from std/private/osdirs import walkDir, createDir +from std/private/ospaths2 import getCurrentDir + +from std/times import cpuTime +from std/hashes import hash +from std/osproc import nil + + +when defined(nimPreviewSlimSystem): + import std/syncio +else: + from std/formatfloat import addFloatRoundtrip, addFloatSprintf + + +# There are some useful procs in vmconv. +import vmconv, vmmarshal template mathop(op) {.dirty.} = registerCallback(c, "stdlib.math." & astToStr(op), `op Wrapper`) @@ -21,25 +49,43 @@ template mathop(op) {.dirty.} = template osop(op) {.dirty.} = registerCallback(c, "stdlib.os." & astToStr(op), `op Wrapper`) -template ospathsop(op) {.dirty.} = - registerCallback(c, "stdlib.ospaths." & 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`) template systemop(op) {.dirty.} = registerCallback(c, "stdlib.system." & astToStr(op), `op Wrapper`) +template ioop(op) {.dirty.} = + registerCallback(c, "stdlib.syncio." & astToStr(op), `op Wrapper`) + template macrosop(op) {.dirty.} = registerCallback(c, "stdlib.macros." & 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()) @@ -55,6 +101,11 @@ template wrap2s(op, modop) {.dirty.} = setResult(a, op(getString(a, 0), getString(a, 1))) modop op +template wrap2si(op, modop) {.dirty.} = + proc `op Wrapper`(a: VmArgs) {.nimcall.} = + setResult(a, op(getString(a, 0), getInt(a, 1))) + modop op + template wrap1svoid(op, modop) {.dirty.} = proc `op Wrapper`(a: VmArgs) {.nimcall.} = op(getString(a, 0)) @@ -65,58 +116,302 @@ template wrap2svoid(op, modop) {.dirty.} = op(getString(a, 0), getString(a, 1)) modop op +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 + modop op + else: + proc `op Wrapper`(a: VmArgs) {.nimcall.} = + op(getString(a, 0), getString(a, 1)) + modop op + proc getCurrentExceptionMsgWrapper(a: VmArgs) {.nimcall.} = setResult(a, if a.currentException.isNil: "" - else: a.currentException.sons[3].skipColon.strVal) + else: a.currentException[3].skipColon.strVal) + +proc getCurrentExceptionWrapper(a: VmArgs) {.nimcall.} = + setResult(a, a.currentException) proc staticWalkDirImpl(path: string, relative: bool): PNode = result = newNode(nkBracket) for k, f in walkDir(path, relative): - result.add newTree(nkTupleConstr, newIntNode(nkIntLit, k.ord), - newStrNode(nkStrLit, f)) + result.add toLit((k, f)) + +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 (s, e) = opGorge(getString(a, 0), getString(a, 1), getString(a, 2), + let ret = opGorge(getString(a, 0), getString(a, 1), getString(a, 2), a.currentLineInfo, c.config) - setResult a, newTree(nkTupleConstr, newStrNode(nkStrLit, s), newIntNode(nkIntLit, e)) + setResult a, ret.toLit proc getProjectPathWrapper(a: VmArgs) = - setResult a, c.config.projectPath - - wrap1f_math(sqrt) - wrap1f_math(ln) - wrap1f_math(log10) - wrap1f_math(log2) - wrap1f_math(exp) - wrap1f_math(round) - wrap1f_math(arccos) - wrap1f_math(arcsin) - wrap1f_math(arctan) - 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) - wrap2f_math(fmod) + setResult a, c.config.projectPath.string + + 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): + wrap2fMath(copySign) + + when declared(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: 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, ospathsop) - wrap1s(existsEnv, ospathsop) - wrap2svoid(putEnv, ospathsop) - wrap1s(dirExists, osop) - wrap1s(fileExists, osop) - wrap2svoid(writeFile, systemop) - wrap1s(readFile, systemop) + 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 - registerCallback c, "stdlib.*.staticWalkDir", proc (a: VmArgs) {.nimcall.} = + systemop getCurrentException + registerCallback c, "stdlib.osdirs.staticWalkDir", proc (a: VmArgs) {.nimcall.} = setResult(a, staticWalkDirImpl(getString(a, 0), getBool(a, 1))) - systemop gorgeEx + 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'" + else: + systemop gorgeEx macrosop getProjectPath + + registerCallback c, "stdlib.os.getCurrentCompilerExe", proc (a: VmArgs) {.nimcall.} = + setResult(a, getAppFilename()) + + registerCallback c, "stdlib.macros.symBodyHash", proc (a: VmArgs) = + let n = getNode(a, 0) + if n.kind != nkSym: + stackTrace2(c, "symBodyHash() requires a symbol. '$#' is of kind '$#'" % [$n, $n.kind], n) + setResult(a, $symBodyDigest(c.graph, n.sym)) + + registerCallback c, "stdlib.macros.isExported", proc(a: VmArgs) = + let n = getNode(a, 0) + if n.kind != nkSym: + stackTrace2(c, "isExported() requires a symbol. '$#' is of kind '$#'" % [$n, $n.kind], n) + 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: + # emulate JS's terrible integers: + res = cast[int32](res) + setResult(a, res) + + registerCallback c, "stdlib.hashes.hashVmImpl", hashVmImpl + + proc hashVmImplByte(a: VmArgs) = + # nkBracket[...] + let sPos = a.getInt(1).int + let ePos = a.getInt(2).int + let arr = a.getNode(0) + var bytes = newSeq[byte](arr.len) + for i in 0..<arr.len: + bytes[i] = byte(arr[i].intVal and 0xff) + + var res = hashes.hash(bytes, sPos, ePos) + if c.config.backend == backendJs: + # emulate JS's terrible integers: + res = cast[int32](res) + setResult(a, res) + + registerCallback c, "stdlib.hashes.hashVmImplByte", hashVmImplByte + registerCallback c, "stdlib.hashes.hashVmImplChar", hashVmImplByte + + if optBenchmarkVM in c.config.globalOptions or vmopsDanger in c.config.features: + wrap0(cpuTime, timesop) + else: + proc cpuTime(): float = 5.391245e-44 # Randomly chosen + wrap0(cpuTime, timesop) + + if vmopsDanger in c.config.features: + ## useful procs but these should be opt-in because they may impact + ## 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.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.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: + for e in fn.typ.n[0][effectIndex]: + list.add opMapTypeInstToAst(c.cache, e.typ.skipTypes({tyRef}), e.info, c.idgen) + 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) + setResult(a, fn.typ != nil and tfGcSafe in fn.typ.flags) + + registerCallback c, "stdlib.effecttraits.hasNoSideEffectsImpl", proc (a: VmArgs) = + 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 new file mode 100644 index 000000000..3f0db84bd --- /dev/null +++ b/compiler/vmprofiler.nim @@ -0,0 +1,45 @@ + +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: + prof.tEnter = cpuTime() + prof.tos = tos + +proc leaveImpl(prof: var Profiler, c: PCtx) {.noinline.} = + let tLeave = cpuTime() + var tos = prof.tos + var data = c.config.vmProfileData.data + while tos != nil: + if tos.prc != nil: + let li = tos.prc.info + if li notin data: + data[li] = ProfileInfo() + data[li].time += tLeave - prof.tEnter + if tos == prof.tos: + inc data[li].count + tos = tos.next + +proc leave*(prof: var Profiler, c: PCtx) {.inline.} = + if optProfileVM in c.config.globalOptions: + leaveImpl(prof, c) + +proc dump*(conf: ConfigRef, pd: ProfileData): string = + var data = pd.data + result = "\nprof: µs #instr location" + for i in 0..<32: + var tMax: float + var infoMax: ProfileInfo = default(ProfileInfo) + var flMax: TLineInfo = default(TLineInfo) + for fl, info in data: + if info.time > infoMax.time: + infoMax = info + flMax = fl + if infoMax.count == 0: + break + result.add " " & align($int(infoMax.time * 1e6), 10) & + align($int(infoMax.count), 10) & " " & + conf.toFileLineCol(flMax) & "\n" + data.del flMax 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 91b527e02..39e0b2e25 100644 --- a/compiler/wordrecg.nim +++ b/compiler/wordrecg.nim @@ -13,78 +13,116 @@ # does not support strings. Without this the code would # be slow and unreadable. -from strutils import cmpIgnoreStyle - -# Keywords must be kept sorted and within a range - type TSpecialWord* = enum - wInvalid, - - wAddr, wAnd, wAs, wAsm, - wBind, wBlock, wBreak, wCase, wCast, wConcept, wConst, - wContinue, wConverter, wDefer, wDiscard, wDistinct, wDiv, wDo, - wElif, wElse, wEnd, wEnum, wExcept, wExport, - wFinally, wFor, wFrom, wFunc, wIf, wImport, wIn, - wInclude, wInterface, wIs, wIsnot, wIterator, wLet, - wMacro, wMethod, wMixin, wMod, wNil, - wNot, wNotin, wObject, wOf, wOr, wOut, wProc, wPtr, wRaise, wRef, wReturn, - wShl, wShr, wStatic, wTemplate, wTry, wTuple, wType, wUsing, wVar, - wWhen, wWhile, wXor, wYield, - - wColon, wColonColon, wEquals, wDot, wDotDot, - wStar, wMinus, - wMagic, wThread, wFinal, wProfiler, wMemTracker, wObjChecks, - wIntDefine, wStrDefine, - - wDestroy, - - wImmediate, wConstructor, wDestructor, wDelegator, wOverride, - wImportCpp, wImportObjC, - wImportCompilerProc, - wImportc, wExportc, wExportNims, wIncompleteStruct, wRequiresInit, - wAlign, wNodecl, wPure, wSideeffect, wHeader, - wNosideeffect, wGcSafe, wNoreturn, wMerge, wLib, wDynlib, - wCompilerproc, wCore, wProcVar, wBase, wUsed, - wFatal, wError, wWarning, wHint, wLine, wPush, wPop, wDefine, wUndef, - wLinedir, wStacktrace, wLinetrace, wLink, wCompile, - wLinksys, wDeprecated, wVarargs, wCallconv, wBreakpoint, wDebugger, - wNimcall, wStdcall, wCdecl, wSafecall, wSyscall, wInline, wNoInline, - wFastcall, wClosure, wNoconv, wOn, wOff, wChecks, wRangechecks, - wBoundchecks, wOverflowchecks, wNilchecks, - wFloatchecks, wNanChecks, wInfChecks, wMoveChecks, - wAssertions, wPatterns, wWarnings, - wHints, wOptimization, wRaises, wWrites, wReads, wSize, wEffects, wTags, - wDeadCodeElimUnused, # deprecated, dead code elim always happens - wSafecode, wPackage, wNoForward, wReorder, wNoRewrite, - wPragma, - wCompileTime, wNoInit, - wPassc, wPassl, wBorrow, wDiscardable, - wFieldChecks, - wWatchPoint, wSubsChar, - wAcyclic, wShallow, wUnroll, wLinearScanEnd, wComputedGoto, - wInjectStmt, wExperimental, - wWrite, wGensym, wInject, wDirty, wInheritable, wThreadVar, wEmit, - wAsmNoStackFrame, - wImplicitStatic, wGlobal, wCodegenDecl, wUnchecked, wGuard, wLocks, - wPartial, wExplain, wLiftLocals, - - wAuto, wBool, wCatch, wChar, wClass, - wConst_cast, wDefault, wDelete, wDouble, wDynamic_cast, - wExplicit, wExtern, wFalse, wFloat, wFriend, - wGoto, wInt, wLong, wMutable, wNamespace, wNew, wOperator, - wPrivate, wProtected, wPublic, wRegister, wReinterpret_cast, - wShort, wSigned, wSizeof, wStatic_cast, wStruct, wSwitch, - wThis, wThrow, wTrue, wTypedef, wTypeid, wTypename, - wUnion, wPacked, wUnsigned, wVirtual, wVoid, wVolatile, wWchar_t, - - wAlignas, wAlignof, wConstexpr, wDecltype, wNullptr, wNoexcept, - wThread_local, wStatic_assert, wChar16_t, wChar32_t, - - wStdIn, wStdOut, wStdErr, - - wInOut, wByCopy, wByRef, wOneWay, - wBitsize, + 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", + 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", + 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", + wVar = "var", wWhen = "when", wWhile = "while", wXor = "xor", wYield = "yield", + + wColon = ":", wColonColon = "::", wEquals = "=", wDot = ".", wDotDot = "..", + wStar = "*", wMinus = "-", + wUnderscore = "_", + wMagic = "magic", wThread = "thread", wFinal = "final", wProfiler = "profiler", + wMemTracker = "memtracker", wObjChecks = "objchecks", + wIntDefine = "intdefine", wStrDefine = "strdefine", wBoolDefine = "booldefine", + wCursor = "cursor", wNoalias = "noalias", wEffectsOf = "effectsOf", + wUncheckedAssign = "uncheckedAssign", wRunnableExamples = "runnableExamples", + + 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", + 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", 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", + wStackTrace = "stackTrace", wLineTrace = "lineTrace", wLink = "link", wCompile = "compile", + 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", + wBoundChecks = "boundChecks", wOverflowChecks = "overflowChecks", wNilChecks = "nilChecks", + wFloatChecks = "floatChecks", wNanChecks = "nanChecks", wInfChecks = "infChecks", + wStyleChecks = "styleChecks", wStaticBoundchecks = "staticBoundChecks", + wNonReloadable = "nonReloadable", wExecuteOnReload = "executeOnReload", + + wAssertions = "assertions", wPatterns = "patterns", wTrMacros = "trmacros", + wSinkInference = "sinkInference", wWarnings = "warnings", + wHints = "hints", wOptimization = "optimization", wRaises = "raises", + wWrites = "writes", wReads = "reads", wSize = "size", wEffects = "effects", wTags = "tags", + 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", + wFieldChecks = "fieldChecks", wSubsChar = "subschar", wAcyclic = "acyclic", + wShallow = "shallow", wUnroll = "unroll", wLinearScanEnd = "linearScanEnd", + wComputedGoto = "computedGoto", wExperimental = "experimental", wDoctype = "doctype", + wWrite = "write", wGensym = "gensym", wInject = "inject", wDirty = "dirty", + wInheritable = "inheritable", wThreadVar = "threadvar", wEmit = "emit", + wAsmNoStackFrame = "asmNoStackFrame", wAsmSyntax = "asmSyntax", wImplicitStatic = "implicitStatic", + wGlobal = "global", wCodegenDecl = "codegenDecl", wUnchecked = "unchecked", + wGuard = "guard", wLocks = "locks", wPartial = "partial", wExplain = "explain", + wLiftLocals = "liftlocals", wEnforceNoRaises = "enforceNoRaises", wSystemRaisesDefect = "systemRaisesDefect", + 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", + wUnsigned = "unsigned", wVoid = "void", + + wAlignas = "alignas", wAlignof = "alignof", wConstexpr = "constexpr", wDecltype = "decltype", + wNullptr = "nullptr", wNoexcept = "noexcept", + wThreadLocal = "thread_local", wStaticAssert = "static_assert", + wChar16 = "char16_t", wChar32 = "char32_t", wWchar = "wchar_t", + + wStdIn = "stdin", wStdOut = "stdout", wStdErr = "stderr", + + wInOut = "inout", wOneWay = "oneway", + # end of codegen keywords + + wBitsize = "bitsize", wImportHidden = "all", + wSendable = "sendable" TSpecialWords* = set[TSpecialWord] @@ -95,89 +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 + - specialWords*: array[low(TSpecialWord)..high(TSpecialWord), string] = ["", - - "addr", "and", "as", "asm", - "bind", "block", "break", "case", "cast", - "concept", "const", "continue", "converter", - "defer", "discard", "distinct", "div", "do", - "elif", "else", "end", "enum", "except", "export", - "finally", "for", "from", "func", "if", - "import", "in", "include", "interface", "is", "isnot", "iterator", - "let", - "macro", "method", "mixin", "mod", "nil", "not", "notin", - "object", "of", "or", - "out", "proc", "ptr", "raise", "ref", "return", - "shl", "shr", "static", - "template", "try", "tuple", "type", "using", "var", - "when", "while", "xor", - "yield", - - ":", "::", "=", ".", "..", - "*", "-", - "magic", "thread", "final", "profiler", "memtracker", "objchecks", "intdefine", "strdefine", - - "destroy", - - "immediate", "constructor", "destructor", "delegator", "override", - "importcpp", "importobjc", - "importcompilerproc", "importc", "exportc", "exportnims", - "incompletestruct", - "requiresinit", "align", "nodecl", "pure", "sideeffect", - "header", "nosideeffect", "gcsafe", "noreturn", "merge", "lib", "dynlib", - "compilerproc", "core", "procvar", "base", "used", - "fatal", "error", "warning", "hint", "line", - "push", "pop", "define", "undef", "linedir", "stacktrace", "linetrace", - "link", "compile", "linksys", "deprecated", "varargs", - "callconv", "breakpoint", "debugger", "nimcall", "stdcall", - "cdecl", "safecall", "syscall", "inline", "noinline", "fastcall", "closure", - "noconv", "on", "off", "checks", "rangechecks", "boundchecks", - "overflowchecks", "nilchecks", - "floatchecks", "nanchecks", "infchecks", "movechecks", - - "assertions", "patterns", "warnings", "hints", - "optimization", "raises", "writes", "reads", "size", "effects", "tags", - "deadcodeelim", # deprecated, dead code elim always happens - "safecode", "package", "noforward", "reorder", "norewrite", - "pragma", - "compiletime", "noinit", - "passc", "passl", "borrow", "discardable", "fieldchecks", - "watchpoint", - "subschar", "acyclic", "shallow", "unroll", "linearscanend", - "computedgoto", "injectstmt", "experimental", - "write", "gensym", "inject", "dirty", "inheritable", "threadvar", "emit", - "asmnostackframe", "implicitstatic", "global", "codegendecl", "unchecked", - "guard", "locks", "partial", "explain", "liftlocals", - - "auto", "bool", "catch", "char", "class", - "const_cast", "default", "delete", "double", - "dynamic_cast", "explicit", "extern", "false", - "float", "friend", "goto", "int", "long", "mutable", - "namespace", "new", "operator", - "private", "protected", "public", "register", "reinterpret_cast", - "short", "signed", "sizeof", "static_cast", "struct", "switch", - "this", "throw", "true", "typedef", "typeid", - "typename", "union", "packed", "unsigned", "virtual", "void", "volatile", - "wchar_t", - - "alignas", "alignof", "constexpr", "decltype", "nullptr", "noexcept", - "thread_local", "static_assert", "char16_t", "char32_t", - - "stdin", "stdout", "stderr", - - "inout", "bycopy", "byref", "oneway", - "bitsize", - ] - -proc findStr*(a: openArray[string], s: string): int = - for i in countup(low(a), high(a)): - if cmpIgnoreStyle(a[i], s) == 0: - return i - result = - 1 +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) diff --git a/compiler/writetracking.nim b/compiler/writetracking.nim deleted file mode 100644 index 1ea1deb2d..000000000 --- a/compiler/writetracking.nim +++ /dev/null @@ -1,277 +0,0 @@ -# -# -# The Nim Compiler -# (c) Copyright 2015 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements the write tracking analysis. Read my block post for -## a basic description of the algorithm and ideas. -## The algorithm operates in 2 phases: -## -## * Collecting information about assignments (and pass-by-var calls). -## * Computing an aliasing relation based on the assignments. This relation -## is then used to compute the 'writes' and 'escapes' effects. - -import intsets, idents, ast, astalgo, trees, renderer, msgs, types, options, - lineinfos - -const - debug = false - -type - AssignToResult = enum - asgnNil, # 'nil' is fine - asgnNew, # 'new(result)' - asgnOther # result = fooBar # not a 'new' --> 'result' might not 'new' - NewLocation = enum - newNone, - newLit, - newCall - RootInfo = enum - rootIsResultOrParam, - rootIsHeapAccess, - rootIsSym, - markAsWrittenTo, - markAsEscaping - - Assignment = object # \ - # Note that the transitive closures MUST be computed in - # phase 2 of the algorithm. - dest, src: seq[ptr TSym] # we use 'ptr' here to save RC ops and GC cycles - destNoTc, srcNoTc: int # length of 'dest', 'src' without the - # transitive closure - destInfo: set[RootInfo] - info: TLineInfo - - W = object # WriteTrackContext - owner: PSym - returnsNew: AssignToResult # assignments to 'result' - assignments: seq[Assignment] # list of all assignments in this proc - -proc allRoots(n: PNode; result: var seq[ptr TSym]; info: var set[RootInfo]) = - case n.kind - of nkSym: - if n.sym.kind in {skParam, skVar, skTemp, skLet, skResult, skForVar}: - if n.sym.kind in {skResult, skParam}: incl(info, rootIsResultOrParam) - result.add(cast[ptr TSym](n.sym)) - of nkHiddenDeref, nkDerefExpr: - incl(info, rootIsHeapAccess) - allRoots(n.sons[0], result, info) - of nkDotExpr, nkBracketExpr, nkCheckedFieldExpr, - nkHiddenAddr, nkObjUpConv, nkObjDownConv: - allRoots(n.sons[0], result, info) - of nkExprEqExpr, nkExprColonExpr, nkHiddenStdConv, nkHiddenSubConv, nkConv, - nkStmtList, nkStmtListExpr, nkBlockStmt, nkBlockExpr, nkOfBranch, - nkElifBranch, nkElse, nkExceptBranch, nkFinally, nkCast: - allRoots(n.lastSon, result, info) - of nkCallKinds: - if getMagic(n) == mSlice: - allRoots(n.sons[1], result, info) - else: - # we do significantly better here by using the available escape - # information: - if n.sons[0].typ.isNil: return - var typ = n.sons[0].typ - if typ != nil: - typ = skipTypes(typ, abstractInst) - if typ.kind != tyProc: typ = nil - else: assert(sonsLen(typ) == sonsLen(typ.n)) - - for i in 1 ..< n.len: - let it = n.sons[i] - if typ != nil and i < sonsLen(typ): - assert(typ.n.sons[i].kind == nkSym) - let paramType = typ.n.sons[i] - if paramType.typ.isCompileTimeOnly: continue - if sfEscapes in paramType.sym.flags or paramType.typ.kind == tyVar: - allRoots(it, result, info) - else: - allRoots(it, result, info) - else: - for i in 0..<n.safeLen: - allRoots(n.sons[i], result, info) - -proc addAsgn(a: var Assignment; dest, src: PNode; destInfo: set[RootInfo]) = - a.dest = @[] - a.src = @[] - a.destInfo = destInfo - allRoots(dest, a.dest, a.destInfo) - if dest.kind == nkSym: incl(a.destInfo, rootIsSym) - if src != nil: - var dummy: set[RootInfo] - allRoots(src, a.src, dummy) - a.destNoTc = a.dest.len - a.srcNoTc = a.src.len - a.info = dest.info - #echo "ADDING ", dest.info, " ", a.destInfo - -proc srcHasSym(a: Assignment; x: ptr TSym): bool = - for i in 0 ..< a.srcNoTc: - if a.src[i] == x: return true - -proc returnsNewExpr*(n: PNode): NewLocation = - case n.kind - of nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, - nkFloatLit..nkFloat64Lit, nkNilLit: - result = newLit - of nkExprEqExpr, nkExprColonExpr, nkHiddenStdConv, nkHiddenSubConv, - nkStmtList, nkStmtListExpr, nkBlockStmt, nkBlockExpr, nkOfBranch, - nkElifBranch, nkElse, nkExceptBranch, nkFinally, nkCast: - result = returnsNewExpr(n.lastSon) - of nkCurly, nkBracket, nkPar, nkTupleConstr, nkObjConstr, nkClosure, - nkIfExpr, nkIfStmt, nkWhenStmt, nkCaseStmt, nkTryStmt: - result = newLit - for i in ord(n.kind == nkObjConstr) ..< n.len: - let x = returnsNewExpr(n.sons[i]) - case x - of newNone: return newNone - of newLit: discard - of newCall: result = newCall - of nkCallKinds: - if n.sons[0].typ != nil and tfReturnsNew in n.sons[0].typ.flags: - result = newCall - else: - result = newNone - -proc deps(w: var W; dest, src: PNode; destInfo: set[RootInfo]) = - # let x = (localA, localB) - # compute 'returnsNew' property: - let retNew = if src.isNil: newNone else: returnsNewExpr(src) - if dest.kind == nkSym and dest.sym.kind == skResult: - if retNew != newNone: - if w.returnsNew != asgnOther: w.returnsNew = asgnNew - else: - w.returnsNew = asgnOther - # mark the dependency, but - # rule out obviously innocent assignments like 'somebool = true' - if dest.kind == nkSym and retNew == newLit: discard - else: - let L = w.assignments.len - w.assignments.setLen(L+1) - addAsgn(w.assignments[L], dest, src, destInfo) - -proc depsArgs(w: var W; n: PNode) = - if n.sons[0].typ.isNil: return - var typ = skipTypes(n.sons[0].typ, abstractInst) - if typ.kind != tyProc: return - # echo n.info, " ", n, " ", w.owner.name.s, " ", typeToString(typ) - assert(sonsLen(typ) == sonsLen(typ.n)) - for i in 1 ..< n.len: - let it = n.sons[i] - if i < sonsLen(typ): - assert(typ.n.sons[i].kind == nkSym) - let paramType = typ.n.sons[i] - if paramType.typ.isCompileTimeOnly: continue - var destInfo: set[RootInfo] = {} - if sfWrittenTo in paramType.sym.flags or paramType.typ.kind == tyVar: - # p(f(x, y), X, g(h, z)) - destInfo.incl markAsWrittenTo - if sfEscapes in paramType.sym.flags: - destInfo.incl markAsEscaping - if destInfo != {}: - deps(w, it, nil, destInfo) - -proc deps(w: var W; n: PNode) = - case n.kind - of nkLetSection, nkVarSection: - for child in n: - let last = lastSon(child) - if last.kind == nkEmpty: continue - if child.kind == nkVarTuple and last.kind in {nkPar, nkTupleConstr}: - if child.len-2 != last.len: return - for i in 0 .. child.len-3: - deps(w, child.sons[i], last.sons[i], {}) - else: - for i in 0 .. child.len-3: - deps(w, child.sons[i], last, {}) - of nkAsgn, nkFastAsgn: - deps(w, n.sons[0], n.sons[1], {}) - else: - for i in 0 ..< n.safeLen: - deps(w, n.sons[i]) - if n.kind in nkCallKinds: - if getMagic(n) in {mNew, mNewFinalize, mNewSeq}: - # may not look like an assignment, but it is: - deps(w, n.sons[1], newNodeIT(nkObjConstr, n.info, n.sons[1].typ), {}) - else: - depsArgs(w, n) - -proc possibleAliases(w: var W; result: var seq[ptr TSym]) = - # this is an expensive fixpoint iteration. We could speed up this analysis - # by a smarter data-structure but we wait until profiling shows us it's - # expensive. Usually 'w.assignments' is small enough. - var alreadySeen = initIntSet() - template addNoDup(x) = - if not alreadySeen.containsOrIncl(x.id): result.add x - for x in result: alreadySeen.incl x.id - - var todo = 0 - while todo < result.len: - let x = result[todo] - inc todo - for i in 0..<len(w.assignments): - let a = addr(w.assignments[i]) - #if a.srcHasSym(x): - # # y = f(..., x, ...) - # for i in 0 ..< a.destNoTc: addNoDup a.dest[i] - if a.destNoTc > 0 and a.dest[0] == x and rootIsSym in a.destInfo: - # x = f(..., y, ....) - for i in 0 ..< a.srcNoTc: addNoDup a.src[i] - -proc markWriteOrEscape(w: var W; conf: ConfigRef) = - ## Both 'writes' and 'escapes' effects ultimately only care - ## about *parameters*. - ## However, due to aliasing, even locals that might not look as parameters - ## have to count as parameters if they can alias a parameter: - ## - ## .. code-block:: nim - ## proc modifies(n: Node) {.writes: [n].} = - ## let x = n - ## x.data = "abc" - ## - ## We call a symbol *parameter-like* if it is a parameter or can alias a - ## parameter. - ## Let ``p``, ``q`` be *parameter-like* and ``x``, ``y`` be general - ## expressions. - ## - ## A write then looks like ``p[] = x``. - ## An escape looks like ``p[] = q`` or more generally - ## like ``p[] = f(q)`` where ``f`` can forward ``q``. - for i in 0..<len(w.assignments): - let a = addr(w.assignments[i]) - if a.destInfo != {}: - possibleAliases(w, a.dest) - - if {rootIsHeapAccess, markAsWrittenTo} * a.destInfo != {}: - for p in a.dest: - if p.kind == skParam and p.owner == w.owner: - incl(p.flags, sfWrittenTo) - if w.owner.kind == skFunc and p.typ.kind != tyVar: - localError(conf, a.info, "write access to non-var parameter: " & p.name.s) - - if {rootIsResultOrParam, rootIsHeapAccess, markAsEscaping}*a.destInfo != {}: - var destIsParam = false - for p in a.dest: - if p.kind in {skResult, skParam} and p.owner == w.owner: - destIsParam = true - break - if destIsParam: - possibleAliases(w, a.src) - for p in a.src: - if p.kind == skParam and p.owner == w.owner: - incl(p.flags, sfEscapes) - -proc trackWrites*(owner: PSym; body: PNode; conf: ConfigRef) = - var w: W - w.owner = owner - w.assignments = @[] - # Phase 1: Collect and preprocess any assignments in the proc body: - deps(w, body) - # Phase 2: Compute the 'writes' and 'escapes' effects: - markWriteOrEscape(w, conf) - if w.returnsNew != asgnOther and not isEmptyType(owner.typ.sons[0]) and - containsGarbageCollectedRef(owner.typ.sons[0]): - incl(owner.typ.flags, tfReturnsNew) |