diff options
Diffstat (limited to 'compiler')
204 files changed, 83894 insertions, 37166 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 7accb8ce3..fa1167753 100644 --- a/compiler/aliases.nim +++ b/compiler/aliases.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -10,55 +10,63 @@ ## 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 arNo, arMaybe, arYes -proc isPartOfAux(a, b: PType, marker: var TIntSet): TAnalysisResult +proc isPartOfAux(a, b: PType, marker: var IntSet): TAnalysisResult -proc isPartOfAux(n: PNode, b: PType, marker: var TIntSet): TAnalysisResult = +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) + of nkRecList: + 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 - of nkOfBranch, nkElse: - result = isPartOfAux(lastSon(n.sons[i]), b, marker) + for i in 1..<n.len: + case n[i].kind + of nkOfBranch, nkElse: + result = isPartOfAux(lastSon(n[i]), b, marker) if result == arYes: return - else: internalError("isPartOfAux(record case branch)") + else: discard "isPartOfAux(record case branch)" of nkSym: result = isPartOfAux(n.sym.typ, b, marker) - else: internalError(n.info, "isPartOfAux()") - -proc isPartOfAux(a, b: PType, marker: var TIntSet): TAnalysisResult = + else: discard + +proc isPartOfAux(a, b: PType, marker: var IntSet): TAnalysisResult = result = arNo - if a == nil or b == nil: return - if ContainsOrIncl(marker, a.id): return + if a == nil or b == nil: return + if containsOrIncl(marker, a.id): return if compareTypes(a, b, dcEqIgnoreDistinct): return arYes case a.kind - of tyObject: - result = isPartOfAux(a.sons[0], b, marker) + of tyObject: + if a.baseClass != nil: + result = isPartOfAux(a.baseClass.skipTypes(skipPtrs), b, marker) if result == arNo: result = isPartOfAux(a.n, b, marker) - of tyGenericInst, tyDistinct: - result = isPartOfAux(lastSon(a), b, marker) - of tyArray, tyArrayConstr, tySet, tyTuple: - for i in countup(0, sonsLen(a) - 1): - result = isPartOfAux(a.sons[i], b, marker) - if result == arYes: return - else: nil - -proc isPartOf(a, b: PType): TAnalysisResult = + of tyGenericInst, tyDistinct, tyAlias, tySink: + 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 + +proc isPartOf(a, b: PType): TAnalysisResult = ## checks iff 'a' can be part of 'b'. Iterates over VALUE types! - var marker = InitIntSet() + var marker = initIntSet() # watch out: parameters reversed because I'm too lazy to change the code... result = isPartOfAux(b, a, marker) @@ -70,34 +78,39 @@ proc isPartOf*(a, b: PNode): TAnalysisResult = ## type. Since however type analysis is more expensive, we perform it only ## if necessary. ## - ## cases: + ## 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: - const varKinds = {skVar, skTemp, skProc} + const varKinds = {skVar, skTemp, skProc, skFunc} # same symbol: aliasing: if a.sym.id == b.sym.id: result = arYes - elif a.sym.kind in varKinds or b.sym.kind in varKinds: + elif a.sym.kind in varKinds or b.sym.kind in varKinds: # actually, a param could alias a var but we know that cannot happen # here. XXX make this more generic result = arNo @@ -105,24 +118,26 @@ 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; - # if they are + # we know it's the same array and we have 2 constant indexes; + # if they are var x = if a[1].kind == nkHiddenStdConv: a[1][1] else: a[1] var y = if b[1].kind == nkHiddenStdConv: b[1][1] else: b[1] - - if SameValue(x, y): result = arYes + + if sameValue(x, y): result = arYes else: result = arNo # else: maybe and no are accurate else: # pointer derefs: if result != arYes: if isPartOf(a.typ, b.typ) != arNo: result = arMaybe - + of nkDotExpr: result = isPartOf(a[0], b[0]) if result != arNo: @@ -135,35 +150,36 @@ proc isPartOf*(a, b: PNode): TAnalysisResult = # weaken because of indirection: if result != arYes: if isPartOf(a.typ, b.typ) != arNo: result = arMaybe - + of nkHiddenStdConv, nkHiddenSubConv, nkConv: result = isPartOf(a[1], b[1]) of nkObjUpConv, nkObjDownConv, nkCheckedFieldExpr: result = isPartOf(a[0], b[0]) - else: nil + else: result = arNo # Calls return a new location, so a default of ``arNo`` is fine. else: # go down recursively; this is quite demanding: - const + const Ix0Kinds = {nkDotExpr, nkBracketExpr, nkObjUpConv, nkObjDownConv, - nkCheckedFieldExpr} + nkCheckedFieldExpr, nkHiddenAddr} Ix1Kinds = {nkHiddenStdConv, nkHiddenSubConv, nkConv} DerefKinds = {nkHiddenDeref, nkDerefExpr} case b.kind of Ix0Kinds: # a* !<| b.f iff a* !<| b result = isPartOf(a, b[0]) - + of DerefKinds: - # a* !<| b[] iff + # a* !<| b[] iff + result = arNo if isPartOf(a.typ, b.typ) != arNo: result = isPartOf(a, b[0]) if result == arNo: result = arMaybe - + of Ix1Kinds: # a* !<| T(b) iff a* !<| b result = isPartOf(a, b[1]) - + of nkSym: # b is an atom, so we have to check a: case a.kind @@ -172,11 +188,31 @@ proc isPartOf*(a, b: PNode): TAnalysisResult = result = isPartOf(a[0], b) of Ix1Kinds: result = isPartOf(a[1], b) - + of DerefKinds: if isPartOf(a.typ, b.typ) != arNo: result = isPartOf(a[0], b) if result == arNo: result = arMaybe - else: nil - else: nil - + else: + result = arNo + else: result = arNo + of nkObjConstr: + result = arNo + for i in 1..<b.len: + let res = isPartOf(a, b[i][1]) + if res != arNo: + result = res + if res == arYes: break + 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 3456177d3..a342e1ea7 100644 --- a/compiler/ast.nim +++ b/compiler/ast.nim @@ -1,7 +1,7 @@ # # -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -9,307 +9,188 @@ # abstract syntax tree + symbol table -import - msgs, hashes, nversion, options, strutils, crc, ropes, idents, lists, - intsets, idgen - -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 - -const - CallingConvToStr*: array[TCallingConvention, string] = ["", "stdcall", - "cdecl", "safecall", "syscall", "inline", "noinline", "fastcall", - "closure", "noconv"] - -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 - nkMetaNode, # difficult to explain; represents itself - # (used for macros) - 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 - - nkModule, # the syntax tree of a module - 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 - 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 - 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: - nkTypeOfExpr, # type(1+2) - nkObjectTy, # object body - nkTupleTy, # tuple body - 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 +import + lineinfos, options, ropes, idents, int128, wordrecg + +import std/[tables, hashes] +from std/strutils import toLowerAscii + +when defined(nimPreviewSlimSystem): + import std/assertions + +export int128 + +import nodekinds +export nodekinds + +type + TCallingConvention* = enum + ccNimCall = "nimcall" # nimcall, also the default + 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 30 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 + sfFromGeneric, # symbol is instantiation of a generic; this is needed # for symbol file generation; such symbols should always # be written into the ROD file sfGlobal, # symbol is at global scope sfForward, # symbol is forward declared + sfWasForwarded, # symbol had a forward declaration + # (implies it's too dangerous to patch its type signature) sfImportc, # symbol is external; imported sfExportc, # symbol is exported (under a specified name) + sfMangleCpp, # mangle as cpp (combines with `sfExportc`) sfVolatile, # variable is volatile sfRegister, # variable should be placed in a register sfPure, # object is "pure" that means it has no type-information - + # enum is "pure", its values need qualified access + # variable is "pure"; it's an explicit "global" sfNoSideEffect, # proc has no side effects sfSideEffect, # proc may have side effects; cannot prove it has none sfMainModule, # module is the main module sfSystemModule, # module is the system module sfNoReturn, # proc never returns (an exit proc) - sfAddrTaken, # the variable's address is taken (ex- or implicitely); + sfAddrTaken, # the variable's address is taken (ex- or implicitly); # *OR*: a proc is indirectly called (used as first class) sfCompilerProc, # proc is a compiler proc, that is a C proc that is # needed for the code generator - sfProcvar, # proc can be passed to a proc var + 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 - sfMerge, # proc can be merged with itself - sfDeadCodeElim, # dead code elimination for the module is turned on + sfConstructor, # proc is a C++ constructor + sfDispatcher, # copied method symbol is the dispatcher + # deprecated and unused, except for the con sfBorrow, # proc is borrowed sfInfixCall, # symbol needs infix call syntax in target language; # for interfacing with C++, JS sfNamedParamCall, # symbol needs named parameter call syntax in target # language; for interfacing with Objective C - sfDiscardable, # returned value may be discarded implicitely - sfDestructor, # proc is destructor + sfDiscardable, # returned value may be discarded implicitly + sfOverridden, # proc is overridden + sfCallsite # A flag for template symbols to tell the + # compiler it should use line information from + # the calling side of the macro, not from the + # implementation. sfGenSym # symbol is 'gensym'ed; do not add to symbol table + sfNonReloadable # symbol will be left as-is when hot code reloading is on - + # meaning that it won't be renamed and/or changed in any way + sfGeneratedOp # proc is a generated '='; do not inject destructors in it + # variable is generated closure environment; requires early + # destruction for --newruntime. + sfTemplateParam # symbol is a template parameter + sfCursor # variable/field is a cursor, see RFC 177 for details + sfInjectDestructors # whether the proc needs the 'injectdestructors' transformation + sfNeverRaises # proc can never raise an exception, not even OverflowDefect + # or out-of-memory + sfSystemRaisesDefect # proc in the system can raise defects + sfUsedInFinallyOrExcept # symbol is used inside an 'except' or 'finally' + sfSingleUsedTemp # For temporaries that we know will only be used once + sfNoalias # 'noalias' annotation, means C's 'restrict' + # for templates and macros, means cannot be called + # as a lone symbol (cannot use alias syntax) + sfEffectsDelayed # an 'effectsDelayed' parameter + sfGeneratedType # A anonymous generic type that is generated by the compiler for + # objects that do not have generic parameters in case one of the + # object fields has one. + # + # This is disallowed but can cause the typechecking to go into + # an infinite loop, this flag is used as a sentinel to stop it. + sfVirtual # proc is a C++ virtual function + sfByCopy # param is marked as pass bycopy + sfMember # proc is a C++ member of a type + sfCodegenDecl # type, proc, global or proc param is marked as codegenDecl + sfWasGenSym # symbol was 'gensym'ed + sfForceLift # variable has to be lifted into closure environment + + sfDirty # template is not hygienic (old styled template) module, + # compiled from a dirty-buffer + sfCustomPragma # symbol is custom pragma template + sfBase, # a base method + sfGoto # var is used for 'goto' code generation + sfAnon, # symbol name that was generated by the compiler + # the compiler will avoid printing such names + # in user messages. + sfAllUntyped # macro or template is immediately expanded in a generic context + sfTemplateRedefinition # symbol is a redefinition of an earlier template TSymFlags* = set[TSymFlag] const - sfFakeConst* = sfDeadCodeElim # const cannot be put into a data section - sfDispatcher* = sfDeadCodeElim # copied method symbol is the dispatcher sfNoInit* = sfMainModule # don't generate code to init the variable - sfImmediate* = sfDeadCodeElim - # macro or template is immediately expanded - # without considering any possible overloads - - sfDirty* = sfPure - # template is not hygienic (old styled template) - # module, compiled from a dirty-buffer - - sfAnon* = sfDiscardable - # symbol name that was generated by the compiler - # the compiler will avoid printing such names - # in user messages. - sfNoForward* = sfRegister # forward declarations are not required (per module) + sfReorder* = sfForward + # reordering pass is enabled - sfNoRoot* = sfBorrow # a local variable is provably no root so it doesn't - # require RC ops + sfCompileToCpp* = sfInfixCall # compile the module as C++ code + sfCompileToObjc* = sfNamedParamCall # compile the module as Objective-C code + sfExperimental* = sfOverridden # module uses the .experimental switch + sfWrittenTo* = sfBorrow # param is assigned to + # currently unimplemented + sfCppMember* = { sfVirtual, sfMember, sfConstructor } # proc is a C++ member, meaning it will be attached to the type definition const # getting ready for the future expr/stmt merge nkWhen* = nkWhenStmt nkWhenExpr* = nkWhenStmt - nkEffectList* = nkArgList + nkEffectList* = nkArgList # hacks ahead: an nkEffectList is a node with 4 children: exceptionEffects* = 0 # exceptions at position 0 - readEffects* = 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! # Don't forget to change hti.nim if you make a change here # XXX put this into an include file to avoid this issue! + # several types are no longer used (guess which), but a + # spot in the sequence is kept for backwards compatibility + # (apparently something with bootstrapping) + # if you need to add a type, they can apparently be reused tyNone, tyBool, tyChar, - tyEmpty, tyArrayConstr, tyNil, tyExpr, tyStmt, tyTypeDesc, - tyGenericInvokation, # ``T[a, b]`` for types to invoke + tyEmpty, tyAlias, tyNil, tyUntyped, tyTyped, tyTypeDesc, + tyGenericInvocation, # ``T[a, b]`` for types to invoke tyGenericBody, # ``T[a, b, body]`` last parameter is the body tyGenericInst, # ``T[a, b, realInstance]`` instantiated generic type # realInstance will be a concrete type like tyObject # unless this is an instance of a generic alias type. # then realInstance will be the tyGenericInst of the # completely (recursively) resolved alias. - + tyGenericParam, # ``a`` in the above patterns tyDistinct, tyEnum, @@ -324,20 +205,90 @@ 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, - tyBigNum, - tyConst, tyMutable, tyVarargs, - tyIter, # unused - tyProxy # used as errornous type (for idetools) - tyTypeClass, + tyOwned, tySink, tyLent, + tyVarargs, + tyUncheckedArray + # An array with boundaries [0,+∞] + + tyError # used as erroneous type (for idetools) + # as an erroneous node should match everything + + tyBuiltInTypeClass + # Type such as the catch-all object, tuple, seq, etc + + tyUserTypeClass + # the body of a user-defined type class + + tyUserTypeClassInst + # Instance of a parametric user-defined type class. + # Structured similarly to tyGenericInst. + # tyGenericInst represents concrete types, while + # this is still a "generic param" that will bind types + # and resolves them during sigmatch and instantiation. + + tyCompositeTypeClass + # Type such as seq[Number] + # The notes for tyUserTypeClassInst apply here as well + # sons[0]: the original expression used by the user. + # sons[1]: fully expanded and instantiated meta type + # (potentially following aliases) + + tyInferred + # In the initial state `base` stores a type class constraining + # the types that can be inferred. After a candidate type is + # selected, it's stored in `last`. Between `base` and `last` + # there may be 0, 2 or more types that were also considered as + # possible candidates in the inference process (i.e. last will + # be updated to store a type best conforming to all candidates) + + tyAnd, tyOr, tyNot + # boolean type classes such as `string|int`,`not seq`, + # `Sortable and Enumable`, etc + + tyAnything + # a type class matching any type + + tyStatic + # a value known at compile type (the underlying type is .base) + + tyFromExpr + # This is a type representing an expression that depends + # on generic parameters (the expression is stored in t.n) + # It will be converted to a real type only during generic + # instantiation and prior to this it has the potential to + # be any type. + + tyConcept + # new style concept. + + tyVoid + # now different from tyEmpty, hurray! + tyIterable + +static: + # remind us when TTypeKind stops to fit in a single 64-bit word + # assert TTypeKind.high.ord <= 63 + discard const tyPureObject* = tyTuple GcTypeKinds* = {tyRef, tySequence, tyString} - tyError* = tyProxy # as an errornous node should match everything + + tyTypeClasses* = {tyBuiltInTypeClass, tyCompositeTypeClass, + tyUserTypeClass, tyUserTypeClassInst, + tyAnd, tyOr, tyNot, tyAnything} + + tyMetaTypes* = {tyGenericParam, tyTypeDesc, tyUntyped} + tyTypeClasses + tyUserTypeClasses* = {tyUserTypeClass, tyUserTypeClassInst} + # consider renaming as `tyAbstractVarRange` + abstractVarRange* = {tyGenericInst, tyRange, tyVar, tyDistinct, tyOrdinal, + tyTypeDesc, tyAlias, tyInferred, tySink, tyOwned} + abstractInst* = {tyGenericInst, tyDistinct, tyOrdinal, tyTypeDesc, tyAlias, + tyInferred, tySink, tyOwned} # xxx what about tyStatic? type TTypeKinds* = set[TTypeKind] @@ -351,43 +302,103 @@ type # but unfortunately it has measurable impact for compilation # efficiency nfTransf, # node has been transformed + nfNoRewrite # node should not be transformed anymore nfSem # node has been checked for semantics + nfLL # node has gone through lambda lifting + nfDotField # the call can use a dot operator + nfDotSetter # the call can use a setter dot operarator + nfExplicitCall # x.y() was used instead of x.y + nfExprCall # this is an attempt to call a regular expression + nfIsRef # this node is a 'ref' node; used for the VM + nfIsPtr # this node is a 'ptr' node; used for the VM + nfPreventCg # this node should be ignored by the codegen + nfBlockArg # this a stmtlist appearing in a call (e.g. a do block) + nfFromTemplate # a top-level node returned from a template + nfDefaultParam # an automatically inserter default parameter + nfDefaultRefsParam # a default param value references another parameter + # the flag is applied to proc default values and to calls + nfExecuteOnReload # A top-level statement that will be executed during reloads + nfLastRead # this node is a last read + nfFirstWrite # this node is a first write + nfHasComment # node has a comment + nfSkipFieldChecking # node skips field visable checking + nfDisabledOpenSym # temporary: node should be nkOpenSym but cannot + # because openSym experimental switch is disabled + # gives warning instead TNodeFlags* = set[TNodeFlag] - TTypeFlag* = enum # keep below 32 for efficiency reasons (now: 23) + 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`` + tfThread, # proc type is marked as ``thread``; alias for ``gcsafe`` tfFromGeneric, # type is an instantiation of a generic; this is needed # because for instantiations of objects, structural # type equality has to be used - tfInstantiated, # XXX: used to mark generic params after instantiation. - # if the concrete type happens to be an implicit generic - # this can lead to invalid proc signatures in the second - # pass of semProcTypeNode performed after instantiation. - # this won't be needed if we don't perform this redundant - # second pass (stay tuned). - tfRetType, # marks return types in proc (used to detect type classes + tfUnresolved, # marks unresolved typedesc/static params: e.g. + # proc foo(T: typedesc, list: seq[T]): var T + # proc foo(L: static[int]): array[L, int] + # can be attached to ranges to indicate that the range + # can be attached to generic procs with free standing + # type parameters: e.g. proc foo[T]() + # depends on unresolved static params. + tfResolved # marks a user type class, after it has been bound to a + # concrete type (lastSon becomes the concrete type) + tfRetType, # marks return types in proc (used to detect type classes # used as return types for return type inference) - tfAll, # type class requires all constraints to be met (default) - tfAny, # type class requires any constraint to be met tfCapturesEnv, # whether proc really captures some environment tfByCopy, # pass object/tuple by copy (C backend) tfByRef, # pass object/tuple by reference (C backend) tfIterator, # type is really an iterator, not a tyProc - tfShared, # type is 'shared' + 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 inititalization - tfHasShared, # type constains a "shared" constraint modifier somewhere - tfHasMeta, # type has "typedesc" or "expr" somewhere + tfRequiresInit, # type contains a "not nil" constraint somewhere or + # a `requiresInit` field, so the default zero init + # is not appropriate + tfNeedsFullInit, # object type marked with {.requiresInit.} + # all fields must be initialized + tfVarIsPtr, # 'var' type is translated like 'ptr' even in C++ mode + tfHasMeta, # type contains "wildcard" sub-types such as generic params + # or other type classes tfHasGCedMem, # type contains GC'ed memory + tfPacked + tfHasStatic + tfGenericTypeParam + tfImplicitTypeParam + tfInferrableStatic + tfConceptMatchedTypeSym + tfExplicit # for typedescs, marks types explicitly prefixed with the + # `type` operator (e.g. type int) + tfWildcard # consider a proc like foo[T, I](x: Type[T, I]) + # T and I here can bind to both typedesc and static types + # before this is determined, we'll consider them to be a + # wildcard type. + tfHasAsgn # type has overloaded assignment operator + tfBorrowDot # distinct type borrows '.' + tfTriggersCompileTime # uses the NimNode type which make the proc + # implicitly '.compiletime' + tfRefsAnonObj # used for 'ref object' and 'ptr object' + tfCovariant # covariant generic param mimicking a ptr type + tfWeakCovariant # covariant generic param mimicking a seq/array type + tfContravariant # contravariant generic param + tfCheckedForDestructor # type was checked for having a destructor. + # If it has one, t.destructor is not nil. + tfAcyclic # object type was annotated as .acyclic + tfIncompleteStruct # treat this type as if it had sizeof(pointer) + tfCompleteStruct + # (for importc types); type is fully specified, allowing to compute + # sizeof, alignof, offsetof at CT + tfExplicitCallConv + tfIsConstructor + tfEffectSystemWorkaround + tfIsOutParam + tfSendable + tfImplicitStatic TTypeFlags* = set[TTypeFlag] @@ -397,7 +408,7 @@ type # and first phase symbol lookup in generics skConditional, # symbol for the preprocessor (may become obsolete) skDynLib, # symbol represents a dynamic library; this is used - # internally; it does not exist in Nimrod code + # internally; it does not exist in Nim code skParam, # a parameter skGenericParam, # a generic parameter; eq in ``proc x[eq=`==`]()`` skTemp, # a temporary variable (introduced by compiler) @@ -408,6 +419,7 @@ type skConst, # a constant skResult, # special 'result' variable skProc, # a proc + skFunc, # a func skMethod, # a method skIterator, # an iterator skConverter, # a type converter @@ -421,111 +433,157 @@ type skStub, # symbol is a stub and not yet loaded from the ROD # file (it is loaded on demand, which may # mean: never) + skPackage, # symbol is a package (used for canonicalization) TSymKinds* = set[TSymKind] const - routineKinds* = {skProc, skMethod, skIterator, skConverter, - skMacro, skTemplate} - tfIncompleteStruct* = tfVarargs + routineKinds* = {skProc, skFunc, skMethod, skIterator, + skConverter, skMacro, skTemplate} + ExportableSymKinds* = {skVar, skLet, skConst, skType, skEnumField, skStub} + routineKinds + + tfUnion* = tfNoSideEffect + tfGcSafe* = tfThread + tfObjHasKids* = tfEnumHasHoles + tfReturnsNew* = tfInheritable + tfNonConstExpr* = tfExplicitCallConv + ## tyFromExpr where the expression shouldn't be evaluated as a static value skError* = skUnknown - - # type flags that are essential for type equality: - eqTypeFlags* = {tfIterator, tfShared, tfNotNil} + +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, - mLow, mHigh, mSizeOf, mTypeTrait, mIs, mOf, - 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, mSucc, - mPred, mInc, mDec, mOrd, mNew, mNewFinalize, mNewSeq, mLengthOpenArray, - mLengthStr, mLengthArray, mLengthSeq, mIncl, mExcl, mCard, mChr, mGCref, - mGCunref, mAddI, mSubI, mMulI, mDivI, mModI, mAddI64, mSubI64, mMulI64, - mDivI64, mModI64, + mInc, mDec, mOrd, + mNew, mNewFinalize, mNewSeq, mNewSeqOfCap, + mLengthOpenArray, mLengthStr, mLengthArray, mLengthSeq, + mIncl, mExcl, mCard, mChr, + mGCref, mGCunref, + mAddI, mSubI, mMulI, mDivI, mModI, + mSucc, mPred, mAddF64, mSubF64, mMulF64, mDivF64, - mShrI, mShlI, mBitandI, mBitorI, mBitxorI, mMinI, mMaxI, - mShrI64, mShlI64, mBitandI64, mBitorI64, mBitxorI64, mMinI64, mMaxI64, - mMinF64, mMaxF64, mAddU, mSubU, mMulU, - mDivU, mModU, mEqI, mLeI, - mLtI, - mEqI64, mLeI64, mLtI64, mEqF64, mLeF64, mLtF64, - mLeU, mLtU, mLeU64, mLtU64, - mEqEnum, mLeEnum, mLtEnum, mEqCh, mLeCh, mLtCh, mEqB, mLeB, mLtB, mEqRef, - mEqUntracedRef, mLePtr, mLtPtr, mEqCString, mXor, mEqProc, mUnaryMinusI, - mUnaryMinusI64, mAbsI, mAbsI64, mNot, - mUnaryPlusI, mBitnotI, mUnaryPlusI64, - mBitnotI64, mUnaryPlusF64, mUnaryMinusF64, mAbsF64, mZe8ToI, mZe8ToI64, - mZe16ToI, mZe16ToI64, mZe32ToI64, mZeIToI64, mToU8, mToU16, mToU32, - mToFloat, mToBiggestFloat, mToInt, mToBiggestInt, mCharToStr, mBoolToStr, - mIntToStr, mInt64ToStr, mFloatToStr, mCStrToStr, mStrToStr, mEnumToStr, - mAnd, mOr, mEqStr, mLeStr, mLtStr, mEqSet, mLeSet, mLtSet, mMulSet, - mPlusSet, mMinusSet, mSymDiffSet, mConStrStr, mConArrArr, mConArrT, - mConTArr, mConTT, mSlice, + mShrI, mShlI, mAshrI, mBitandI, mBitorI, mBitxorI, + mMinI, mMaxI, + mAddU, mSubU, mMulU, mDivU, mModU, + mEqI, mLeI, mLtI, + mEqF64, mLeF64, mLtF64, + mLeU, mLtU, + mEqEnum, mLeEnum, mLtEnum, + mEqCh, mLeCh, mLtCh, + mEqB, mLeB, mLtB, + mEqRef, mLePtr, mLtPtr, + mXor, mEqCString, mEqProc, + mUnaryMinusI, mUnaryMinusI64, mAbsI, mNot, + mUnaryPlusI, mBitnotI, + mUnaryPlusF64, mUnaryMinusF64, + mCharToStr, mBoolToStr, + mCStrToStr, + mStrToStr, mEnumToStr, + mAnd, mOr, + mImplies, mIff, mExists, mForall, mOld, + mEqStr, mLeStr, mLtStr, + mEqSet, mLeSet, mLtSet, mMulSet, mPlusSet, mMinusSet, + mConStrStr, mSlice, + mDotDot, # this one is only necessary to give nice compile time warnings mFields, mFieldPairs, mOmpParFor, mAppendStrCh, mAppendStrStr, mAppendSeqElem, - mInRange, mInSet, mRepr, mExit, mSetLengthStr, mSetLengthSeq, - mIsPartOf, mAstToStr, mRand, - mSwap, mIsNil, mArrToSeq, mCopyStr, mCopyStrLast, - mNewString, mNewStringOfCap, - mReset, + mInSet, mRepr, mExit, + mSetLengthStr, mSetLengthSeq, + mIsPartOf, mAstToStr, mParallel, + mSwap, mIsNil, mArrToSeq, mOpenArrayToSeq, + mNewString, mNewStringOfCap, mParseBiggestFloat, + mMove, mEnsureMove, mWasMoved, mDup, mDestroy, mTrace, + mDefault, mUnown, mFinished, mIsolate, mAccessEnv, mAccessTypeField, mArray, mOpenArray, mRange, mSet, mSeq, mVarargs, - mOrdinal, + mRef, mPtr, mVar, mDistinct, mVoid, mTuple, + mOrdinal, mIterableType, mInt, mInt8, mInt16, mInt32, mInt64, mUInt, mUInt8, mUInt16, mUInt32, mUInt64, mFloat, mFloat32, mFloat64, mFloat128, mBool, mChar, mString, mCstring, - mPointer, mEmptySet, mIntSetBaseType, mNil, mExpr, mStmt, mTypeDesc, - mVoidType, mPNimrodNode, - mIsMainModule, mCompileDate, mCompileTime, mNimrodVersion, mNimrodMajor, - mNimrodMinor, mNimrodPatch, mCpuEndian, mHostOS, mHostCPU, mAppType, - mNaN, mInf, mNegInf, + mPointer, mNil, mExpr, mStmt, mTypeDesc, + mVoidType, mPNimrodNode, mSpawn, mDeepCopy, + mIsMainModule, mCompileDate, mCompileTime, mProcCall, + mCpuEndian, mHostOS, mHostCPU, mBuildOS, mBuildCPU, mAppType, mCompileOption, mCompileOptionArg, - mNLen, mNChild, mNSetChild, mNAdd, mNAddMultiple, mNDel, mNKind, + mNLen, mNChild, mNSetChild, mNAdd, mNAddMultiple, mNDel, + mNKind, mNSymKind, + + mNccValue, mNccInc, mNcsAdd, mNcsIncl, mNcsLen, mNcsAt, + mNctPut, mNctLen, mNctGet, mNctHasNext, mNctNext, + mNIntVal, mNFloatVal, mNSymbol, mNIdent, mNGetType, mNStrVal, mNSetIntVal, - mNSetFloatVal, mNSetSymbol, mNSetIdent, mNSetType, mNSetStrVal, mNLineInfo, - mNNewNimNode, mNCopyNimNode, mNCopyNimTree, mStrToIdent, mIdentToStr, - mNBindSym, mLocals, mNCallSite, - mEqIdent, mEqNimrodNode, mNHint, mNWarning, mNError, - mInstantiationInfo, mGetTypeInfo + mNSetFloatVal, mNSetSymbol, mNSetIdent, mNSetStrVal, mNLineInfo, + mNNewNimNode, mNCopyNimNode, mNCopyNimTree, mStrToIdent, mNSigHash, mNSizeOf, + mNBindSym, mNCallSite, + mEqIdent, mEqNimrodNode, mSameNodeType, mGetImpl, mNGenSym, + mNHint, mNWarning, mNError, + mInstantiationInfo, mGetTypeInfo, mGetTypeInfoV2, + mNimvm, mIntDefine, mStrDefine, mBoolDefine, mGenericDefine, mRunnableExamples, + mException, mBuiltinType, mSymOwner, mUncheckedArray, mGetImplTransf, + mSymIsInstantiationOf, mNodeId, mPrivateAccess, mZeroDefault + -# things that we can evaluate safely at compile time, even if not asked for it: const - ctfeWhitelist* = {mNone, mUnaryLt, mSucc, - mPred, mInc, mDec, mOrd, mLengthOpenArray, - mLengthStr, mLengthArray, mLengthSeq, mIncl, mExcl, mCard, mChr, - mAddI, mSubI, mMulI, mDivI, mModI, mAddI64, mSubI64, mMulI64, - mDivI64, mModI64, mAddF64, mSubF64, mMulF64, mDivF64, - mShrI, mShlI, mBitandI, mBitorI, mBitxorI, mMinI, mMaxI, - mShrI64, mShlI64, mBitandI64, mBitorI64, mBitxorI64, mMinI64, mMaxI64, - mMinF64, mMaxF64, mAddU, mSubU, mMulU, - mDivU, mModU, mEqI, mLeI, - mLtI, - mEqI64, mLeI64, mLtI64, mEqF64, mLeF64, mLtF64, - mLeU, mLtU, mLeU64, mLtU64, - mEqEnum, mLeEnum, mLtEnum, mEqCh, mLeCh, mLtCh, mEqB, mLeB, mLtB, mEqRef, - mEqProc, mEqUntracedRef, mLePtr, mLtPtr, mEqCString, mXor, mUnaryMinusI, - mUnaryMinusI64, mAbsI, mAbsI64, mNot, - mUnaryPlusI, mBitnotI, mUnaryPlusI64, - mBitnotI64, mUnaryPlusF64, mUnaryMinusF64, mAbsF64, mZe8ToI, mZe8ToI64, - mZe16ToI, mZe16ToI64, mZe32ToI64, mZeIToI64, mToU8, mToU16, mToU32, - mToFloat, mToBiggestFloat, mToInt, mToBiggestInt, mCharToStr, mBoolToStr, - mIntToStr, mInt64ToStr, mFloatToStr, mCStrToStr, mStrToStr, mEnumToStr, - mAnd, mOr, mEqStr, mLeStr, mLtStr, mEqSet, mLeSet, mLtSet, mMulSet, - mPlusSet, mMinusSet, mSymDiffSet, mConStrStr, mConArrArr, mConArrT, - mConTArr, mConTT, mSlice, - mAppendStrCh, mAppendStrStr, mAppendSeqElem, - mInRange, mInSet, mRepr, - mRand, - 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, - mEcho, mShallowCopy, mExpandToAst} - -type + # things that we can evaluate safely at compile time, even if not asked for it: + ctfeWhitelist* = {mNone, mSucc, + mPred, mInc, mDec, mOrd, mLengthOpenArray, + mLengthStr, mLengthArray, mLengthSeq, + mArrGet, mArrPut, mAsgn, mDestroy, + mIncl, mExcl, mCard, mChr, + mAddI, mSubI, mMulI, mDivI, mModI, + mAddF64, mSubF64, mMulF64, mDivF64, + mShrI, mShlI, mBitandI, mBitorI, mBitxorI, + mMinI, mMaxI, + mAddU, mSubU, mMulU, mDivU, mModU, + mEqI, mLeI, mLtI, + mEqF64, mLeF64, mLtF64, + mLeU, mLtU, + mEqEnum, mLeEnum, mLtEnum, + mEqCh, mLeCh, mLtCh, + mEqB, mLeB, mLtB, + mEqRef, mEqProc, mLePtr, mLtPtr, mEqCString, mXor, + mUnaryMinusI, mUnaryMinusI64, mAbsI, mNot, mUnaryPlusI, mBitnotI, + mUnaryPlusF64, mUnaryMinusF64, + mCharToStr, mBoolToStr, + mCStrToStr, + mStrToStr, mEnumToStr, + mAnd, mOr, + mEqStr, mLeStr, mLtStr, + mEqSet, mLeSet, mLtSet, mMulSet, mPlusSet, mMinusSet, + mConStrStr, mAppendStrCh, mAppendStrStr, mAppendSeqElem, + mInSet, mRepr, mOpenArrayToSeq} + + generatedMagics* = {mNone, mIsolate, mFinished, mOpenArrayToSeq} + ## magics that are generated as normal procs in the backend + +type + ItemId* = object + module*: int32 + item*: int32 + +proc `$`*(x: ItemId): string = + "(module: " & $x.module & ", item: " & $x.item & ")" + +proc `==`*(a, b: ItemId): bool {.inline.} = + a.item == b.item and a.module == b.module + +proc hash*(x: ItemId): Hash = + var h: Hash = hash(x.module) + h = h !& hash(x.item) + result = !$h + + +type PNode* = ref TNode TNodeSeq* = seq[PNode] PType* = ref TType @@ -534,118 +592,120 @@ type when defined(useNodeIds): id*: int typ*: PType - comment*: string info*: TLineInfo flags*: TNodeFlags - case Kind*: TNodeKind + case kind*: TNodeKind of nkCharLit..nkUInt64Lit: - intVal*: biggestInt + intVal*: BiggestInt of nkFloatLit..nkFloat128Lit: - floatVal*: biggestFloat + floatVal*: BiggestFloat of nkStrLit..nkTripleStrLit: strVal*: string - of nkSym: + of nkSym: sym*: PSym - of nkIdent: + of nkIdent: ident*: PIdent - else: + else: sons*: TNodeSeq - - TSymSeq* = seq[PSym] + when defined(nimsuggest): + endInfo*: TLineInfo + TStrTable* = object # a table[PIdent] of PSym counter*: int - data*: TSymSeq - + data*: seq[PSym] + # -------------- backend information ------------------------------- - TLocKind* = enum + TLocKind* = enum locNone, # no location locTemp, # temporary location locLocalVar, # location is a local variable locGlobalVar, # location is a global variable locParam, # location is a parameter locField, # location is a record field - locArrayElem, # location is an array element locExpr, # "location" is really an expression locProc, # location is a proc (an address of a procedure) locData, # location is a constant locCall, # location is a call expression locOther # location is something other - TLocFlag* = enum + TLocFlag* = enum lfIndirect, # backend introduced a pointer - lfParamCopy, # backend introduced a parameter copy (LLVM) lfNoDeepCopy, # no need for a deep copy lfNoDecl, # do not declare it in C lfDynamicLib, # link symbol to dynamic library lfExportLib, # export symbol for dynamic library generation lfHeader, # include header file for symbol - lfImportCompilerProc # ``importc`` of a compilerproc - TStorageLoc* = enum + lfImportCompilerProc, # ``importc`` of a compilerproc + lfSingleUse # no location yet and will only be used once + lfEnforceDeref # a copyMem is required to dereference if this a + # ptr array due to C array limitations. + # See #1181, #6422, #11171 + lfPrepareForMutation # string location is about to be mutated (V2) + TStorageLoc* = enum OnUnknown, # location is unknown (stack, heap or static) + OnStatic, # in a static section OnStack, # location is on hardware stack OnHeap # location is on heap or global # (reference counting needed) TLocFlags* = set[TLocFlag] - TLoc*{.final.} = object + TLoc* = object k*: TLocKind # kind of location - s*: TStorageLoc + storage*: TStorageLoc flags*: TLocFlags # location's flags - t*: PType # type of location - r*: PRope # rope value of location (code generators) - heapRoot*: PRope # keeps track of the enclosing heap object that - # owns this location (required by GC algorithms - # employing heap snapshots or sliding views) - a*: int # location's "address", i.e. slot for temporaries + lode*: PNode # Node where the location came from; can be faked + snippet*: Rope # C code snippet of location (code generators) # ---------------- end of backend information ------------------------------ - TLibKind* = enum + TLibKind* = enum libHeader, libDynamic - TLib* = object of lists.TListEntry # also misused for headers! + + TLib* = object # also misused for headers! + # keep in sync with PackedLib kind*: TLibKind generated*: bool # needed for the backends: - isOverriden*: bool - name*: PRope + isOverridden*: bool + name*: Rope path*: PNode # can be a string literal! - + + + CompilesId* = int ## id that is used for the caching logic within + ## ``system.compiles``. See the seminst module. TInstantiation* = object sym*: PSym concreteTypes*: seq[PType] - usedBy*: seq[int32] # list of modules using the generic - # needed in caas mode for purging the cache - # XXX: it's possible to switch to a - # simple ref count here - + compilesId*: CompilesId + 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: - typeInstCache*: seq[PType] of routineKinds: - procInstCache*: seq[PInstantiation] - scope*: PScope # the scope where the proc was defined - of skModule: - # 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. - 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.: @@ -660,185 +720,261 @@ 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 - - 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] - 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 # else: unused - destructor*: PSym # destructor. warning: nil here may not necessary - # mean that there is no destructor. - # see instantiateDestructor in types.nim owner*: PSym # the 'owner' of the type sym*: PSym # types have the sym associated with them # it is used for converting types to strings size*: BiggestInt # the size of the type in bytes # -1 means that the size is unkwown - align*: int # the type's alignment requirements + align*: int16 # the type's alignment requirements + paddingAtEnd*: int16 # loc*: TLoc + typeInst*: PType # for generic instantiations the tyGenericInst that led to this + # type. + uniqueId*: ItemId # due to a design mistake, we need to keep the real ID here as it + # is required by the --incremental:on mode. - TPair*{.final.} = object - key*, val*: PObject + TPair* = object + key*, val*: RootRef TPairSeq* = seq[TPair] - TTable*{.final.} = object # the same as table[PObject] of PObject - counter*: int - data*: TPairSeq - - TIdPair*{.final.} = object - key*: PIdObj - val*: PObject - - TIdPairSeq* = seq[TIdPair] - TIdTable*{.final.} = object # the same as table[PIdent] of PObject - counter*: int - data*: TIdPairSeq - - TIdNodePair*{.final.} = object - key*: PIdObj - val*: PNode - TIdNodePairSeq* = seq[TIdNodePair] - TIdNodeTable*{.final.} = object # the same as table[PIdObj] of PNode - counter*: int - data*: TIdNodePairSeq - - TNodePair*{.final.} = object - h*: THash # because it is expensive to compute! + TNodePair* = object + h*: Hash # because it is expensive to compute! key*: PNode val*: int TNodePairSeq* = seq[TNodePair] - TNodeTable*{.final.} = object # the same as table[PNode] of int; + TNodeTable* = object # the same as table[PNode] of int; # nodes are compared by structure! counter*: int data*: TNodePairSeq - TObjectSeq* = seq[PObject] - TObjectSet*{.final.} = object + TObjectSeq* = seq[RootRef] + TObjectSet* = object counter*: int data*: TObjectSeq + 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, skMethod, skIterator, skConverter, - skModule, skTemplate, skMacro} +const + OverloadableSyms* = {skProc, skFunc, skMethod, skIterator, + skConverter, skModule, skTemplate, skMacro, skEnumField} - GenericTypes*: TTypeKinds = {tyGenericInvokation, tyGenericBody, + GenericTypes*: TTypeKinds = {tyGenericInvocation, tyGenericBody, tyGenericParam} - StructuralEquivTypes*: TTypeKinds = {tyArrayConstr, tyNil, tyTuple, tyArray, - tySet, tyRange, tyPtr, tyRef, tyVar, tySequence, tyProc, tyOpenArray, + + StructuralEquivTypes*: TTypeKinds = {tyNil, tyTuple, tyArray, + tySet, tyRange, tyPtr, tyRef, tyVar, tyLent, tySequence, tyProc, tyOpenArray, tyVarargs} + ConcreteTypes*: TTypeKinds = { # types of the expr that may occur in:: # var x = expr - tyBool, tyChar, tyEnum, tyArray, tyObject, - tySet, tyTuple, tyRange, tyPtr, tyRef, tyVar, tySequence, tyProc, - tyPointer, - tyOpenArray, tyString, tyCString, tyInt..tyInt64, tyFloat..tyFloat128, + tyBool, tyChar, tyEnum, tyArray, tyObject, + tySet, tyTuple, tyRange, tyPtr, tyRef, tyVar, tyLent, tySequence, tyProc, + tyPointer, + tyOpenArray, tyString, tyCstring, tyInt..tyInt64, tyFloat..tyFloat128, tyUInt..tyUInt64} IntegralTypes* = {tyBool, tyChar, tyEnum, tyInt..tyInt64, - tyFloat..tyFloat128, tyUInt..tyUInt64} - ConstantDataTypes*: TTypeKinds = {tyArrayConstr, tyArray, tySet, + 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, skMethod, skType, skIterator, - skMacro, skTemplate, skConverter, skEnumField, skLet, skStub} - PersistentNodeFlags*: TNodeFlags = {nfBase2, nfBase8, nfBase16, nfAllConst} + NilableTypes*: TTypeKinds = {tyPointer, tyCstring, tyRef, tyPtr, + tyProc, tyError} # TODO + PtrLikeKinds*: TTypeKinds = {tyPointer, tyPtr} # for VM + PersistentNodeFlags*: TNodeFlags = {nfBase2, nfBase8, nfBase16, + nfDotSetter, nfDotField, + nfIsRef, nfIsPtr, nfPreventCg, nfLL, + nfFromTemplate, nfDefaultRefsParam, + nfExecuteOnReload, nfLastRead, + nfFirstWrite, nfSkipFieldChecking, + nfDisabledOpenSym} namePos* = 0 patternPos* = 1 # empty except for term rewriting macros genericParamsPos* = 2 paramsPos* = 3 pragmasPos* = 4 - exceptionPos* = 5 # will be used for exception tracking + 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 5! + dispatcherPos* = 8 - nkCallKinds* = {nkCall, nkInfix, nkPrefix, nkPostfix, - nkCommand, nkCallStrLit, nkHiddenCallConv} + nfAllFieldsSet* = nfBase2 + nkIdentKinds* = {nkIdent, nkSym, nkAccQuoted, nkOpenSymChoice, + nkClosedSymChoice, nkOpenSym} + + nkPragmaCallKinds* = {nkExprColonExpr, nkCall, nkCallStrLit} + nkLiterals* = {nkCharLit..nkTripleStrLit} + nkFloatLiterals* = {nkFloatLit..nkFloat128Lit} nkLambdaKinds* = {nkLambda, nkDo} - declarativeDefs* = {nkProcDef, nkMethodDef, nkIteratorDef, nkConverterDef} + declarativeDefs* = {nkProcDef, nkFuncDef, nkMethodDef, nkIteratorDef, nkConverterDef} + routineDefs* = declarativeDefs + {nkMacroDef, nkTemplateDef} procDefs* = nkLambdaKinds + declarativeDefs + callableDefs* = nkLambdaKinds + routineDefs nkSymChoices* = {nkClosedSymChoice, nkOpenSymChoice} nkStrKinds* = {nkStrLit..nkTripleStrLit} skLocalVars* = {skVar, skLet, skForVar, skParam, skResult} + skProcKinds* = {skProc, skFunc, skTemplate, skMacro, skIterator, + skMethod, skConverter} + defaultSize = -1 + defaultAlignment = -1 + defaultOffset* = -1 -# creator procs: -proc NewSym*(symKind: TSymKind, Name: PIdent, owner: PSym, - info: TLineInfo): PSym -proc NewType*(kind: TTypeKind, owner: PSym): PType -proc newNode*(kind: TNodeKind): PNode -proc newIntNode*(kind: TNodeKind, intVal: BiggestInt): PNode -proc newIntTypeNode*(kind: TNodeKind, intVal: BiggestInt, typ: PType): PNode -proc newFloatNode*(kind: TNodeKind, floatVal: BiggestFloat): PNode -proc newStrNode*(kind: TNodeKind, strVal: string): PNode -proc newIdentNode*(ident: PIdent, info: TLineInfo): PNode -proc newSymNode*(sym: PSym): PNode -proc newNodeI*(kind: TNodeKind, info: TLineInfo): PNode -proc newNodeIT*(kind: TNodeKind, info: TLineInfo, typ: PType): PNode -proc initStrTable*(x: var TStrTable) -proc initTable*(x: var TTable) -proc initIdTable*(x: var TIdTable) -proc initObjectSet*(x: var TObjectSet) -proc initIdNodeTable*(x: var TIdNodeTable) -proc initNodeTable*(x: var TNodeTable) - -# copy procs: -proc copyType*(t: PType, owner: PSym, keepId: bool): PType -proc copySym*(s: PSym, keepId: bool = false): PSym -proc assignType*(dest, src: PType) -proc copyStrTable*(dest: var TStrTable, src: TStrTable) -proc copyTable*(dest: var TTable, src: TTable) -proc copyObjectSet*(dest: var TObjectSet, src: TObjectSet) -proc copyIdTable*(dest: var TIdTable, src: TIdTable) -proc sonsLen*(n: PNode): int {.inline.} -proc sonsLen*(n: PType): int {.inline.} -proc lastSon*(n: PNode): PNode {.inline.} -proc lastSon*(n: PType): PType {.inline.} -proc newSons*(father: PNode, length: int) -proc newSons*(father: PType, length: int) -proc addSon*(father, son: PNode) -proc delSon*(father: PNode, idx: int) -proc hasSonWith*(n: PNode, kind: TNodeKind): bool -proc hasSubnodeWith*(n: PNode, kind: TNodeKind): bool -proc replaceSons*(n: PNode, oldKind, newKind: TNodeKind) -proc copyNode*(src: PNode): PNode - # does not copy its sons! -proc copyTree*(src: PNode): PNode - # does copy its sons! +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 proc isCallExpr*(n: PNode): bool = result = n.kind in nkCallKinds @@ -846,29 +982,244 @@ 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 = n.strVal.len + elif n.kind in {nkNone..nkFloat128Lit}: result = 0 + else: result = n.len + proc add*(father, son: PNode) = assert son != nil - if isNil(father.sons): father.sons = @[] - add(father.sons, son) - -proc `[]`*(n: PNode, i: int): PNode {.inline.} = - result = n.sons[i] - -# son access operators with support for negative indices -template `{}`*(n: PNode, i: int): expr = n[i -| n] -template `{}=`*(n: PNode, i: int, s: PNode): stmt = - n.sons[i -| n] = s - -var emptyNode* = newNode(nkEmpty) -# There is a single empty node that is shared! Do not overwrite it! + 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) + +proc addAllowNil*(father, son: PType) {.inline.} = + father.sons.add(son) + +template `[]`*(n: PType, i: int): PType = n.sons[i] +template `[]=`*(n: PType, i: int; x: PType) = n.sons[i] = x + +template `[]`*(n: PType, i: BackwardsIndex): PType = n[n.len - i.int] +template `[]=`*(n: PType, i: BackwardsIndex; x: PType) = n[n.len - i.int] = x + +proc getDeclPragma*(n: PNode): PNode = + ## return the `nkPragma` node for declaration `n`, or `nil` if no pragma was found. + ## Currently only supports routineDefs + {nkTypeDef}. + case n.kind + of routineDefs: + if n[pragmasPos].kind != nkEmpty: result = n[pragmasPos] + else: result = nil + of nkTypeDef: + #[ + type F3*{.deprecated: "x3".} = int + + TypeSection + TypeDef + PragmaExpr + Postfix + Ident "*" + Ident "F3" + Pragma + ExprColonExpr + Ident "deprecated" + StrLit "x3" + Empty + Ident "int" + ]# + if n[0].kind == nkPragmaExpr: + result = n[0][1] + else: + result = nil + else: + # support as needed for `nkIdentDefs` etc. + result = nil + if result != nil: + assert result.kind == nkPragma, $(result.kind, n.kind) + +proc extractPragma*(s: PSym): PNode = + ## gets the pragma node of routine/type/var/let/const symbol `s` + if s.kind in routineKinds: # bug #24167 + if s.ast[pragmasPos] != nil and s.ast[pragmasPos].kind != nkEmpty: + result = s.ast[pragmasPos] + else: + result = nil + elif s.kind in {skType, skVar, skLet, skConst}: + if s.ast != nil and s.ast.len > 0: + if s.ast[0].kind == nkPragmaExpr and s.ast[0].len > 1: + # s.ast = nkTypedef / nkPragmaExpr / [nkSym, nkPragma] + result = s.ast[0][1] + else: + result = nil + else: + result = nil + else: + result = nil + assert result == nil or result.kind == nkPragma + +proc skipPragmaExpr*(n: PNode): PNode = + ## if pragma expr, give the node the pragmas are applied to, + ## otherwise give node itself + if n.kind == nkPragmaExpr: + result = n[0] + else: + result = n + +proc setInfoRecursive*(n: PNode, info: TLineInfo) = + ## set line info recursively + if n != nil: + for i in 0..<n.safeLen: setInfoRecursive(n[i], info) + n.info = info + +when defined(useNodeIds): + const nodeIdToDebug* = -1 # 2322968 + var gNodeId: int + +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: + echo "KIND ", result.kind + 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.last else: nil + +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 + 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 + (t.kind == tyStatic and t.n == nil) or + tfHasMeta in t.flags + +proc isUnresolvedStatic*(t: PType): bool = + return t.kind == tyStatic and t.n == nil proc linkTo*(t: PType, s: PSym): PType {.discardable.} = t.sym = s @@ -880,13 +1231,13 @@ proc linkTo*(s: PSym, t: PType): PSym {.discardable.} = s.typ = t result = s -template fileIdx*(c: PSym): int32 = +template fileIdx*(c: PSym): FileIndex = # XXX: this should be used only on module symbols - c.position.int32 + c.position.FileIndex template filename*(c: PSym): string = # XXX: this should be used only on module symbols - c.position.int32.toFileName + c.position.FileIndex.toFilename proc appendToModule*(m: PSym, n: PNode) = ## The compiler will use this internally to add nodes that will be @@ -897,484 +1248,888 @@ proc appendToModule*(m: PSym, n: PNode) = else: assert m.ast.kind == nkStmtList m.ast.sons.add(n) - + const # for all kind of hash tables: GrowthFactor* = 2 # must be power of 2, > 0 StartSize* = 8 # must be power of 2, > 0 -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) = +proc copyStrTable*(dest: var TStrTable, src: TStrTable) = 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] - -proc copyTable(dest: var TTable, src: TTable) = - 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 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] - -proc discardSons(father: PNode) = - father.sons = nil - -when defined(useNodeIds): - const nodeIdToDebug = 612777 # 612794 - #612840 # 612905 # 614635 # 614637 # 614641 - # 423408 - #429107 # 430443 # 441048 # 441090 # 441153 - var gNodeId: int - -proc newNode(kind: TNodeKind): PNode = - new(result) - result.kind = kind - #result.info = UnknownLineInfo() inlined: - result.info.fileIndex = int32(- 1) - result.info.col = int16(- 1) - result.info.line = int16(- 1) - when defined(useNodeIds): - result.id = gNodeId - if result.id == nodeIdToDebug: - echo "KIND ", result.kind - writeStackTrace() - inc gNodeId - -proc newIntNode(kind: TNodeKind, intVal: BiggestInt): PNode = - result = newNode(kind) - result.intVal = intVal + setLen(dest.data, src.data.len) + for i in 0..high(src.data): dest.data[i] = src.data[i] -proc newIntTypeNode(kind: TNodeKind, intVal: BiggestInt, typ: PType): PNode = - result = newIntNode(kind, intVal) - result.typ = typ +proc copyObjectSet*(dest: var TObjectSet, src: TObjectSet) = + dest.counter = src.counter + setLen(dest.data, src.data.len) + for i in 0..high(src.data): dest.data[i] = src.data[i] -proc newFloatNode(kind: TNodeKind, floatVal: BiggestFloat): PNode = - result = newNode(kind) - result.floatVal = floatVal +proc discardSons*(father: PNode) = + father.sons = @[] -proc newStrNode(kind: TNodeKind, strVal: string): PNode = - result = newNode(kind) - result.strVal = strVal +proc withInfo*(n: PNode, info: TLineInfo): PNode = + n.info = info + return n -proc newIdentNode(ident: PIdent, info: TLineInfo): PNode = +proc newIdentNode*(ident: PIdent, info: TLineInfo): PNode = result = newNode(nkIdent) result.ident = ident result.info = info -proc newSymNode(sym: PSym): PNode = +proc newSymNode*(sym: PSym): PNode = result = newNode(nkSym) result.sym = sym result.typ = sym.typ result.info = sym.info -proc newSymNode*(sym: PSym, info: TLineInfo): PNode = +proc newSymNode*(sym: PSym, info: TLineInfo): PNode = result = newNode(nkSym) result.sym = sym 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 newOpenSym*(n: PNode): PNode {.inline.} = + result = newTreeI(nkOpenSym, n.info, n) -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 newIntNode*(kind: TNodeKind, intVal: BiggestInt): PNode = + result = newNode(kind) + result.intVal = intVal -proc newNode*(kind: TNodeKind, info: TLineInfo, sons: TNodeSeq = @[], - typ: PType = nil): PNode = - new(result) - result.kind = kind - result.info = info +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 - # 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 = +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.info = info - result.typ = typ + result.floatVal = floatVal -proc newMetaNodeIT*(tree: PNode, info: TLineInfo, typ: PType): PNode = - result = newNodeIT(nkMetaNode, info, typ) - result.add(tree) +proc newStrNode*(kind: TNodeKind, strVal: string): PNode = + result = newNode(kind) + result.strVal = strVal -var emptyParams = newNode(nkFormalParams) -emptyParams.addSon(emptyNode) +proc newStrNode*(strVal: string; info: TLineInfo): PNode = + result = newNodeI(nkStrLit, info) + result.strVal = strVal proc newProcNode*(kind: TNodeKind, info: TLineInfo, body: PNode, - params = emptyParams, + params, name, pattern, genericParams, - pragmas, exceptions = ast.emptyNode): PNode = + pragmas, exceptions: PNode): PNode = result = newNodeI(kind, info) result.sons = @[name, pattern, genericParams, params, pragmas, exceptions, body] +const + 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.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 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() - when debugIds: - RegisterId(result) - #if result.id < 2000 then - # MessageOut(typeKindToStr[kind] & ' has id: ' & toString(result.id)) - proc mergeLoc(a: var TLoc, b: TLoc) = - if a.k == low(a.k): a.k = b.k - if a.s == low(a.s): a.s = b.s - a.flags = a.flags + b.flags - if a.t == nil: a.t = b.t - if a.r == nil: a.r = b.r - if a.a == 0: a.a = b.a - -proc assignType(dest, src: PType) = + 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.snippet == "": a.snippet = b.snippet + +proc newSons*(father: PNode, length: int) = + setLen(father.sons, length) + +proc newSons*(father: PType, length: int) = + setLen(father.sons, length) + +proc truncateInferredTypeCandidates*(t: PType) {.inline.} = + assert t.kind == tyInferred + if t.sons.len > 1: + setLen(t.sons, 1) + +proc assignType*(dest, src: PType) = dest.kind = src.kind dest.flags = src.flags dest.callConv = src.callConv dest.n = src.n dest.size = src.size dest.align = src.align - dest.destructor = src.destructor # this fixes 'type TLock = TSysLock': if src.sym != nil: if dest.sym != nil: - dest.sym.flags = dest.sym.flags + src.sym.flags + 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] - -proc copyType(t: PType, owner: PSym, keepId: bool): PType = - result = newType(t.Kind, owner) + newSons(dest, src.sons.len) + for i in 0..<src.sons.len: dest[i] = src[i] + +proc copyType*(t: PType, idgen: IdGenerator, owner: PSym): PType = + result = newType(t.kind, idgen, owner) + assignType(result, t) + result.sym = t.sym # backend-info should not be copied + +proc exactReplica*(t: PType): PType = + result = PType(kind: t.kind, owner: t.owner, size: defaultSize, + align: defaultAlignment, itemId: t.itemId, + uniqueId: t.uniqueId) assignType(result, t) - if keepId: - result.id = t.id - else: - result.id = getID() - when debugIds: RegisterId(result) 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) - result.ast = nil # BUGFIX; was: s.ast which made problems + +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 - -proc NewSym(symKind: TSymKind, Name: PIdent, owner: PSym, - info: TLineInfo): 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 = gOptions - result.owner = owner - result.offset = - 1 - result.id = getID() - when debugIds: - RegisterId(result) - #if result.id < 2000: - # MessageOut(name.s & " has id: " & toString(result.id)) - -proc initStrTable(x: var TStrTable) = - x.counter = 0 - newSeq(x.data, startSize) - -proc newStrTable*: TStrTable = - initStrTable(result) - -proc initTable(x: var TTable) = - x.counter = 0 - newSeq(x.data, startSize) - -proc initIdTable(x: var TIdTable) = - x.counter = 0 - newSeq(x.data, startSize) - -proc initObjectSet(x: var TObjectSet) = - x.counter = 0 - newSeq(x.data, startSize) - -proc initIdNodeTable(x: var TIdNodeTable) = - x.counter = 0 - newSeq(x.data, startSize) - -proc initNodeTable(x: var TNodeTable) = - x.counter = 0 - newSeq(x.data, startSize) - -proc sonsLen(n: PType): int = - if isNil(n.sons): result = 0 - else: result = len(n.sons) - -proc len*(n: PType): int = - if isNil(n.sons): result = 0 - else: result = len(n.sons) - -proc newSons(father: PType, length: int) = - if isNil(father.sons): - newSeq(father.sons, length) - else: - setlen(father.sons, length) - -proc sonsLen(n: PNode): int = - if isNil(n.sons): result = 0 - else: result = len(n.sons) - -proc newSons(father: PNode, length: int) = - if isNil(father.sons): - newSeq(father.sons, length) - else: - setlen(father.sons, length) + 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, idgen: IdGenerator, newIdent: PIdent, info: TLineInfo; + options: TOptions): PSym = + result = newSym(s.kind, newIdent, idgen, s.owner, info, options) + # keep ID! + result.ast = s.ast + #result.id = s.id # XXX figure out what to do with the ID. + result.flags = s.flags + result.options = s.options + result.position = s.position + result.loc = s.loc + result.annex = s.annex + +proc initStrTable*(): TStrTable = + result = TStrTable(counter: 0) + newSeq(result.data, StartSize) + +proc initObjectSet*(): TObjectSet = + result = TObjectSet(counter: 0) + newSeq(result.data, StartSize) -proc propagateToOwner*(owner, elem: PType) = - const HaveTheirOwnEmpty = {tySequence, tySet} - owner.flags = owner.flags + (elem.flags * {tfHasShared, tfHasMeta, - tfHasGCedMem}) +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 = last(result) + dec i + if i == 0: return nil + +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.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; propagateHasAsgn = true) = + owner.flags.incl elem.flags * {tfHasMeta, tfTriggersCompileTime} if tfNotNil in elem.flags: - if owner.kind in {tyGenericInst, tyGenericBody, tyGenericInvokation}: + 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: nil - else: owner.flags.incl tfNeedsInit - - if tfShared in elem.flags: - owner.flags.incl tfHasShared - - if elem.kind in {tyExpr, tyTypeDesc}: - owner.flags.incl tfHasMeta - elif elem.kind in {tyString, tyRef, tySequence} or - elem.kind == tyProc and elem.callConv == ccClosure: - 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) + if elem.isMetaType: + owner.flags.incl tfHasMeta -proc addSon(father, son: PNode) = - assert son != nil - if isNil(father.sons): father.sons = @[] - add(father.sons, son) + 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, tySet, tyDistinct}: + o2.flags.incl mask + owner.flags.incl mask + + if owner.kind notin {tyProc, tyGenericInst, tyGenericBody, + tyGenericInvocation, tyPtr}: + let elemB = elem.skipTypes({tyGenericInst, tyAlias, tySink}) + if elemB.isGCedMem or tfHasGCedMem in elemB.flags: + # for simplicity, we propagate this flag even to generics. We then + # ensure this doesn't bite us in sempass2. + owner.flags.incl tfHasGCedMem + +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) +proc delSon*(father: PNode, idx: int) = + 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 = +proc copyNode*(src: PNode): PNode = # does not copy its sons! - if src == nil: + 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 + case src.kind of nkCharLit..nkUInt64Lit: result.intVal = src.intVal - of nkFloatLit..nkFloat128Lit: result.floatVal = src.floatVal + 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: nil - -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 + else: discard + when defined(nimsuggest): + result.endInfo = src.endInfo + +template transitionNodeKindCommon(k: TNodeKind) = + let obj {.inject.} = n[] + n[] = TNode(kind: k, typ: obj.typ, info: obj.info, flags: obj.flags) + # 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 nkFloatLit..nkFloat128Lit: 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)) + case src.kind + 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 = +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 - when defined(useNodeIds): - if result.id == nodeIdToDebug: - echo "COMES FROM ", src.id - case src.Kind - of nkCharLit..nkUInt64Lit: result.intVal = src.intVal - of nkFloatLit..nkFloat128Lit: 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]) - -proc lastSon(n: PNode): PNode = - result = n.sons[sonsLen(n) - 1] - -proc lastSon(n: PType): PType = - result = n.sons[sonsLen(n) - 1] - -proc hasSonWith(n: PNode, kind: TNodeKind): bool = - for i in countup(0, sonsLen(n) - 1): - if n.sons[i].kind == kind: + 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 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: +proc hasNilSon*(n: PNode): bool = + 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 = +proc hasSubnodeWith*(n: PNode, kind: TNodeKind): bool = case n.kind - of nkEmpty..nkNilLit: 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): + of nkEmpty..nkNilLit, nkFormalParams: result = n.kind == kind + else: + for i in 0..<n.len: + if (n[i].kind == kind) or hasSubnodeWith(n[i], kind): return true result = false -proc replaceSons(n: PNode, oldKind, newKind: TNodeKind) = - for i in countup(0, sonsLen(n) - 1): - if n.sons[i].kind == oldKind: n.sons[i].kind = newKind - -proc sonsNotNil(n: PNode): bool = - for i in countup(0, sonsLen(n) - 1): - if n.sons[i] == nil: - return false - result = true - -proc getInt*(a: PNode): biggestInt = +proc getInt*(a: PNode): Int128 = case a.kind - of nkIntLit..nkUInt64Lit: result = a.intVal - else: - internalError(a.info, "getInt") - result = 0 + 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 getFloat*(a: PNode): biggestFloat = +proc getInt64*(a: PNode): int64 {.deprecated: "use getInt".} = case a.kind - of nkFloatLit..nkFloat128Lit: result = a.floatVal - else: - internalError(a.info, "getFloat") - result = 0.0 + of nkCharLit, nkUIntLit..nkUInt64Lit, nkIntLit..nkInt64Lit: + result = a.intVal + else: + raiseRecoverableError("cannot extract number from invalid AST node") -proc getStr*(a: PNode): string = +proc getFloat*(a: PNode): BiggestFloat = case a.kind - of nkStrLit..nkTripleStrLit: result = a.strVal - else: - internalError(a.info, "getStr") - result = "" + of nkFloatLiterals: result = a.floatVal + of nkCharLit, nkUIntLit..nkUInt64Lit, nkIntLit..nkInt64Lit: + result = BiggestFloat a.intVal + else: + raiseRecoverableError("cannot extract number from invalid AST node") + #doAssert false, "getFloat" + #internalError(a.info, "getFloat") + #result = 0.0 -proc getStrOrChar*(a: PNode): string = +proc getStr*(a: PNode): string = case a.kind of nkStrLit..nkTripleStrLit: result = a.strVal - of nkCharLit: result = $chr(int(a.intVal)) - else: - internalError(a.info, "getStrOrChar") + of nkNilLit: + # let's hope this fixes more problems than it creates: result = "" + else: + raiseRecoverableError("cannot extract string from invalid AST node") + #doAssert false, "getStr" + #internalError(a.info, "getStr") + #result = "" -proc isGenericRoutine*(s: PSym): bool = - case s.kind - of skProc, skTemplate, skMacro, skIterator, skMethod, skConverter: - result = s.ast != nil and s.ast[genericParamsPos].kind != nkEmpty - else: nil +proc getStrOrChar*(a: PNode): string = + case a.kind + of nkStrLit..nkTripleStrLit: result = a.strVal + of nkCharLit..nkUInt64Lit: result = $chr(int(a.intVal)) + else: + raiseRecoverableError("cannot extract string from invalid AST node") + #doAssert false, "getStrOrChar" + #internalError(a.info, "getStrOrChar") + #result = "" + +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 == 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 + while result.kind != skModule: result = result.owner proc isRoutine*(s: PSym): bool {.inline.} = - result = s.kind in {skProc, skTemplate, skMacro, skIterator, skMethod, - skConverter} + result = s.kind in skProcKinds + +proc isCompileTimeProc*(s: PSym): bool {.inline.} = + result = s.kind == skMacro or + 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.len: 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[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 {tyEmpty, 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: + result = n + else: + result = newNodeI(nkStmtList, n.info) + result.add n + +proc skipStmtList*(n: PNode): PNode = + if n.kind in {nkStmtList, nkStmtListExpr}: + for i in 0..<n.len-1: + if n[i].kind notin {nkEmpty, nkCommentStmt}: return n + result = n.lastSon + else: + result = n + +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.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 + 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 conf.exc != excCpp: + return false + + let base = t.skipTypes({tyAlias, tyPtr, tyDistinct, tyGenericInst}) + 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.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 != 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 + + return nil + +when false: + proc containsNil*(n: PNode): bool = + # only for debugging + if n.isNil: return true + for i in 0..<n.safeLen: + if n[i].containsNil: return true + + +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 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 fd6774e7a..7a9892f78 100644 --- a/compiler/astalgo.nim +++ b/compiler/astalgo.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -11,98 +11,72 @@ # and sets of nodes are supported. Efficiency is important as # the data structures here are used in various places of the compiler. -import - ast, hashes, intsets, strutils, options, msgs, ropes, idents, rodutils - -proc hashNode*(p: PObject): THash -proc treeToYaml*(n: PNode, indent: int = 0, maxRecDepth: int = - 1): PRope - # 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*(n: PType, indent: int = 0, maxRecDepth: int = - 1): PRope -proc symToYaml*(n: PSym, indent: int = 0, maxRecDepth: int = - 1): PRope -proc lineInfoToStr*(info: TLineInfo): PRope - -# ----------------------- node sets: --------------------------------------- -proc ObjectSetContains*(t: TObjectSet, obj: PObject): bool - # returns true whether n is in t -proc ObjectSetIncl*(t: var TObjectSet, obj: PObject) - # include an element n in the table t -proc ObjectSetContainsOrIncl*(t: var TObjectSet, obj: PObject): bool - # more are not needed ... - -# ----------------------- (key, val)-Hashtables ---------------------------- -proc TablePut*(t: var TTable, key, val: PObject) -proc TableGet*(t: TTable, key: PObject): PObject -type - TCmpProc* = proc (key, closure: PObject): bool {.nimcall.} # true if found - -proc TableSearch*(t: TTable, key, closure: PObject, - comparator: TCmpProc): PObject - # return val as soon as comparator returns true; if this never happens, - # nil is returned - -# ----------------------- str table ----------------------------------------- -proc StrTableContains*(t: TStrTable, n: PSym): bool -proc StrTableAdd*(t: var TStrTable, n: PSym) -proc StrTableGet*(t: TStrTable, name: PIdent): PSym - -type - TTabIter*{.final.} = object # consider all fields here private - h*: THash # current hash - -proc InitTabIter*(ti: var TTabIter, tab: TStrTable): PSym -proc NextIter*(ti: var TTabIter, tab: TStrTable): PSym - # usage: - # var - # i: TTabIter - # s: PSym - # s = InitTabIter(i, table) - # while s != nil: - # ... - # s = NextIter(i, table) - # +import + ast, astyaml, options, lineinfos, idents, rodutils, + msgs -type - TIdentIter*{.final.} = object # iterator over all syms with same identifier - h*: THash # current hash - name*: PIdent +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 InitIdentIter*(ti: var TIdentIter, tab: TStrTable, s: PIdent): PSym -proc NextIdentIter*(ti: var TIdentIter, tab: TStrTable): PSym +proc hashNode*(p: RootRef): Hash # these are for debugging only: They are not really deprecated, but I want # the warning so that release versions do not contain debugging statements: -proc debug*(n: PSym) {.deprecated.} -proc debug*(n: PType) {.deprecated.} -proc debug*(n: PNode) {.deprecated.} - -# --------------------------- ident tables ---------------------------------- -proc IdTableGet*(t: TIdTable, key: PIdObj): PObject -proc IdTableGet*(t: TIdTable, key: int): PObject -proc IdTablePut*(t: var TIdTable, key: PIdObj, val: PObject) -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 writeIdNodeTable*(t: TIdNodeTable) +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 + elif compiles(m.c.module): + m.c.module.fileIdx == m.c.config.projectMainIdx + elif compiles(cl.c.module): + cl.c.module.fileIdx == cl.c.config.projectMainIdx + elif compiles(p): + when compiles(p.lex): + p.lex.fileIdx == p.lex.config.projectMainIdx + else: + p.module.module.fileIdx == p.config.projectMainIdx + elif compiles(m.module.fileIdx): + m.module.fileIdx == m.config.projectMainIdx + elif compiles(L.fileIdx): + L.fileIdx == L.config.projectMainIdx + else: + error() # --------------------------------------------------------------------------- -proc getSymFromList*(list: PNode, ident: PIdent, start: int = 0): PSym proc lookupInRecord*(n: PNode, field: PIdent): PSym -proc getModule*(s: PSym): PSym proc mustRehash*(length, counter: int): bool -proc nextTry*(h, maxHash: THash): THash {.inline.} +proc nextTry*(h, maxHash: Hash): Hash {.inline.} # ------------- table[int, int] --------------------------------------------- -const +const InvalidKey* = low(int) -type - TIIPair*{.final.} = object +type + TIIPair*{.final.} = object key*, val*: int TIIPairSeq* = seq[TIIPair] @@ -112,452 +86,468 @@ type proc initIITable*(x: var TIITable) -proc IITableGet*(t: TIITable, key: int): int -proc IITablePut*(t: var TIITable, key, val: int) +proc iiTableGet*(t: TIITable, key: int): int +proc iiTablePut*(t: var TIITable, key, val: int) # implementation -proc skipConv*(n: PNode): PNode = - case n.kind - of nkObjUpConv, nkObjDownConv, nkChckRange, nkChckRangeF, nkChckRange64: - result = n.sons[0] - of nkHiddenStdConv, nkHiddenSubConv, nkConv: - result = n.sons[1] - else: result = n - -proc skipConvTakeType*(n: PNode): PNode = - result = n.skipConv - result.typ = n.typ - -proc SameValue*(a, b: PNode): bool = +proc skipConvCastAndClosure*(n: PNode): PNode = + result = n + while true: + case result.kind + of nkObjUpConv, nkObjDownConv, nkChckRange, nkChckRangeF, nkChckRange64, + nkClosure: + 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..nkInt64Lit: - if b.kind in {nkCharLit..nkInt64Lit}: result = a.intVal == b.intVal - of nkFloatLit..nkFloat64Lit: + 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: + of nkStrLit..nkTripleStrLit: if b.kind in {nkStrLit..nkTripleStrLit}: result = a.strVal == b.strVal else: - # don't raise an internal error for 'nimrod check': + # don't raise an internal error for 'nim check': #InternalError(a.info, "SameValue") - nil + discard -proc leValue*(a, b: PNode): bool = +proc leValue*(a, b: PNode): bool = # a <= b? result = false case a.kind - of nkCharLit..nkInt64Lit: - if b.kind in {nkCharLit..nkInt64Lit}: result = a.intVal <= b.intVal - of nkFloatLit..nkFloat64Lit: + 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: + of nkStrLit..nkTripleStrLit: if b.kind in {nkStrLit..nkTripleStrLit}: result = a.strVal <= b.strVal - else: - # don't raise an internal error for 'nimrod check': + else: + # don't raise an internal error for 'nim check': #InternalError(a.info, "leValue") - nil + discard + +proc weakLeValue*(a, b: PNode): TImplication = + if a.kind notin nkLiterals or b.kind notin nkLiterals: + result = impUnknown + else: + result = if leValue(a, b): impYes else: impNo -proc lookupInRecord(n: PNode, field: PIdent): PSym = +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) - if result != nil: return - of nkRecCase: - if (n.sons[0].kind != nkSym): InternalError(n.info, "lookupInRecord") - result = lookupInRecord(n.sons[0], field) - if result != nil: return - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind - of nkOfBranch, nkElse: - result = lookupInRecord(lastSon(n.sons[i]), field) - if result != nil: return - else: internalError(n.info, "lookupInRecord(record case branch)") - of nkSym: + of nkRecList: + for i in 0..<n.len: + result = lookupInRecord(n[i], field) + if result != nil: return + of nkRecCase: + if (n[0].kind != nkSym): return nil + result = lookupInRecord(n[0], field) + if result != nil: return + for i in 1..<n.len: + case n[i].kind + of nkOfBranch, nkElse: + result = lookupInRecord(lastSon(n[i]), field) + if result != nil: return + else: return nil + of nkSym: if n.sym.name.id == field.id: result = n.sym - else: internalError(n.info, "lookupInRecord()") - -proc getModule(s: PSym): PSym = + else: return nil + +proc getModule*(s: PSym): PSym = result = s 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 - if result.name.id == ident.id: return - else: InternalError(list.info, "getSymFromList") + while result != nil and result.kind != skModule: result = result.owner + +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: PObject): THash = +proc hashNode(p: RootRef): Hash = result = hash(cast[pointer](p)) -proc mustRehash(length, counter: int): bool = +proc mustRehash(length, counter: int): bool = assert(length > counter) result = (length * 2 < counter * 3) or (length - counter < 4) -proc spaces(x: int): PRope = - # returns x spaces - result = toRope(repeatChar(x)) - -proc toYamlChar(c: Char): string = - case c - of '\0'..'\x1F', '\x80'..'\xFF': result = "\\u" & strutils.toHex(ord(c), 4) - of '\'', '\"', '\\': result = '\\' & c - else: result = $c - -proc makeYamlString*(s: string): PRope = - # 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, len(s) - 1): - if (i + 1) mod MaxLineLength == 0: - add(res, '\"') - add(res, "\n") - app(result, toRope(res)) - res = "\"" # reset - add(res, toYamlChar(s[i])) - add(res, '\"') - app(result, toRope(res)) - -proc flagsToStr[T](flags: set[T]): PRope = - if flags == {}: - result = toRope("[]") - else: - result = nil - for x in items(flags): - if result != nil: app(result, ", ") - app(result, makeYamlString($x)) - result = con("[", con(result, "]")) - -proc lineInfoToStr(info: TLineInfo): PRope = - result = ropef("[$1, $2, $3]", [makeYamlString(toFilename(info)), - toRope(toLinenumber(info)), - toRope(toColumn(info))]) - -proc treeToYamlAux(n: PNode, marker: var TIntSet, - indent, maxRecDepth: int): PRope -proc symToYamlAux(n: PSym, marker: var TIntSet, - indent, maxRecDepth: int): PRope -proc typeToYamlAux(n: PType, marker: var TIntSet, - indent, maxRecDepth: int): PRope -proc strTableToYaml(n: TStrTable, marker: var TIntSet, indent: int, - maxRecDepth: int): PRope = - var istr = spaces(indent + 2) - result = toRope("[") - var mycount = 0 - for i in countup(0, high(n.data)): - if n.data[i] != nil: - if mycount > 0: app(result, ",") - appf(result, "$N$1$2", - [istr, symToYamlAux(n.data[i], marker, indent + 2, maxRecDepth - 1)]) - inc(mycount) - if mycount > 0: appf(result, "$N$1", [spaces(indent)]) - app(result, "]") - assert(mycount == n.counter) - -proc ropeConstr(indent: int, c: openarray[PRope]): PRope = - # array of (name, value) pairs - var istr = spaces(indent + 2) - result = toRope("{") +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: app(result, ",") - appf(result, "$N$1\"$2\": $3", [istr, c[i], c[i + 1]]) - inc(i, 2) - appf(result, "$N$1}", [spaces(indent)]) - -proc symToYamlAux(n: PSym, marker: var TIntSet, indent: int, - maxRecDepth: int): PRope = - if n == nil: - result = toRope("null") - elif ContainsOrIncl(marker, n.id): - result = ropef("\"$1 @$2\"", [toRope(n.name.s), toRope( - strutils.toHex(cast[TAddress](n), sizeof(n) * 2))]) - else: - var ast = treeToYamlAux(n.ast, marker, indent + 2, maxRecDepth - 1) - result = ropeConstr(indent, [toRope("kind"), - makeYamlString($n.kind), - toRope("name"), makeYamlString(n.name.s), - toRope("typ"), typeToYamlAux(n.typ, marker, - indent + 2, maxRecDepth - 1), - toRope("info"), lineInfoToStr(n.info), - toRope("flags"), flagsToStr(n.flags), - toRope("magic"), makeYamlString($n.magic), - toRope("ast"), ast, toRope("options"), - flagsToStr(n.options), toRope("position"), - toRope(n.position)]) - -proc typeToYamlAux(n: PType, marker: var TIntSet, indent: int, - maxRecDepth: int): PRope = - if n == nil: - result = toRope("null") - elif ContainsOrIncl(marker, n.id): - result = ropef("\"$1 @$2\"", [toRope($n.kind), toRope( - strutils.toHex(cast[TAddress](n), sizeof(n) * 2))]) - else: - if sonsLen(n) > 0: - result = toRope("[") - for i in countup(0, sonsLen(n) - 1): - if i > 0: app(result, ",") - appf(result, "$N$1$2", [spaces(indent + 4), typeToYamlAux(n.sons[i], - marker, indent + 4, maxRecDepth - 1)]) - appf(result, "$N$1]", [spaces(indent + 2)]) - else: - result = toRope("null") - result = ropeConstr(indent, [toRope("kind"), - makeYamlString($n.kind), - toRope("sym"), symToYamlAux(n.sym, marker, - indent + 2, maxRecDepth - 1), toRope("n"), treeToYamlAux(n.n, marker, - indent + 2, maxRecDepth - 1), toRope("flags"), FlagsToStr(n.flags), - toRope("callconv"), - makeYamlString(CallingConvToStr[n.callConv]), - toRope("size"), toRope(n.size), - toRope("align"), toRope(n.align), - toRope("sons"), result]) - -proc treeToYamlAux(n: PNode, marker: var TIntSet, indent: int, - maxRecDepth: int): PRope = - if n == nil: - result = toRope("null") - else: - var istr = spaces(indent + 2) - result = ropef("{$N$1\"kind\": $2", [istr, makeYamlString($n.kind)]) - if maxRecDepth != 0: - appf(result, ",$N$1\"info\": $2", [istr, lineInfoToStr(n.info)]) - case n.kind - of nkCharLit..nkInt64Lit: - appf(result, ",$N$1\"intVal\": $2", [istr, toRope(n.intVal)]) - of nkFloatLit, nkFloat32Lit, nkFloat64Lit: - appf(result, ",$N$1\"floatVal\": $2", - [istr, toRope(n.floatVal.ToStrMaxPrecision)]) - of nkStrLit..nkTripleStrLit: - appf(result, ",$N$1\"strVal\": $2", [istr, makeYamlString(n.strVal)]) - of nkSym: - appf(result, ",$N$1\"sym\": $2", - [istr, symToYamlAux(n.sym, marker, indent + 2, maxRecDepth)]) - of nkIdent: - if n.ident != nil: - appf(result, ",$N$1\"ident\": $2", [istr, makeYamlString(n.ident.s)]) - else: - appf(result, ",$N$1\"ident\": null", [istr]) - else: - if sonsLen(n) > 0: - appf(result, ",$N$1\"sons\": [", [istr]) - for i in countup(0, sonsLen(n) - 1): - if i > 0: app(result, ",") - appf(result, "$N$1$2", [spaces(indent + 4), treeToYamlAux(n.sons[i], - marker, indent + 4, maxRecDepth - 1)]) - appf(result, "$N$1]", [istr]) - appf(result, ",$N$1\"typ\": $2", - [istr, typeToYamlAux(n.typ, marker, indent + 2, maxRecDepth)]) - appf(result, "$N$1}", [spaces(indent)]) - -proc treeToYaml(n: PNode, indent: int = 0, maxRecDepth: int = - 1): PRope = - var marker = InitIntSet() - result = treeToYamlAux(n, marker, indent, maxRecDepth) - -proc typeToYaml(n: PType, indent: int = 0, maxRecDepth: int = - 1): PRope = - var marker = InitIntSet() - result = typeToYamlAux(n, marker, indent, maxRecDepth) - -proc symToYaml(n: PSym, indent: int = 0, maxRecDepth: int = - 1): PRope = - var marker = InitIntSet() - result = symToYamlAux(n, marker, indent, maxRecDepth) - -proc debugTree(n: PNode, indent: int, maxRecDepth: int): PRope -proc debugType(n: PType): PRope = - if n == nil: - result = toRope("null") - else: - result = toRope($n.kind) - if n.sym != nil: - app(result, " ") - app(result, n.sym.name.s) - if (n.kind != tyString) and (sonsLen(n) > 0): - app(result, "(") - for i in countup(0, sonsLen(n) - 1): - if i > 0: app(result, ", ") - if n.sons[i] == nil: - app(result, "null") - else: - app(result, debugType(n.sons[i])) - if n.kind == tyObject and n.n != nil: - app(result, ", node: ") - app(result, debugTree(n.n, 2, 100)) - app(result, ")") - -proc debugTree(n: PNode, indent: int, maxRecDepth: int): PRope = - if n == nil: - result = toRope("null") - else: - var istr = spaces(indent + 2) - result = ropef("{$N$1\"kind\": $2", - [istr, makeYamlString($n.kind)]) - if maxRecDepth != 0: - case n.kind - of nkCharLit..nkUInt64Lit: - appf(result, ",$N$1\"intVal\": $2", [istr, toRope(n.intVal)]) - of nkFloatLit, nkFloat32Lit, nkFloat64Lit: - appf(result, ",$N$1\"floatVal\": $2", - [istr, toRope(n.floatVal.ToStrMaxPrecision)]) - of nkStrLit..nkTripleStrLit: - appf(result, ",$N$1\"strVal\": $2", [istr, makeYamlString(n.strVal)]) - of nkSym: - appf(result, ",$N$1\"sym\": $2_$3", - [istr, toRope(n.sym.name.s), toRope(n.sym.id)]) - # [istr, symToYaml(n.sym, indent, maxRecDepth), - # toRope(n.sym.id)]) - of nkIdent: - if n.ident != nil: - appf(result, ",$N$1\"ident\": $2", [istr, makeYamlString(n.ident.s)]) - else: - appf(result, ",$N$1\"ident\": null", [istr]) - else: - if sonsLen(n) > 0: - appf(result, ",$N$1\"sons\": [", [istr]) - for i in countup(0, sonsLen(n) - 1): - if i > 0: app(result, ",") - appf(result, "$N$1$2", [spaces(indent + 4), debugTree(n.sons[i], - indent + 4, maxRecDepth - 1)]) - appf(result, "$N$1]", [istr]) - appf(result, ",$N$1\"info\": $2", [istr, lineInfoToStr(n.info)]) - appf(result, "$N$1}", [spaces(indent)]) - -proc debug(n: PSym) = - #writeln(stdout, ropeToStr(symToYaml(n, 0, 1))) - writeln(stdout, ropeToStr(ropef("$1_$2: $3, $4", [ - toRope(n.name.s), toRope(n.id), flagsToStr(n.flags), - flagsToStr(n.loc.flags)]))) - -proc debug(n: PType) = - writeln(stdout, ropeToStr(debugType(n))) - -proc debug(n: PNode) = - writeln(stdout, ropeToStr(debugTree(n, 0, 100))) - -const - EmptySeq = @[] - -proc nextTry(h, maxHash: THash): THash = - result = ((5 * h) + 1) and maxHash + 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: + 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: + 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: + this.key "typ" + this.value "nil" + + 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 # random-number generation for proof). - -proc objectSetContains(t: TObjectSet, obj: PObject): bool = + +proc objectSetContains*(t: TObjectSet, obj: RootRef): bool = # returns true whether n is in t - var h: THash = hashNode(obj) and high(t.data) # start with real hash value - while t.data[h] != nil: - if (t.data[h] == obj): + var h: Hash = hashNode(obj) and high(t.data) # start with real hash value + while t.data[h] != nil: + if t.data[h] == obj: return true h = nextTry(h, high(t.data)) result = false -proc objectSetRawInsert(data: var TObjectSeq, obj: PObject) = - var h: THash = HashNode(obj) and high(data) - while data[h] != nil: +proc objectSetRawInsert(data: var TObjectSeq, obj: RootRef) = + var h: Hash = hashNode(obj) and high(data) + while data[h] != nil: assert(data[h] != obj) h = nextTry(h, high(data)) assert(data[h] == nil) data[h] = obj -proc objectSetEnlarge(t: var TObjectSet) = +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: PObject) = - if mustRehash(len(t.data), t.counter): objectSetEnlarge(t) +proc objectSetIncl*(t: var TObjectSet, obj: RootRef) = + if mustRehash(t.data.len, t.counter): objectSetEnlarge(t) objectSetRawInsert(t.data, obj) inc(t.counter) -proc objectSetContainsOrIncl(t: var TObjectSet, obj: PObject): bool = +proc objectSetContainsOrIncl*(t: var TObjectSet, obj: RootRef): bool = # returns true if obj is already in the string table: - var h: THash = HashNode(obj) and high(t.data) - while true: + var h: Hash = hashNode(obj) and high(t.data) + while true: var it = t.data[h] - if it == nil: break - if it == obj: + if it == nil: break + 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: + else: assert(t.data[h] == nil) t.data[h] = obj inc(t.counter) result = false -proc TableRawGet(t: TTable, key: PObject): int = - var h: THash = hashNode(key) and high(t.data) # start with real hash value - while t.data[h].key != nil: - if t.data[h].key == key: - return h - h = nextTry(h, high(t.data)) - result = -1 - -proc TableSearch(t: TTable, key, closure: PObject, - comparator: TCmpProc): PObject = - var h: THash = hashNode(key) and high(t.data) # start with real hash value - while t.data[h].key != nil: - if t.data[h].key == key: - if comparator(t.data[h].val, closure): - # BUGFIX 1 - return t.data[h].val - h = nextTry(h, high(t.data)) - result = nil - -proc TableGet(t: TTable, key: PObject): PObject = - var index = TableRawGet(t, key) - if index >= 0: result = t.data[index].val - else: result = nil - -proc TableRawInsert(data: var TPairSeq, key, val: PObject) = - var h: THash = HashNode(key) and high(data) - while data[h].key != nil: - assert(data[h].key != key) - h = nextTry(h, high(data)) - assert(data[h].key == nil) - data[h].key = key - data[h].val = val - -proc TableEnlarge(t: var TTable) = - var n: TPairSeq - newSeq(n, len(t.data) * growthFactor) - for i in countup(0, high(t.data)): - if t.data[i].key != nil: TableRawInsert(n, t.data[i].key, t.data[i].val) - swap(t.data, n) - -proc TablePut(t: var TTable, key, val: PObject) = - var index = TableRawGet(t, key) - if index >= 0: - t.data[index].val = val - else: - if mustRehash(len(t.data), t.counter): TableEnlarge(t) - TableRawInsert(t.data, key, val) - inc(t.counter) - -proc StrTableContains(t: TStrTable, n: PSym): bool = - var h: THash = n.name.h and high(t.data) # start with real hash value - while t.data[h] != nil: - if (t.data[h] == n): +proc strTableContains*(t: TStrTable, n: PSym): bool = + var h: Hash = n.name.h and high(t.data) # start with real hash value + while t.data[h] != nil: + if (t.data[h] == n): return true h = nextTry(h, high(t.data)) result = false -proc StrTableRawInsert(data: var TSymSeq, n: PSym) = - var h: THash = n.name.h and high(data) - while data[h] != nil: +proc strTableRawInsert(data: var seq[PSym], n: PSym) = + var h: Hash = n.name.h and high(data) + while data[h] != nil: if data[h] == n: # allowed for 'export' feature: #InternalError(n.info, "StrTableRawInsert: " & n.name.s) @@ -566,291 +556,216 @@ proc StrTableRawInsert(data: var TSymSeq, n: PSym) = assert(data[h] == nil) data[h] = n -proc SymTabReplaceRaw(data: var TSymSeq, prevSym: PSym, newSym: PSym) = +proc symTabReplaceRaw(data: var seq[PSym], prevSym: PSym, newSym: PSym) = assert prevSym.name.h == newSym.name.h - var h: THash = prevSym.name.h and high(data) + var h: Hash = prevSym.name.h and high(data) while data[h] != nil: if data[h] == prevSym: data[h] = newSym return h = nextTry(h, high(data)) assert false - -proc SymTabReplace*(t: var TStrTable, prevSym: PSym, newSym: PSym) = - SymTabReplaceRaw(t.data, prevSym, newSym) - -proc StrTableEnlarge(t: var TStrTable) = - var n: TSymSeq - newSeq(n, len(t.data) * growthFactor) - for i in countup(0, high(t.data)): - if t.data[i] != nil: StrTableRawInsert(n, t.data[i]) + +proc symTabReplace*(t: var TStrTable, prevSym: PSym, newSym: PSym) = + symTabReplaceRaw(t.data, prevSym, newSym) + +proc strTableEnlarge(t: var TStrTable) = + var n: seq[PSym] + newSeq(n, t.data.len * GrowthFactor) + for i in 0..high(t.data): + if t.data[i] != nil: strTableRawInsert(n, t.data[i]) swap(t.data, n) -proc StrTableAdd(t: var TStrTable, n: PSym) = - if mustRehash(len(t.data), t.counter): StrTableEnlarge(t) - StrTableRawInsert(t.data, n) +proc strTableAdd*(t: var TStrTable, n: PSym) = + if mustRehash(t.data.len, t.counter): strTableEnlarge(t) + strTableRawInsert(t.data, n) inc(t.counter) -proc StrTableIncl*(t: var TStrTable, n: PSym): 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: THash = n.name.h and high(t.data) + var h: Hash = n.name.h and high(t.data) + var replaceSlot = -1 while true: var it = t.data[h] if it == nil: break + # Semantic checking can happen multiple times thanks to templates + # and overloading: (var x=@[]; x).mapIt(it). + # So it is possible the very same sym is added multiple + # times to the symbol table which we allow here with the 'it == n' check. if it.name.id == n.name.id: - t.data[h] = n # overwrite it with newer definition! - return true # found it + if it == n: return nil + replaceSlot = h h = nextTry(h, high(t.data)) - if mustRehash(len(t.data), t.counter): - StrTableEnlarge(t) - StrTableRawInsert(t.data, n) + if replaceSlot >= 0: + result = t.data[replaceSlot] # found it + if not onConflictKeepOld: + t.data[replaceSlot] = n # overwrite it with newer definition! + return result # but return the old one + elif mustRehash(t.data.len, t.counter): + strTableEnlarge(t) + strTableRawInsert(t.data, n) else: assert(t.data[h] == nil) t.data[h] = n inc(t.counter) - result = false + result = nil -proc StrTableGet(t: TStrTable, name: PIdent): PSym = - var h: THash = name.h and high(t.data) - while true: +proc strTableIncl*(t: var TStrTable, n: PSym; + onConflictKeepOld = false): bool {.discardable.} = + result = strTableInclReportConflict(t, n, onConflictKeepOld) != nil + +proc strTableGet*(t: TStrTable, name: PIdent): PSym = + var h: Hash = name.h and high(t.data) + while true: result = t.data[h] - if result == nil: break - if result.name.id == name.id: break + if result == nil: break + if result.name.id == name.id: break h = nextTry(h, high(t.data)) -proc InitIdentIter(ti: var TIdentIter, tab: TStrTable, s: PIdent): PSym = - ti.h = s.h - ti.name = s - if tab.Counter == 0: result = nil - else: result = NextIdentIter(ti, tab) - -proc NextIdentIter(ti: var TIdentIter, tab: TStrTable): PSym = - var h, start: THash - h = ti.h and high(tab.data) - start = h - result = tab.data[h] - while result != nil: - if result.Name.id == ti.name.id: break + +type + TIdentIter* = object # iterator over all syms with same identifier + h*: Hash # current hash + name*: PIdent + +proc nextIdentIter*(ti: var TIdentIter, tab: TStrTable): PSym = + # hot spots + var h = ti.h and high(tab.data) + var start = h + 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 - break - result = tab.data[h] + if h == start: + p = nil + break + p = tab.data[h] + if p != nil: + result = p # increase the count + else: + result = nil ti.h = nextTry(h, high(tab.data)) - -proc NextIdentExcluding*(ti: var TIdentIter, tab: TStrTable, - excluding: TIntSet): PSym = - var h: THash = ti.h and high(tab.data) + +proc initIdentIter*(ti: var TIdentIter, tab: TStrTable, s: PIdent): PSym = + ti.h = s.h + ti.name = s + if tab.counter == 0: result = nil + else: result = nextIdentIter(ti, tab) + +proc nextIdentExcluding*(ti: var TIdentIter, tab: TStrTable, + excluding: IntSet): PSym = + var h: Hash = ti.h and high(tab.data) var start = h result = tab.data[h] - while result != nil: - if result.Name.id == ti.name.id and not Contains(excluding, result.id): + while result != nil: + if result.name.id == ti.name.id and not contains(excluding, result.id): break h = nextTry(h, high(tab.data)) - if h == start: + if h == start: result = nil - break + break result = tab.data[h] ti.h = nextTry(h, high(tab.data)) - if result != nil and Contains(excluding, result.id): result = nil + if result != nil and contains(excluding, result.id): result = nil -proc FirstIdentExcluding*(ti: var TIdentIter, tab: TStrTable, s: PIdent, - excluding: TIntSet): PSym = +proc firstIdentExcluding*(ti: var TIdentIter, tab: TStrTable, s: PIdent, + excluding: IntSet): PSym = ti.h = s.h ti.name = s - if tab.Counter == 0: result = nil - else: result = NextIdentExcluding(ti, tab, excluding) - -proc InitTabIter(ti: var TTabIter, tab: TStrTable): PSym = - ti.h = 0 # we start by zero ... - if tab.counter == 0: - result = nil # FIX 1: removed endless loop - else: - result = NextIter(ti, tab) - -proc NextIter(ti: var TTabIter, tab: TStrTable): PSym = - result = nil - while (ti.h <= high(tab.data)): - result = tab.data[ti.h] - Inc(ti.h) # ... and increment by one always - if result != nil: break + if tab.counter == 0: result = nil + else: result = nextIdentExcluding(ti, tab, excluding) -iterator items*(tab: TStrTable): PSym = - var it: 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: THash - 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): PObject = - var index = IdTableRawGet(t, key.id) - if index >= 0: result = t.data[index].val - else: result = nil - -proc IdTableGet(t: TIdTable, key: int): PObject = - var index = IdTableRawGet(t, key) - if index >= 0: result = t.data[index].val - else: result = nil - -iterator pairs*(t: TIdTable): tuple[key: int, value: PObject] = - 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: PObject) = - var h: THash - 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 +type + TTabIter* = object + h: Hash -proc IdTablePut(t: var TIdTable, key: PIdObj, val: PObject) = - 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: PObject] = - for i in 0 .. high(t.data): - if not isNil(t.data[i].key): yield (t.data[i].key, t.data[i].val) - -proc writeIdNodeTable(t: TIdNodeTable) = - nil - -proc IdNodeTableRawGet(t: TIdNodeTable, key: PIdObj): int = - var h: THash - 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: THash - 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 nextIter*(ti: var TTabIter, tab: TStrTable): PSym = + # usage: + # var + # i: TTabIter + # s: PSym + # s = InitTabIter(i, table) + # while s != nil: + # ... + # s = NextIter(i, table) + # + result = nil + while (ti.h <= high(tab.data)): + result = tab.data[ti.h] + inc(ti.h) # ... and increment by one always + if result != nil: break -proc IdNodeTablePutLazy*(t: var TIdNodeTable, key: PIdObj, val: PNode) = - if isNil(t.data): initIdNodeTable(t) - IdNodeTablePut(t, key, val) +proc initTabIter*(ti: var TTabIter, tab: TStrTable): PSym = + ti.h = 0 + if tab.counter == 0: + result = nil + else: + result = nextIter(ti, tab) -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) +iterator items*(tab: TStrTable): PSym = + var it: TTabIter = default(TTabIter) + var s = initTabIter(it, tab) + while s != nil: + yield s + s = nextIter(it, tab) -proc initIITable(x: var TIITable) = +proc initIITable(x: var TIITable) = x.counter = 0 - newSeq(x.data, startSize) - for i in countup(0, startSize - 1): x.data[i].key = InvalidKey - -proc IITableRawGet(t: TIITable, key: int): int = - var h: THash + newSeq(x.data, StartSize) + for i in 0..<StartSize: x.data[i].key = InvalidKey + +proc iiTableRawGet(t: TIITable, key: int): int = + var h: Hash h = key and high(t.data) # start with real hash value - while t.data[h].key != InvalidKey: - if (t.data[h].key == key): - return h + while t.data[h].key != InvalidKey: + if t.data[h].key == key: return h h = nextTry(h, high(t.data)) - result = - 1 + result = -1 -proc IITableGet(t: TIITable, key: int): int = - var index = IITableRawGet(t, key) +proc iiTableGet(t: TIITable, key: int): int = + var index = iiTableRawGet(t, key) if index >= 0: result = t.data[index].val else: result = InvalidKey - -proc IITableRawInsert(data: var TIIPairSeq, key, val: int) = - var h: THash + +proc iiTableRawInsert(data: var TIIPairSeq, key, val: int) = + var h: Hash h = key and high(data) - while data[h].key != InvalidKey: + while data[h].key != InvalidKey: assert(data[h].key != key) h = nextTry(h, high(data)) assert(data[h].key == InvalidKey) data[h].key = key data[h].val = val -proc IITablePut(t: var TIITable, key, val: int) = - var index = IITableRawGet(t, key) - if index >= 0: +proc iiTablePut(t: var TIITable, key, val: int) = + var index = iiTableRawGet(t, key) + if index >= 0: assert(t.data[index].key != InvalidKey) t.data[index].val = val - else: - if mustRehash(len(t.data), t.counter): + else: + 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)): - if t.data[i].key != InvalidKey: - IITableRawInsert(n, t.data[i].key, t.data[i].val) + 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) + 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/babelcmd.nim b/compiler/babelcmd.nim deleted file mode 100644 index b67a26040..000000000 --- a/compiler/babelcmd.nim +++ /dev/null @@ -1,90 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Implements some helper procs for Babel (Nimrod's package manager) support. - -import parseutils, strutils, strtabs, os, options, msgs, lists - -proc addPath*(path: string, info: TLineInfo) = - if not contains(options.searchPaths, path): - lists.PrependStr(options.searchPaths, path) - -proc versionSplitPos(s: string): int = - result = s.len-2 - while result > 1 and s[result] in {'0'..'9', '.'}: dec result - if s[result] != '-': result = s.len - -const - latest = "head" - -proc `<.`(a, b: string): bool = - # wether a has a smaller version than b: - if a == latest: return false - var i = 0 - var j = 0 - var verA = 0 - var verB = 0 - while true: - let ii = parseInt(a, verA, i) - let jj = parseInt(b, verB, j) - # if A has no number left, but B has, B is prefered: 0.8 vs 0.8.3 - if ii <= 0 or jj <= 0: return jj > 0 - if verA < verB: return true - elif verA > verB: return false - # else: same version number; continue: - inc i, ii - inc j, jj - if a[i] == '.': inc i - if b[j] == '.': inc j - -proc addPackage(packages: PStringTable, p: string) = - let x = versionSplitPos(p) - let name = p.subStr(0, x-1) - if x < p.len: - let version = p.subStr(x+1) - if packages[name] <. version: - packages[name] = version - else: - packages[name] = latest - -iterator chosen(packages: PStringTable): string = - for key, val in pairs(packages): - let res = if val == latest: key else: key & '-' & val - yield res - -proc addBabelPath(p: string, info: TLineInfo) = - if not contains(options.searchPaths, p): - if gVerbosity >= 1: Message(info, hintPath, p) - lists.PrependStr(options.lazyPaths, p) - -proc addPathWithNimFiles(p: string, info: TLineInfo) = - proc hasNimFile(dir: string): bool = - for kind, path in walkDir(dir): - if kind == pcFile and path.endsWith(".nim"): - result = true - break - if hasNimFile(p): - addBabelPath(p, info) - else: - for kind, p2 in walkDir(p): - if hasNimFile(p2): addBabelPath(p2, info) - -proc addPathRec(dir: string, info: TLineInfo) = - var packages = newStringTable(modeStyleInsensitive) - var pos = dir.len-1 - if dir[pos] in {DirSep, AltSep}: inc(pos) - for k,p in os.walkDir(dir): - if k == pcDir and p[pos] != '.': - addPackage(packages, p) - for p in packages.chosen: - addBabelPath(p, info) - -proc babelPath*(path: string, info: TLineInfo) = - addPathRec(path, info) - addBabelPath(path, info) diff --git a/compiler/bitsets.nim b/compiler/bitsets.nim index dfb23b06d..7d142b01d 100644 --- a/compiler/bitsets.nim +++ b/compiler/bitsets.nim @@ -1,71 +1,97 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # -# this unit handles Nimrod sets; it implements bit sets -# the code here should be reused in the Nimrod standard library +# this unit handles Nim sets; it implements bit sets +# the code here should be reused in the Nim standard library -type - TBitSet* = seq[int8] # we use byte here to avoid issues with +when defined(nimPreviewSlimSystem): + import std/assertions + +type + ElemType = byte + TBitSet* = seq[ElemType] # we use byte here to avoid issues with # cross-compiling; uint would be more efficient # however +const + ElemSize* = 8 + One = ElemType(1) + Zero = ElemType(0) + +template modElemSize(arg: untyped): untyped = arg and 7 +template divElemSize(arg: untyped): untyped = arg shr 3 -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 -# 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) = +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 BitSetDiff(x: var TBitSet, y: TBitSet) = - for i in countup(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 BitSetIntersect(x: var TBitSet, y: TBitSet) = - for i in countup(0, high(x)): x[i] = x[i] and y[i] - -proc BitSetEquals(x, y: TBitSet): bool = - for i in countup(0, high(x)): - if x[i] != 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 0..high(x): x[i] = x[i] and not 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 0..high(x): x[i] = x[i] and y[i] + +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[uint8, uint8] = block: + var arr: array[uint8, uint8] + + proc countSetBits(x: uint8): uint8 = + return + ( 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 = + result = 0 + for it in x: + result.inc int(populationCount[it]) + +proc bitSetToWord*(s: TBitSet; size: int): BiggestUInt = + result = 0 + for j in 0..<size: + if j < s.len: result = result or (BiggestUInt(s[j]) shl (j * 8)) diff --git a/compiler/btrees.nim b/compiler/btrees.nim new file mode 100644 index 000000000..3b737b1bc --- /dev/null +++ b/compiler/btrees.nim @@ -0,0 +1,180 @@ +# +# +# The Nim Compiler +# (c) Copyright 2018 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## 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] {.acyclic.} = ref object + entries: int + keys: array[M, Key] + case isInternal: bool + of false: + vals: array[M, Val] + of true: + links: array[M, Node[Key, Val]] + BTree*[Key, Val] = object + root: Node[Key, Val] + entries: int ## number of key-value pairs + +proc initBTree*[Key, Val](): BTree[Key, Val] = + BTree[Key, Val](root: Node[Key, Val](entries: 0, isInternal: false)) + +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: + 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: + 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: + 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: + if eq(key, x.keys[j]): return true + return false + +proc copyHalf[Key, Val](h, result: Node[Key, Val]) = + for j in 0..<Mhalf: + result.keys[j] = h.keys[Mhalf + j] + if h.isInternal: + for j in 0..<Mhalf: + result.links[j] = h.links[Mhalf + j] + else: + 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 + result = Node[Key, Val](entries: Mhalf, isInternal: h.isInternal) + h.entries = Mhalf + copyHalf(h, result) + +proc insert[Key, Val](h: Node[Key, Val], key: Key, val: Val): Node[Key, Val] = + #var t = Entry(key: key, val: val, next: nil) + var newKey = key + 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): + 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 + while j < h.entries: + if j+1 == h.entries or less(key, h.keys[j+1]): + let u = insert(h.links[j], key, val) + inc j + if u == nil: return nil + newKey = u.keys[0] + newLink = u + break + inc j + for i in countdown(h.entries, j+1): + h.links[i] = h.links[i-1] + h.links[j] = newLink + + for i in countdown(h.entries, j+1): + h.keys[i] = h.keys[i-1] + h.keys[j] = newKey + inc h.entries + return if h.entries < M: nil else: split(h) + +proc add*[Key, Val](b: var BTree[Key, Val]; key: Key; val: Val) = + let u = insert(b.root, key, val) + inc b.entries + if u == nil: return + + # need to split root + let t = Node[Key, Val](entries: 2, isInternal: true) + t.keys[0] = b.root.keys[0] + t.links[0] = b.root + t.keys[1] = u.keys[0] + t.links[1] = u + b.root = t + +proc toString[Key, Val](h: Node[Key, Val], indent: string; result: var string) = + if not h.isInternal: + for j in 0..<h.entries: + result.add(indent) + result.add($h.keys[j] & " " & $h.vals[j] & "\n") + else: + for j in 0..<h.entries: + if j > 0: result.add(indent & "(" & $h.keys[j] & ")\n") + toString(h.links[j], indent & " ", result) + +proc `$`[Key, Val](b: BTree[Key, Val]): string = + result = "" + toString(b.root, "", result) + +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: + result = 0 + for k in 0..<it.entries: + inc result, countSubTree(it.links[k]) + else: + result = it.entries + +proc next*[Key, Val](b: BTree[Key, Val]; index: int): (Key, Val, int) = + var it = b.root + var i = index + # navigate to the right leaf: + while it.isInternal: + var sum = 0 + for k in 0..<it.entries: + let c = countSubTree(it.links[k]) + inc sum, c + if sum > i: + it = it.links[k] + dec i, (sum - c) + break + result = (it.keys[i], it.vals[i], index+1) + +iterator pairs*[Key, Val](b: BTree[Key, Val]): (Key, Val) = + var i = 0 + while hasNext(b, i): + let (k, v, i2) = next(b, i) + i = i2 + yield (k, v) + +proc len*[Key, Val](b: BTree[Key, Val]): int {.inline.} = b.entries diff --git a/compiler/c2nim/c2nim.nim b/compiler/c2nim/c2nim.nim deleted file mode 100644 index 029f9ecda..000000000 --- a/compiler/c2nim/c2nim.nim +++ /dev/null @@ -1,77 +0,0 @@ -# -# -# c2nim - C to Nimrod source converter -# (c) Copyright 2013 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -import - strutils, os, times, parseopt, llstream, ast, renderer, options, msgs, - clex, cparse - -const - Version = NimrodVersion - Usage = """ -c2nim - C to Nimrod source converter - (c) 2013 Andreas Rumpf -Usage: c2nim [options] inputfile [options] -Options: - -o, --out:FILE set output filename - --dynlib:SYMBOL import from dynlib: SYMBOL will be used for the import - --header:HEADER_FILE import from a HEADER_FILE (discouraged!) - --cdecl annotate procs with ``{.cdecl.}`` - --stdcall annotate procs with ``{.stdcall.}`` - --ref convert typ* to ref typ (default: ptr typ) - --prefix:PREFIX strip prefix for the generated Nimrod identifiers - (multiple --prefix options are supported) - --suffix:SUFFIX strip suffix for the generated Nimrod identifiers - (multiple --suffix options are supported) - --skipinclude do not convert ``#include`` to ``import`` - --typeprefixes generate ``T`` and ``P`` type prefixes - --skipcomments do not copy comments - -v, --version write c2nim's version - -h, --help show this help -""" - -proc main(infile, outfile: string, options: PParserOptions) = - var start = getTime() - var stream = LLStreamOpen(infile, fmRead) - if stream == nil: rawMessage(errCannotOpenFile, infile) - var p: TParser - openParser(p, infile, stream, options) - var module = parseUnit(p) - closeParser(p) - renderModule(module, outfile) - rawMessage(hintSuccessX, [$gLinesCompiled, $(getTime() - start), - formatSize(getTotalMem())]) - -var - infile = "" - outfile = "" - parserOptions = newParserOptions() -for kind, key, val in getopt(): - case kind - of cmdArgument: infile = key - of cmdLongOption, cmdShortOption: - case key.toLower - of "help", "h": - stdout.write(Usage) - quit(0) - of "version", "v": - stdout.write(Version & "\n") - quit(0) - of "o", "out": outfile = val - else: - if not parserOptions.setOption(key, val): - stdout.writeln("[Error] unknown option: " & key) - of cmdEnd: assert(false) -if infile.len == 0: - # no filename has been given, so we show the help: - stdout.write(Usage) -else: - if outfile.len == 0: - outfile = changeFileExt(infile, "nim") - infile = addFileExt(infile, "h") - main(infile, outfile, parserOptions) diff --git a/compiler/c2nim/clex.nim b/compiler/c2nim/clex.nim deleted file mode 100644 index 5b648392f..000000000 --- a/compiler/c2nim/clex.nim +++ /dev/null @@ -1,752 +0,0 @@ -# -# -# c2nim - C to Nimrod source converter -# (c) Copyright 2012 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements an Ansi C scanner. This is an adaption from -# the scanner module. Keywords are not handled here, but in the parser to make -# it more flexible. - - -import - options, msgs, strutils, platform, nimlexbase, llstream - -const - MaxLineLength* = 80 # lines longer than this lead to a warning - numChars*: TCharSet = {'0'..'9', 'a'..'z', 'A'..'Z'} - SymChars*: TCharSet = {'a'..'z', 'A'..'Z', '0'..'9', '_', '\x80'..'\xFF'} - SymStartChars*: TCharSet = {'a'..'z', 'A'..'Z', '_', '\x80'..'\xFF'} - -type - TTokKind* = enum - pxInvalid, pxEof, - pxMacroParam, # fake token: macro parameter (with its index) - pxStarComment, # /* */ comment - pxLineComment, # // comment - pxDirective, # #define, etc. - pxDirectiveParLe, # #define m( with parle (yes, C is that ugly!) - pxDirConc, # ## - pxNewLine, # newline: end of directive - pxAmp, # & - pxAmpAmp, # && - pxAmpAsgn, # &= - pxAmpAmpAsgn, # &&= - pxBar, # | - pxBarBar, # || - pxBarAsgn, # |= - pxBarBarAsgn, # ||= - pxNot, # ! - pxPlusPlus, # ++ - pxMinusMinus, # -- - pxPlus, # + - pxPlusAsgn, # += - pxMinus, # - - pxMinusAsgn, # -= - pxMod, # % - pxModAsgn, # %= - pxSlash, # / - pxSlashAsgn, # /= - pxStar, # * - pxStarAsgn, # *= - pxHat, # ^ - pxHatAsgn, # ^= - pxAsgn, # = - pxEquals, # == - pxDot, # . - pxDotDotDot, # ... - pxLe, # <= - pxLt, # < - pxGe, # >= - pxGt, # > - pxNeq, # != - pxConditional, # ? - pxShl, # << - pxShlAsgn, # <<= - pxShr, # >> - pxShrAsgn, # >>= - pxTilde, # ~ - pxTildeAsgn, # ~= - pxArrow, # -> - pxScope, # :: - - pxStrLit, - pxCharLit, - pxSymbol, # a symbol - pxIntLit, - pxInt64Lit, # long constant like 0x70fffffff or out of int range - pxFloatLit, - pxParLe, pxBracketLe, pxCurlyLe, # this order is important - pxParRi, pxBracketRi, pxCurlyRi, # for macro argument parsing! - pxComma, pxSemiColon, pxColon, - TTokKinds* = set[TTokKind] - -type - TNumericalBase* = enum base10, base2, base8, base16 - TToken* = object - xkind*: TTokKind # the type of the token - s*: string # parsed symbol, char or string literal - iNumber*: BiggestInt # the parsed integer literal; - # if xkind == pxMacroParam: parameter's position - fNumber*: BiggestFloat # the parsed floating point literal - base*: TNumericalBase # the numerical base; only valid for int - # or float literals - next*: ref TToken # for C we need arbitrary look-ahead :-( - - TLexer* = object of TBaseLexer - fileIdx*: int32 - inDirective: bool - -proc getTok*(L: var TLexer, tok: var TToken) -proc PrintTok*(tok: TToken) -proc `$`*(tok: TToken): string -# implementation - -var - gLinesCompiled*: int - -proc fillToken(L: var TToken) = - L.xkind = pxInvalid - L.iNumber = 0 - L.s = "" - L.fNumber = 0.0 - L.base = base10 - -proc openLexer*(lex: var TLexer, filename: string, inputstream: PLLStream) = - openBaseLexer(lex, inputstream) - lex.fileIdx = filename.fileInfoIdx - -proc closeLexer*(lex: var TLexer) = - inc(gLinesCompiled, lex.LineNumber) - closeBaseLexer(lex) - -proc getColumn*(L: TLexer): int = - result = getColNumber(L, L.bufPos) - -proc getLineInfo*(L: TLexer): TLineInfo = - result = newLineInfo(L.fileIdx, L.linenumber, getColNumber(L, L.bufpos)) - -proc lexMessage*(L: TLexer, msg: TMsgKind, arg = "") = - msgs.GlobalError(getLineInfo(L), msg, arg) - -proc lexMessagePos(L: var TLexer, msg: TMsgKind, pos: int, arg = "") = - var info = newLineInfo(L.fileIdx, L.linenumber, pos - L.lineStart) - msgs.GlobalError(info, msg, arg) - -proc TokKindToStr*(k: TTokKind): string = - case k - of pxEof: result = "[EOF]" - of pxInvalid: result = "[invalid]" - of pxMacroParam: result = "[macro param]" - of pxStarComment, pxLineComment: result = "[comment]" - of pxStrLit: result = "[string literal]" - of pxCharLit: result = "[char literal]" - - of pxDirective, pxDirectiveParLe: result = "#" # #define, etc. - of pxDirConc: result = "##" - of pxNewLine: result = "[NewLine]" - of pxAmp: result = "&" # & - of pxAmpAmp: result = "&&" # && - of pxAmpAsgn: result = "&=" # &= - of pxAmpAmpAsgn: result = "&&=" # &&= - of pxBar: result = "|" # | - of pxBarBar: result = "||" # || - of pxBarAsgn: result = "|=" # |= - of pxBarBarAsgn: result = "||=" # ||= - of pxNot: result = "!" # ! - of pxPlusPlus: result = "++" # ++ - of pxMinusMinus: result = "--" # -- - of pxPlus: result = "+" # + - of pxPlusAsgn: result = "+=" # += - of pxMinus: result = "-" # - - of pxMinusAsgn: result = "-=" # -= - of pxMod: result = "%" # % - of pxModAsgn: result = "%=" # %= - of pxSlash: result = "/" # / - of pxSlashAsgn: result = "/=" # /= - of pxStar: result = "*" # * - of pxStarAsgn: result = "*=" # *= - of pxHat: result = "^" # ^ - of pxHatAsgn: result = "^=" # ^= - of pxAsgn: result = "=" # = - of pxEquals: result = "==" # == - of pxDot: result = "." # . - of pxDotDotDot: result = "..." # ... - of pxLe: result = "<=" # <= - of pxLt: result = "<" # < - of pxGe: result = ">=" # >= - of pxGt: result = ">" # > - of pxNeq: result = "!=" # != - of pxConditional: result = "?" - of pxShl: result = "<<" - of pxShlAsgn: result = "<<=" - of pxShr: result = ">>" - of pxShrAsgn: result = ">>=" - of pxTilde: result = "~" - of pxTildeAsgn: result = "~=" - of pxArrow: result = "->" - of pxScope: result = "::" - - of pxSymbol: result = "[identifier]" - of pxIntLit, pxInt64Lit: result = "[integer literal]" - of pxFloatLit: result = "[floating point literal]" - of pxParLe: result = "(" - of pxParRi: result = ")" - of pxBracketLe: result = "[" - of pxBracketRi: result = "]" - of pxComma: result = "," - of pxSemiColon: result = ";" - of pxColon: result = ":" - of pxCurlyLe: result = "{" - of pxCurlyRi: result = "}" - -proc `$`(tok: TToken): string = - case tok.xkind - of pxSymbol, pxInvalid, pxStarComment, pxLineComment, pxStrLit: result = tok.s - of pxIntLit, pxInt64Lit: result = $tok.iNumber - of pxFloatLit: result = $tok.fNumber - else: result = TokKindToStr(tok.xkind) - -proc PrintTok(tok: TToken) = - writeln(stdout, $tok) - -proc matchUnderscoreChars(L: var TLexer, tok: var TToken, chars: TCharSet) = - # matches ([chars]_)* - var pos = L.bufpos # use registers for pos, buf - var buf = L.buf - while true: - if buf[pos] in chars: - add(tok.s, buf[pos]) - Inc(pos) - else: - break - if buf[pos] == '_': - add(tok.s, '_') - Inc(pos) - L.bufPos = pos - -proc isFloatLiteral(s: string): bool = - for i in countup(0, len(s)-1): - if s[i] in {'.', 'e', 'E'}: - return true - -proc getNumber2(L: var TLexer, tok: var TToken) = - var pos = L.bufpos + 2 # skip 0b - tok.base = base2 - var xi: biggestInt = 0 - var bits = 0 - while true: - case L.buf[pos] - of 'A'..'Z', 'a'..'z': - # ignore type suffix: - inc(pos) - of '2'..'9', '.': - lexMessage(L, errInvalidNumber) - inc(pos) - of '_': - inc(pos) - of '0', '1': - xi = `shl`(xi, 1) or (ord(L.buf[pos]) - ord('0')) - inc(pos) - inc(bits) - else: break - tok.iNumber = xi - if (bits > 32): tok.xkind = pxInt64Lit - else: tok.xkind = pxIntLit - L.bufpos = pos - -proc getNumber8(L: var TLexer, tok: var TToken) = - var pos = L.bufpos + 1 # skip 0 - tok.base = base8 - var xi: biggestInt = 0 - var bits = 0 - while true: - case L.buf[pos] - of 'A'..'Z', 'a'..'z': - # ignore type suffix: - inc(pos) - of '8'..'9', '.': - lexMessage(L, errInvalidNumber) - inc(pos) - of '_': - inc(pos) - of '0'..'7': - xi = `shl`(xi, 3) or (ord(L.buf[pos]) - ord('0')) - inc(pos) - inc(bits) - else: break - tok.iNumber = xi - if (bits > 12): tok.xkind = pxInt64Lit - else: tok.xkind = pxIntLit - L.bufpos = pos - -proc getNumber16(L: var TLexer, tok: var TToken) = - var pos = L.bufpos + 2 # skip 0x - tok.base = base16 - var xi: biggestInt = 0 - var bits = 0 - while true: - case L.buf[pos] - of 'G'..'Z', 'g'..'z': - # ignore type suffix: - inc(pos) - of '_': inc(pos) - of '0'..'9': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('0')) - inc(pos) - inc(bits, 4) - of 'a'..'f': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('a') + 10) - inc(pos) - inc(bits, 4) - of 'A'..'F': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('A') + 10) - inc(pos) - inc(bits, 4) - else: break - tok.iNumber = xi - if bits > 32: tok.xkind = pxInt64Lit - else: tok.xkind = pxIntLit - L.bufpos = pos - -proc getNumber(L: var TLexer, tok: var TToken) = - tok.base = base10 - matchUnderscoreChars(L, tok, {'0'..'9'}) - if (L.buf[L.bufpos] == '.') and (L.buf[L.bufpos + 1] in {'0'..'9'}): - add(tok.s, '.') - inc(L.bufpos) - matchUnderscoreChars(L, tok, {'e', 'E', '+', '-', '0'..'9'}) - try: - if isFloatLiteral(tok.s): - tok.fnumber = parseFloat(tok.s) - tok.xkind = pxFloatLit - else: - tok.iNumber = ParseInt(tok.s) - if (tok.iNumber < low(int32)) or (tok.iNumber > high(int32)): - tok.xkind = pxInt64Lit - else: - tok.xkind = pxIntLit - except EInvalidValue: - lexMessage(L, errInvalidNumber, tok.s) - except EOverflow: - lexMessage(L, errNumberOutOfRange, tok.s) - # ignore type suffix: - while L.buf[L.bufpos] in {'A'..'Z', 'a'..'z'}: inc(L.bufpos) - -proc HandleCRLF(L: var TLexer, pos: int): int = - case L.buf[pos] - of CR: result = nimlexbase.HandleCR(L, pos) - of LF: result = nimlexbase.HandleLF(L, pos) - else: result = pos - -proc escape(L: var TLexer, tok: var TToken, allowEmpty=false) = - inc(L.bufpos) # skip \ - case L.buf[L.bufpos] - of 'b', 'B': - add(tok.s, '\b') - inc(L.bufpos) - of 't', 'T': - add(tok.s, '\t') - inc(L.bufpos) - of 'n', 'N': - add(tok.s, '\L') - inc(L.bufpos) - of 'f', 'F': - add(tok.s, '\f') - inc(L.bufpos) - of 'r', 'R': - add(tok.s, '\r') - inc(L.bufpos) - of '\'': - add(tok.s, '\'') - inc(L.bufpos) - of '"': - add(tok.s, '"') - inc(L.bufpos) - of '\\': - add(tok.s, '\b') - inc(L.bufpos) - of '0'..'7': - var xi = ord(L.buf[L.bufpos]) - ord('0') - inc(L.bufpos) - if L.buf[L.bufpos] in {'0'..'7'}: - xi = (xi shl 3) or (ord(L.buf[L.bufpos]) - ord('0')) - inc(L.bufpos) - if L.buf[L.bufpos] in {'0'..'7'}: - xi = (xi shl 3) or (ord(L.buf[L.bufpos]) - ord('0')) - inc(L.bufpos) - add(tok.s, chr(xi)) - elif not allowEmpty: - lexMessage(L, errInvalidCharacterConstant) - -proc getCharLit(L: var TLexer, tok: var TToken) = - inc(L.bufpos) # skip ' - if L.buf[L.bufpos] == '\\': - escape(L, tok) - else: - add(tok.s, L.buf[L.bufpos]) - inc(L.bufpos) - if L.buf[L.bufpos] == '\'': - inc(L.bufpos) - else: - lexMessage(L, errMissingFinalQuote) - tok.xkind = pxCharLit - -proc getString(L: var TLexer, tok: var TToken) = - var pos = L.bufPos + 1 # skip " - var buf = L.buf # put `buf` in a register - var line = L.linenumber # save linenumber for better error message - while true: - case buf[pos] - of '\"': - Inc(pos) - break - of CR: - pos = nimlexbase.HandleCR(L, pos) - buf = L.buf - of LF: - pos = nimlexbase.HandleLF(L, pos) - buf = L.buf - of nimlexbase.EndOfFile: - var line2 = L.linenumber - L.LineNumber = line - lexMessagePos(L, errClosingQuoteExpected, L.lineStart) - L.LineNumber = line2 - break - of '\\': - # we allow an empty \ for line concatenation, but we don't require it - # for line concatenation - L.bufpos = pos - escape(L, tok, allowEmpty=true) - pos = L.bufpos - else: - add(tok.s, buf[pos]) - Inc(pos) - L.bufpos = pos - tok.xkind = pxStrLit - -proc getSymbol(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - while true: - var c = buf[pos] - if c notin SymChars: break - add(tok.s, c) - Inc(pos) - L.bufpos = pos - tok.xkind = pxSymbol - -proc scanLineComment(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - # a comment ends if the next line does not start with the // on the same - # column after only whitespace - tok.xkind = pxLineComment - var col = getColNumber(L, pos) - while true: - inc(pos, 2) # skip // - add(tok.s, '#') - while not (buf[pos] in {CR, LF, nimlexbase.EndOfFile}): - add(tok.s, buf[pos]) - inc(pos) - pos = handleCRLF(L, pos) - buf = L.buf - var indent = 0 - while buf[pos] == ' ': - inc(pos) - inc(indent) - if (col == indent) and (buf[pos] == '/') and (buf[pos + 1] == '/'): - add(tok.s, "\n") - else: - break - L.bufpos = pos - -proc scanStarComment(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - tok.s = "#" - tok.xkind = pxStarComment - while true: - case buf[pos] - of CR, LF: - pos = HandleCRLF(L, pos) - buf = L.buf - add(tok.s, "\n#") - # skip annoying stars as line prefix: (eg. - # /* - # * ugly comment <-- this star - # */ - while buf[pos] in {' ', '\t'}: - add(tok.s, ' ') - inc(pos) - if buf[pos] == '*' and buf[pos+1] != '/': inc(pos) - of '*': - inc(pos) - if buf[pos] == '/': - inc(pos) - break - else: - add(tok.s, '*') - of nimlexbase.EndOfFile: - lexMessage(L, errTokenExpected, "*/") - else: - add(tok.s, buf[pos]) - inc(pos) - L.bufpos = pos - -proc skip(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - while true: - case buf[pos] - of '\\': - # Ignore \ line continuation characters when not inDirective - inc(pos) - if L.inDirective: - while buf[pos] in {' ', '\t'}: inc(pos) - if buf[pos] in {CR, LF}: - pos = HandleCRLF(L, pos) - buf = L.buf - of ' ', Tabulator: - Inc(pos) # newline is special: - of CR, LF: - pos = HandleCRLF(L, pos) - buf = L.buf - if L.inDirective: - tok.xkind = pxNewLine - L.inDirective = false - else: - break # EndOfFile also leaves the loop - L.bufpos = pos - -proc getDirective(L: var TLexer, tok: var TToken) = - var pos = L.bufpos + 1 - var buf = L.buf - while buf[pos] in {' ', '\t'}: inc(pos) - while buf[pos] in SymChars: - add(tok.s, buf[pos]) - inc(pos) - # a HACK: we need to distinguish - # #define x (...) - # from: - # #define x(...) - # - L.bufpos = pos - # look ahead: - while buf[pos] in {' ', '\t'}: inc(pos) - while buf[pos] in SymChars: inc(pos) - if buf[pos] == '(': tok.xkind = pxDirectiveParLe - else: tok.xkind = pxDirective - L.inDirective = true - -proc getTok(L: var TLexer, tok: var TToken) = - tok.xkind = pxInvalid - fillToken(tok) - skip(L, tok) - if tok.xkind == pxNewLine: return - var c = L.buf[L.bufpos] - if c in SymStartChars: - getSymbol(L, tok) - elif c == '0': - case L.buf[L.bufpos+1] - of 'x', 'X': getNumber16(L, tok) - of 'b', 'B': getNumber2(L, tok) - of '1'..'7': getNumber8(L, tok) - else: getNumber(L, tok) - elif c in {'1'..'9'}: - getNumber(L, tok) - else: - case c - of ';': - tok.xkind = pxSemicolon - Inc(L.bufpos) - of '/': - if L.buf[L.bufpos + 1] == '/': - scanLineComment(L, tok) - elif L.buf[L.bufpos+1] == '*': - inc(L.bufpos, 2) - scanStarComment(L, tok) - elif L.buf[L.bufpos+1] == '=': - inc(L.bufpos, 2) - tok.xkind = pxSlashAsgn - else: - tok.xkind = pxSlash - inc(L.bufpos) - of ',': - tok.xkind = pxComma - Inc(L.bufpos) - of '(': - Inc(L.bufpos) - tok.xkind = pxParLe - of '*': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxStarAsgn - else: - tok.xkind = pxStar - of ')': - Inc(L.bufpos) - tok.xkind = pxParRi - of '[': - Inc(L.bufpos) - tok.xkind = pxBracketLe - of ']': - Inc(L.bufpos) - tok.xkind = pxBracketRi - of '.': - inc(L.bufpos) - if L.buf[L.bufpos] == '.' and L.buf[L.bufpos+1] == '.': - tok.xkind = pxDotDotDot - inc(L.bufpos, 2) - else: - tok.xkind = pxDot - of '{': - Inc(L.bufpos) - tok.xkind = pxCurlyLe - of '}': - Inc(L.bufpos) - tok.xkind = pxCurlyRi - of '+': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - tok.xkind = pxPlusAsgn - inc(L.bufpos) - elif L.buf[L.bufpos] == '+': - tok.xkind = pxPlusPlus - inc(L.bufpos) - else: - tok.xkind = pxPlus - of '-': - inc(L.bufpos) - case L.buf[L.bufpos] - of '>': - tok.xkind = pxArrow - inc(L.bufpos) - of '=': - tok.xkind = pxMinusAsgn - inc(L.bufpos) - of '-': - tok.xkind = pxMinusMinus - inc(L.bufpos) - else: - tok.xkind = pxMinus - of '?': - inc(L.bufpos) - tok.xkind = pxConditional - of ':': - inc(L.bufpos) - if L.buf[L.bufpos] == ':': - tok.xkind = pxScope - inc(L.bufpos) - else: - tok.xkind = pxColon - of '!': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - tok.xkind = pxNeq - inc(L.bufpos) - else: - tok.xkind = pxNot - of '<': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxLe - elif L.buf[L.bufpos] == '<': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxShlAsgn - else: - tok.xkind = pxShl - else: - tok.xkind = pxLt - of '>': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxGe - elif L.buf[L.bufpos] == '>': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxShrAsgn - else: - tok.xkind = pxShr - else: - tok.xkind = pxGt - of '=': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - tok.xkind = pxEquals - inc(L.bufpos) - else: - tok.xkind = pxAsgn - of '&': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - tok.xkind = pxAmpAsgn - inc(L.bufpos) - elif L.buf[L.bufpos] == '&': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxAmpAmpAsgn - else: - tok.xkind = pxAmpAmp - else: - tok.xkind = pxAmp - of '|': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - tok.xkind = pxBarAsgn - inc(L.bufpos) - elif L.buf[L.bufpos] == '|': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxBarBarAsgn - else: - tok.xkind = pxBarBar - else: - tok.xkind = pxBar - of '^': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - tok.xkind = pxHatAsgn - inc(L.bufpos) - else: - tok.xkind = pxHat - of '%': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - tok.xkind = pxModAsgn - inc(L.bufpos) - else: - tok.xkind = pxMod - of '~': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - tok.xkind = pxTildeAsgn - inc(L.bufpos) - else: - tok.xkind = pxTilde - of '#': - if L.buf[L.bufpos+1] == '#': - inc(L.bufpos, 2) - tok.xkind = pxDirConc - else: - getDirective(L, tok) - of '"': getString(L, tok) - of '\'': getCharLit(L, tok) - of nimlexbase.EndOfFile: - tok.xkind = pxEof - else: - tok.s = $c - tok.xkind = pxInvalid - lexMessage(L, errInvalidToken, c & " (\\" & $(ord(c)) & ')') - Inc(L.bufpos) diff --git a/compiler/c2nim/cparse.nim b/compiler/c2nim/cparse.nim deleted file mode 100644 index b964ed976..000000000 --- a/compiler/c2nim/cparse.nim +++ /dev/null @@ -1,1712 +0,0 @@ -# -# -# c2nim - C to Nimrod source converter -# (c) Copyright 2012 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements an Ansi C parser. -## It translates a C source file into a Nimrod AST. Then the renderer can be -## used to convert the AST to its text representation. - -# XXX cleanup of declaration handling. - -import - os, llstream, renderer, clex, idents, strutils, pegs, ast, astalgo, msgs, - options, strtabs - -type - TParserFlag = enum - pfRefs, ## use "ref" instead of "ptr" for C's typ* - pfCDecl, ## annotate procs with cdecl - pfStdCall, ## annotate procs with stdcall - pfSkipInclude, ## skip all ``#include`` - pfTypePrefixes, ## all generated types start with 'T' or 'P' - pfSkipComments ## do not generate comments - - TMacro {.final.} = object - name: string - params: int # number of parameters - body: seq[ref TToken] # can contain pxMacroParam tokens - - TParserOptions {.final.} = object - flags: set[TParserFlag] - prefixes, suffixes: seq[string] - mangleRules: seq[tuple[pattern: TPeg, frmt: string]] - privateRules: seq[TPeg] - dynlibSym, header: string - macros: seq[TMacro] - toMangle: PStringTable - PParserOptions* = ref TParserOptions - - TParser* {.final.} = object - lex: TLexer - tok: ref TToken # current token - options: PParserOptions - backtrack: seq[ref TToken] - inTypeDef: int - scopeCounter: int - hasDeadCodeElimPragma: bool - - TReplaceTuple* = array[0..1, string] - -proc newParserOptions*(): PParserOptions = - new(result) - result.prefixes = @[] - result.suffixes = @[] - result.macros = @[] - result.mangleRules = @[] - result.privateRules = @[] - result.flags = {} - result.dynlibSym = "" - result.header = "" - result.toMangle = newStringTable(modeCaseSensitive) - -proc setOption*(parserOptions: PParserOptions, key: string, val=""): bool = - result = true - case key - of "ref": incl(parserOptions.flags, pfRefs) - of "dynlib": parserOptions.dynlibSym = val - of "header": parserOptions.header = val - of "cdecl": incl(parserOptions.flags, pfCdecl) - of "stdcall": incl(parserOptions.flags, pfStdCall) - of "prefix": parserOptions.prefixes.add(val) - of "suffix": parserOptions.suffixes.add(val) - of "skipinclude": incl(parserOptions.flags, pfSkipInclude) - of "typeprefixes": incl(parserOptions.flags, pfTypePrefixes) - of "skipcomments": incl(parserOptions.flags, pfSkipComments) - else: result = false - -proc ParseUnit*(p: var TParser): PNode -proc openParser*(p: var TParser, filename: string, inputStream: PLLStream, - options = newParserOptions()) -proc closeParser*(p: var TParser) - -# implementation - -proc OpenParser(p: var TParser, filename: string, - inputStream: PLLStream, options = newParserOptions()) = - OpenLexer(p.lex, filename, inputStream) - p.options = options - p.backtrack = @[] - new(p.tok) - -proc parMessage(p: TParser, msg: TMsgKind, arg = "") = - lexMessage(p.lex, msg, arg) - -proc CloseParser(p: var TParser) = CloseLexer(p.lex) -proc saveContext(p: var TParser) = p.backtrack.add(p.tok) -proc closeContext(p: var TParser) = discard p.backtrack.pop() -proc backtrackContext(p: var TParser) = p.tok = p.backtrack.pop() - -proc rawGetTok(p: var TParser) = - if p.tok.next != nil: - p.tok = p.tok.next - elif p.backtrack.len == 0: - p.tok.next = nil - getTok(p.lex, p.tok[]) - else: - # We need the next token and must be able to backtrack. So we need to - # allocate a new token. - var t: ref TToken - new(t) - getTok(p.lex, t[]) - p.tok.next = t - p.tok = t - -proc findMacro(p: TParser): int = - for i in 0..high(p.options.macros): - if p.tok.s == p.options.macros[i].name: return i - return -1 - -proc rawEat(p: var TParser, xkind: TTokKind) = - if p.tok.xkind == xkind: rawGetTok(p) - else: parMessage(p, errTokenExpected, TokKindToStr(xkind)) - -proc parseMacroArguments(p: var TParser): seq[seq[ref TToken]] = - result = @[] - result.add(@[]) - var i: array[pxParLe..pxCurlyLe, int] - var L = 0 - saveContext(p) - while true: - var kind = p.tok.xkind - case kind - of pxEof: rawEat(p, pxParRi) - of pxParLe, pxBracketLe, pxCurlyLe: - inc(i[kind]) - result[L].add(p.tok) - of pxParRi: - # end of arguments? - if i[pxParLe] == 0 and i[pxBracketLe] == 0 and i[pxCurlyLe] == 0: break - if i[pxParLe] > 0: dec(i[pxParLe]) - result[L].add(p.tok) - of pxBracketRi, pxCurlyRi: - kind = pred(kind, 3) - if i[kind] > 0: dec(i[kind]) - result[L].add(p.tok) - of pxComma: - if i[pxParLe] == 0 and i[pxBracketLe] == 0 and i[pxCurlyLe] == 0: - # next argument: comma is not part of the argument - result.add(@[]) - inc(L) - else: - # comma does not separate different arguments: - result[L].add(p.tok) - else: - result[L].add(p.tok) - rawGetTok(p) - closeContext(p) - -proc expandMacro(p: var TParser, m: TMacro) = - rawGetTok(p) # skip macro name - var arguments: seq[seq[ref TToken]] - if m.params > 0: - rawEat(p, pxParLe) - arguments = parseMacroArguments(p) - if arguments.len != m.params: parMessage(p, errWrongNumberOfArguments) - rawEat(p, pxParRi) - # insert into the token list: - if m.body.len > 0: - var newList: ref TToken - new(newList) - var lastTok = newList - for tok in items(m.body): - if tok.xkind == pxMacroParam: - for t in items(arguments[int(tok.iNumber)]): - #echo "t: ", t^ - lastTok.next = t - lastTok = t - else: - #echo "tok: ", tok^ - lastTok.next = tok - lastTok = tok - lastTok.next = p.tok - p.tok = newList.next - -proc getTok(p: var TParser) = - rawGetTok(p) - if p.tok.xkind == pxSymbol: - var idx = findMacro(p) - if idx >= 0: - expandMacro(p, p.options.macros[idx]) - -proc parLineInfo(p: TParser): TLineInfo = - result = getLineInfo(p.lex) - -proc skipComAux(p: var TParser, n: PNode) = - if n != nil and n.kind != nkEmpty: - if pfSkipComments notin p.options.flags: - if n.comment == nil: n.comment = p.tok.s - else: add(n.comment, "\n" & p.tok.s) - else: - parMessage(p, warnCommentXIgnored, p.tok.s) - getTok(p) - -proc skipCom(p: var TParser, n: PNode) = - while p.tok.xkind in {pxLineComment, pxStarComment}: skipcomAux(p, n) - -proc skipStarCom(p: var TParser, n: PNode) = - while p.tok.xkind == pxStarComment: skipComAux(p, n) - -proc getTok(p: var TParser, n: PNode) = - getTok(p) - skipCom(p, n) - -proc ExpectIdent(p: TParser) = - if p.tok.xkind != pxSymbol: parMessage(p, errIdentifierExpected, $(p.tok[])) - -proc Eat(p: var TParser, xkind: TTokKind, n: PNode) = - if p.tok.xkind == xkind: getTok(p, n) - else: parMessage(p, errTokenExpected, TokKindToStr(xkind)) - -proc Eat(p: var TParser, xkind: TTokKind) = - if p.tok.xkind == xkind: getTok(p) - else: parMessage(p, errTokenExpected, TokKindToStr(xkind)) - -proc Eat(p: var TParser, tok: string, n: PNode) = - if p.tok.s == tok: getTok(p, n) - else: parMessage(p, errTokenExpected, tok) - -proc Opt(p: var TParser, xkind: TTokKind, n: PNode) = - if p.tok.xkind == xkind: getTok(p, n) - -proc addSon(father, a, b: PNode) = - addSon(father, a) - addSon(father, b) - -proc addSon(father, a, b, c: PNode) = - addSon(father, a) - addSon(father, b) - addSon(father, c) - -proc newNodeP(kind: TNodeKind, p: TParser): PNode = - result = newNodeI(kind, getLineInfo(p.lex)) - -proc newIntNodeP(kind: TNodeKind, intVal: BiggestInt, p: TParser): PNode = - result = newNodeP(kind, p) - result.intVal = intVal - -proc newFloatNodeP(kind: TNodeKind, floatVal: BiggestFloat, - p: TParser): PNode = - result = newNodeP(kind, p) - result.floatVal = floatVal - -proc newStrNodeP(kind: TNodeKind, strVal: string, p: TParser): PNode = - result = newNodeP(kind, p) - result.strVal = strVal - -proc newIdentNodeP(ident: PIdent, p: TParser): PNode = - result = newNodeP(nkIdent, p) - result.ident = ident - -proc newIdentNodeP(ident: string, p: TParser): PNode = - result = newIdentNodeP(getIdent(ident), p) - -proc mangleRules(s: string, p: TParser): string = - block mangle: - for pattern, frmt in items(p.options.mangleRules): - if s.match(pattern): - result = s.replacef(pattern, frmt) - break mangle - block prefixes: - for prefix in items(p.options.prefixes): - if s.startsWith(prefix): - result = s.substr(prefix.len) - break prefixes - result = s - block suffixes: - for suffix in items(p.options.suffixes): - if result.endsWith(suffix): - setLen(result, result.len - suffix.len) - break suffixes - -proc mangleName(s: string, p: TParser): string = - if p.options.toMangle.hasKey(s): result = p.options.toMangle[s] - else: result = mangleRules(s, p) - -proc isPrivate(s: string, p: TParser): bool = - for pattern in items(p.options.privateRules): - if s.match(pattern): return true - -proc mangledIdent(ident: string, p: TParser): PNode = - result = newNodeP(nkIdent, p) - result.ident = getIdent(mangleName(ident, p)) - -proc newIdentPair(a, b: string, p: TParser): PNode = - result = newNodeP(nkExprColonExpr, p) - addSon(result, newIdentNodeP(a, p)) - addSon(result, newIdentNodeP(b, p)) - -proc newIdentStrLitPair(a, b: string, p: TParser): PNode = - result = newNodeP(nkExprColonExpr, p) - addSon(result, newIdentNodeP(a, p)) - addSon(result, newStrNodeP(nkStrLit, b, p)) - -proc addImportToPragma(pragmas: PNode, ident: string, p: TParser) = - addSon(pragmas, newIdentStrLitPair("importc", ident, p)) - if p.options.dynlibSym.len > 0: - addSon(pragmas, newIdentPair("dynlib", p.options.dynlibSym, p)) - else: - addSon(pragmas, newIdentStrLitPair("header", p.options.header, p)) - -proc exportSym(p: TParser, i: PNode, origName: string): PNode = - assert i.kind == nkIdent - if p.scopeCounter == 0 and not isPrivate(origName, p): - result = newNodeI(nkPostfix, i.info) - addSon(result, newIdentNode(getIdent("*"), i.info), i) - else: - result = i - -proc varIdent(ident: string, p: TParser): PNode = - result = exportSym(p, mangledIdent(ident, p), ident) - if p.scopeCounter > 0: return - if p.options.dynlibSym.len > 0 or p.options.header.len > 0: - var a = result - result = newNodeP(nkPragmaExpr, p) - var pragmas = newNodeP(nkPragma, p) - addSon(result, a) - addSon(result, pragmas) - addImportToPragma(pragmas, ident, p) - -proc fieldIdent(ident: string, p: TParser): PNode = - result = exportSym(p, mangledIdent(ident, p), ident) - if p.scopeCounter > 0: return - if p.options.header.len > 0: - var a = result - result = newNodeP(nkPragmaExpr, p) - var pragmas = newNodeP(nkPragma, p) - addSon(result, a) - addSon(result, pragmas) - addSon(pragmas, newIdentStrLitPair("importc", ident, p)) - -proc DoImport(ident: string, pragmas: PNode, p: TParser) = - if p.options.dynlibSym.len > 0 or p.options.header.len > 0: - addImportToPragma(pragmas, ident, p) - -proc newBinary(opr: string, a, b: PNode, p: TParser): PNode = - result = newNodeP(nkInfix, p) - addSon(result, newIdentNodeP(getIdent(opr), p)) - addSon(result, a) - addSon(result, b) - -proc skipIdent(p: var TParser): PNode = - expectIdent(p) - result = mangledIdent(p.tok.s, p) - getTok(p, result) - -proc skipIdentExport(p: var TParser): PNode = - expectIdent(p) - result = exportSym(p, mangledIdent(p.tok.s, p), p.tok.s) - getTok(p, result) - -proc skipTypeIdentExport(p: var TParser, prefix='T'): PNode = - expectIdent(p) - var n = prefix & mangleName(p.tok.s, p) - p.options.toMangle[p.tok.s] = n - var i = newNodeP(nkIdent, p) - i.ident = getIdent(n) - result = exportSym(p, i, p.tok.s) - getTok(p, result) - -proc markTypeIdent(p: var TParser, typ: PNode) = - if pfTypePrefixes in p.options.flags: - var prefix = "" - if typ == nil or typ.kind == nkEmpty: - prefix = "T" - else: - var t = typ - while t != nil and t.kind in {nkVarTy, nkPtrTy, nkRefTy}: - prefix.add('P') - t = t.sons[0] - if prefix.len == 0: prefix.add('T') - expectIdent(p) - p.options.toMangle[p.tok.s] = prefix & mangleRules(p.tok.s, p) - -# --------------- parser ----------------------------------------------------- -# We use this parsing rule: If it looks like a declaration, it is one. This -# avoids to build a symbol table, which can't be done reliably anyway for our -# purposes. - -proc expression(p: var TParser): PNode -proc constantExpression(p: var TParser): PNode -proc assignmentExpression(p: var TParser): PNode -proc compoundStatement(p: var TParser): PNode -proc statement(p: var TParser): PNode - -proc declKeyword(s: string): bool = - # returns true if it is a keyword that introduces a declaration - case s - of "extern", "static", "auto", "register", "const", "volatile", "restrict", - "inline", "__inline", "__cdecl", "__stdcall", "__syscall", "__fastcall", - "__safecall", "void", "struct", "union", "enum", "typedef", - "short", "int", "long", "float", "double", "signed", "unsigned", "char": - result = true - -proc stmtKeyword(s: string): bool = - case s - of "if", "for", "while", "do", "switch", "break", "continue", "return", - "goto": - result = true - -# ------------------- type desc ----------------------------------------------- - -proc isIntType(s: string): bool = - case s - of "short", "int", "long", "float", "double", "signed", "unsigned": - result = true - -proc skipConst(p: var TParser) = - while p.tok.xkind == pxSymbol and - (p.tok.s == "const" or p.tok.s == "volatile" or p.tok.s == "restrict"): - getTok(p, nil) - -proc typeAtom(p: var TParser): PNode = - skipConst(p) - ExpectIdent(p) - case p.tok.s - of "void": - result = newNodeP(nkNilLit, p) # little hack - getTok(p, nil) - of "struct", "union", "enum": - getTok(p, nil) - result = skipIdent(p) - elif isIntType(p.tok.s): - var x = "" - #getTok(p, nil) - var isUnsigned = false - while p.tok.xkind == pxSymbol and (isIntType(p.tok.s) or p.tok.s == "char"): - if p.tok.s == "unsigned": - isUnsigned = true - elif p.tok.s == "signed" or p.tok.s == "int": - nil - else: - add(x, p.tok.s) - getTok(p, nil) - if x.len == 0: x = "int" - let xx = if isUnsigned: "cu" & x else: "c" & x - result = mangledIdent(xx, p) - else: - result = mangledIdent(p.tok.s, p) - getTok(p, result) - -proc newPointerTy(p: TParser, typ: PNode): PNode = - if pfRefs in p.options.flags: - result = newNodeP(nkRefTy, p) - else: - result = newNodeP(nkPtrTy, p) - result.addSon(typ) - -proc pointer(p: var TParser, a: PNode): PNode = - result = a - var i = 0 - skipConst(p) - while p.tok.xkind == pxStar: - inc(i) - getTok(p, result) - skipConst(p) - result = newPointerTy(p, result) - if a.kind == nkIdent and a.ident.s == "char": - if i >= 2: - result = newIdentNodeP("cstringArray", p) - for j in 1..i-2: result = newPointerTy(p, result) - elif i == 1: result = newIdentNodeP("cstring", p) - elif a.kind == nkNilLit and i > 0: - result = newIdentNodeP("pointer", p) - for j in 1..i-1: result = newPointerTy(p, result) - -proc newProcPragmas(p: TParser): PNode = - result = newNodeP(nkPragma, p) - if pfCDecl in p.options.flags: - addSon(result, newIdentNodeP("cdecl", p)) - elif pfStdCall in p.options.flags: - addSon(result, newIdentNodeP("stdcall", p)) - -proc addPragmas(father, pragmas: PNode) = - if sonsLen(pragmas) > 0: addSon(father, pragmas) - else: addSon(father, ast.emptyNode) - -proc addReturnType(params, rettyp: PNode) = - if rettyp == nil: addSon(params, ast.emptyNode) - elif rettyp.kind != nkNilLit: addSon(params, rettyp) - else: addson(params, ast.emptyNode) - -proc parseFormalParams(p: var TParser, params, pragmas: PNode) - -proc parseTypeSuffix(p: var TParser, typ: PNode): PNode = - result = typ - while true: - case p.tok.xkind - of pxBracketLe: - getTok(p, result) - skipConst(p) # POSIX contains: ``int [restrict]`` - if p.tok.xkind != pxBracketRi: - var tmp = result - var index = expression(p) - # array type: - result = newNodeP(nkBracketExpr, p) - addSon(result, newIdentNodeP("array", p)) - var r = newNodeP(nkRange, p) - addSon(r, newIntNodeP(nkIntLit, 0, p)) - addSon(r, newBinary("-", index, newIntNodeP(nkIntLit, 1, p), p)) - addSon(result, r) - addSon(result, tmp) - else: - # pointer type: - var tmp = result - if pfRefs in p.options.flags: - result = newNodeP(nkRefTy, p) - else: - result = newNodeP(nkPtrTy, p) - result.addSon(tmp) - eat(p, pxBracketRi, result) - of pxParLe: - # function pointer: - var procType = newNodeP(nkProcTy, p) - var pragmas = newProcPragmas(p) - var params = newNodeP(nkFormalParams, p) - addReturnType(params, result) - parseFormalParams(p, params, pragmas) - addSon(procType, params) - addPragmas(procType, pragmas) - result = procType - else: break - -proc typeDesc(p: var TParser): PNode = - result = pointer(p, typeAtom(p)) - -proc parseField(p: var TParser, kind: TNodeKind): PNode = - if p.tok.xkind == pxParLe: - getTok(p, nil) - while p.tok.xkind == pxStar: getTok(p, nil) - result = parseField(p, kind) - eat(p, pxParRi, result) - else: - expectIdent(p) - if kind == nkRecList: result = fieldIdent(p.tok.s, p) - else: result = mangledIdent(p.tok.s, p) - getTok(p, result) - -proc takeOnlyFirstField(p: TParser, isUnion: bool): bool = - # if we generate an interface to a header file, *all* fields can be - # generated: - result = isUnion and p.options.header.len == 0 - -proc parseStructBody(p: var TParser, isUnion: bool, - kind: TNodeKind = nkRecList): PNode = - result = newNodeP(kind, p) - eat(p, pxCurlyLe, result) - while p.tok.xkind notin {pxEof, pxCurlyRi}: - var baseTyp = typeAtom(p) - while true: - var def = newNodeP(nkIdentDefs, p) - var t = pointer(p, baseTyp) - var i = parseField(p, kind) - t = parseTypeSuffix(p, t) - addSon(def, i, t, ast.emptyNode) - if not takeOnlyFirstField(p, isUnion) or sonsLen(result) < 1: - addSon(result, def) - if p.tok.xkind != pxComma: break - getTok(p, def) - eat(p, pxSemicolon, lastSon(result)) - eat(p, pxCurlyRi, result) - -proc structPragmas(p: TParser, name: PNode, origName: string): PNode = - assert name.kind == nkIdent - result = newNodeP(nkPragmaExpr, p) - addson(result, exportSym(p, name, origName)) - var pragmas = newNodep(nkPragma, p) - addSon(pragmas, newIdentNodeP("pure", p), newIdentNodeP("final", p)) - if p.options.header.len > 0: - addSon(pragmas, newIdentStrLitPair("importc", origName, p), - newIdentStrLitPair("header", p.options.header, p)) - addSon(result, pragmas) - -proc enumPragmas(p: TParser, name: PNode): PNode = - result = newNodeP(nkPragmaExpr, p) - addson(result, name) - var pragmas = newNodep(nkPragma, p) - var e = newNodeP(nkExprColonExpr, p) - # HACK: sizeof(cint) should be constructed as AST - addSon(e, newIdentNodeP("size", p), newIdentNodeP("sizeof(cint)", p)) - addSon(pragmas, e) - addSon(result, pragmas) - -proc parseStruct(p: var TParser, isUnion: bool): PNode = - result = newNodeP(nkObjectTy, p) - addSon(result, ast.emptyNode, ast.emptyNode) # no pragmas, no inheritance - if p.tok.xkind == pxCurlyLe: - addSon(result, parseStructBody(p, isUnion)) - else: - addSon(result, newNodeP(nkRecList, p)) - -proc parseParam(p: var TParser, params: PNode) = - var typ = typeDesc(p) - # support for ``(void)`` parameter list: - if typ.kind == nkNilLit and p.tok.xkind == pxParRi: return - var name: PNode - if p.tok.xkind == pxSymbol: - name = skipIdent(p) - else: - # generate a name for the formal parameter: - var idx = sonsLen(params)+1 - name = newIdentNodeP("a" & $idx, p) - typ = parseTypeSuffix(p, typ) - var x = newNodeP(nkIdentDefs, p) - addSon(x, name, typ) - if p.tok.xkind == pxAsgn: - # we support default parameters for C++: - getTok(p, x) - addSon(x, assignmentExpression(p)) - else: - addSon(x, ast.emptyNode) - addSon(params, x) - -proc parseFormalParams(p: var TParser, params, pragmas: PNode) = - eat(p, pxParLe, params) - while p.tok.xkind notin {pxEof, pxParRi}: - if p.tok.xkind == pxDotDotDot: - addSon(pragmas, newIdentNodeP("varargs", p)) - getTok(p, pragmas) - break - parseParam(p, params) - if p.tok.xkind != pxComma: break - getTok(p, params) - eat(p, pxParRi, params) - -proc parseCallConv(p: var TParser, pragmas: PNode) = - while p.tok.xkind == pxSymbol: - case p.tok.s - of "inline", "__inline": addSon(pragmas, newIdentNodeP("inline", p)) - of "__cdecl": addSon(pragmas, newIdentNodeP("cdecl", p)) - of "__stdcall": addSon(pragmas, newIdentNodeP("stdcall", p)) - of "__syscall": addSon(pragmas, newIdentNodeP("syscall", p)) - of "__fastcall": addSon(pragmas, newIdentNodeP("fastcall", p)) - of "__safecall": addSon(pragmas, newIdentNodeP("safecall", p)) - else: break - getTok(p, nil) - -proc parseFunctionPointerDecl(p: var TParser, rettyp: PNode): PNode = - var procType = newNodeP(nkProcTy, p) - var pragmas = newProcPragmas(p) - var params = newNodeP(nkFormalParams, p) - eat(p, pxParLe, params) - addReturnType(params, rettyp) - parseCallConv(p, pragmas) - if p.tok.xkind == pxStar: getTok(p, params) - else: parMessage(p, errTokenExpected, "*") - if p.inTypeDef > 0: markTypeIdent(p, nil) - var name = skipIdentExport(p) - eat(p, pxParRi, name) - parseFormalParams(p, params, pragmas) - addSon(procType, params) - addPragmas(procType, pragmas) - - if p.inTypeDef == 0: - result = newNodeP(nkVarSection, p) - var def = newNodeP(nkIdentDefs, p) - addSon(def, name, procType, ast.emptyNode) - addSon(result, def) - else: - result = newNodeP(nkTypeDef, p) - addSon(result, name, ast.emptyNode, procType) - assert result != nil - -proc addTypeDef(section, name, t: PNode) = - var def = newNodeI(nkTypeDef, name.info) - addSon(def, name, ast.emptyNode, t) - addSon(section, def) - -proc otherTypeDef(p: var TParser, section, typ: PNode) = - var name: PNode - var t = typ - if p.tok.xkind == pxStar: - t = pointer(p, t) - if p.tok.xkind == pxParLe: - # function pointer: typedef typ (*name)(); - var x = parseFunctionPointerDecl(p, t) - name = x[0] - t = x[2] - else: - # typedef typ name; - markTypeIdent(p, t) - name = skipIdentExport(p) - t = parseTypeSuffix(p, t) - addTypeDef(section, name, t) - -proc parseTrailingDefinedTypes(p: var TParser, section, typ: PNode) = - while p.tok.xkind == pxComma: - getTok(p, nil) - var newTyp = pointer(p, typ) - markTypeIdent(p, newTyp) - var newName = skipIdentExport(p) - newTyp = parseTypeSuffix(p, newTyp) - addTypeDef(section, newName, newTyp) - -proc enumFields(p: var TParser): PNode = - result = newNodeP(nkEnumTy, p) - addSon(result, ast.emptyNode) # enum does not inherit from anything - while true: - var e = skipIdent(p) - if p.tok.xkind == pxAsgn: - getTok(p, e) - var c = constantExpression(p) - var a = e - e = newNodeP(nkEnumFieldDef, p) - addSon(e, a, c) - skipCom(p, e) - - addSon(result, e) - if p.tok.xkind != pxComma: break - getTok(p, e) - # allow trailing comma: - if p.tok.xkind == pxCurlyRi: break - -proc parseTypedefStruct(p: var TParser, result: PNode, isUnion: bool) = - getTok(p, result) - if p.tok.xkind == pxCurlyLe: - var t = parseStruct(p, isUnion) - var origName = p.tok.s - markTypeIdent(p, nil) - var name = skipIdent(p) - addTypeDef(result, structPragmas(p, name, origName), t) - parseTrailingDefinedTypes(p, result, name) - elif p.tok.xkind == pxSymbol: - # name to be defined or type "struct a", we don't know yet: - markTypeIdent(p, nil) - var origName = p.tok.s - var nameOrType = skipIdent(p) - case p.tok.xkind - of pxCurlyLe: - var t = parseStruct(p, isUnion) - if p.tok.xkind == pxSymbol: - # typedef struct tagABC {} abc, *pabc; - # --> abc is a better type name than tagABC! - markTypeIdent(p, nil) - var origName = p.tok.s - var name = skipIdent(p) - addTypeDef(result, structPragmas(p, name, origName), t) - parseTrailingDefinedTypes(p, result, name) - else: - addTypeDef(result, structPragmas(p, nameOrType, origName), t) - of pxSymbol: - # typedef struct a a? - if mangleName(p.tok.s, p) == nameOrType.ident.s: - # ignore the declaration: - getTok(p, nil) - else: - # typedef struct a b; or typedef struct a b[45]; - otherTypeDef(p, result, nameOrType) - else: - otherTypeDef(p, result, nameOrType) - else: - expectIdent(p) - -proc parseTypedefEnum(p: var TParser, result: PNode) = - getTok(p, result) - if p.tok.xkind == pxCurlyLe: - getTok(p, result) - var t = enumFields(p) - eat(p, pxCurlyRi, t) - var origName = p.tok.s - markTypeIdent(p, nil) - var name = skipIdent(p) - addTypeDef(result, enumPragmas(p, exportSym(p, name, origName)), t) - parseTrailingDefinedTypes(p, result, name) - elif p.tok.xkind == pxSymbol: - # name to be defined or type "enum a", we don't know yet: - markTypeIdent(p, nil) - var origName = p.tok.s - var nameOrType = skipIdent(p) - case p.tok.xkind - of pxCurlyLe: - getTok(p, result) - var t = enumFields(p) - eat(p, pxCurlyRi, t) - if p.tok.xkind == pxSymbol: - # typedef enum tagABC {} abc, *pabc; - # --> abc is a better type name than tagABC! - markTypeIdent(p, nil) - var origName = p.tok.s - var name = skipIdent(p) - addTypeDef(result, enumPragmas(p, exportSym(p, name, origName)), t) - parseTrailingDefinedTypes(p, result, name) - else: - addTypeDef(result, - enumPragmas(p, exportSym(p, nameOrType, origName)), t) - of pxSymbol: - # typedef enum a a? - if mangleName(p.tok.s, p) == nameOrType.ident.s: - # ignore the declaration: - getTok(p, nil) - else: - # typedef enum a b; or typedef enum a b[45]; - otherTypeDef(p, result, nameOrType) - else: - otherTypeDef(p, result, nameOrType) - else: - expectIdent(p) - -proc parseTypeDef(p: var TParser): PNode = - result = newNodeP(nkTypeSection, p) - while p.tok.xkind == pxSymbol and p.tok.s == "typedef": - getTok(p, result) - inc(p.inTypeDef) - expectIdent(p) - case p.tok.s - of "struct": parseTypedefStruct(p, result, isUnion=false) - of "union": parseTypedefStruct(p, result, isUnion=true) - of "enum": parseTypedefEnum(p, result) - else: - var t = typeAtom(p) - otherTypeDef(p, result, t) - eat(p, pxSemicolon) - dec(p.inTypeDef) - -proc skipDeclarationSpecifiers(p: var TParser) = - while p.tok.xkind == pxSymbol: - case p.tok.s - of "extern", "static", "auto", "register", "const", "volatile": - getTok(p, nil) - else: break - -proc parseInitializer(p: var TParser): PNode = - if p.tok.xkind == pxCurlyLe: - result = newNodeP(nkBracket, p) - getTok(p, result) - while p.tok.xkind notin {pxEof, pxCurlyRi}: - addSon(result, parseInitializer(p)) - opt(p, pxComma, nil) - eat(p, pxCurlyRi, result) - else: - result = assignmentExpression(p) - -proc addInitializer(p: var TParser, def: PNode) = - if p.tok.xkind == pxAsgn: - getTok(p, def) - addSon(def, parseInitializer(p)) - else: - addSon(def, ast.emptyNode) - -proc parseVarDecl(p: var TParser, baseTyp, typ: PNode, - origName: string): PNode = - result = newNodeP(nkVarSection, p) - var def = newNodeP(nkIdentDefs, p) - addSon(def, varIdent(origName, p)) - addSon(def, parseTypeSuffix(p, typ)) - addInitializer(p, def) - addSon(result, def) - - while p.tok.xkind == pxComma: - getTok(p, def) - var t = pointer(p, baseTyp) - expectIdent(p) - def = newNodeP(nkIdentDefs, p) - addSon(def, varIdent(p.tok.s, p)) - getTok(p, def) - addSon(def, parseTypeSuffix(p, t)) - addInitializer(p, def) - addSon(result, def) - eat(p, pxSemicolon) - -when false: - proc declaration(p: var TParser, father: PNode) = - # general syntax to parse is:: - # - # baseType ::= typeIdent | ((struct|union|enum) ident ("{" body "}" )? - # | "{" body "}") - # declIdent ::= "(" "*" ident ")" formalParams ("=" exprNoComma)? - # | ident ((formalParams ("{" statements "}")?)|"=" - # exprNoComma|(typeSuffix("=" exprNoComma)? ))? - # declaration ::= baseType (pointers)? declIdent ("," declIdent)* - var pragmas = newNodeP(nkPragma, p) - - skipDeclarationSpecifiers(p) - parseCallConv(p, pragmas) - skipDeclarationSpecifiers(p) - expectIdent(p) - -proc declaration(p: var TParser): PNode = - result = newNodeP(nkProcDef, p) - var pragmas = newNodeP(nkPragma, p) - - skipDeclarationSpecifiers(p) - parseCallConv(p, pragmas) - skipDeclarationSpecifiers(p) - expectIdent(p) - var baseTyp = typeAtom(p) - var rettyp = pointer(p, baseTyp) - skipDeclarationSpecifiers(p) - parseCallConv(p, pragmas) - skipDeclarationSpecifiers(p) - - if p.tok.xkind == pxParLe: - # Function pointer declaration: This is of course only a heuristic, but the - # best we can do here. - result = parseFunctionPointerDecl(p, rettyp) - eat(p, pxSemicolon) - return - ExpectIdent(p) - var origName = p.tok.s - getTok(p) # skip identifier - case p.tok.xkind - of pxParLe: - # really a function! - var name = mangledIdent(origName, p) - var params = newNodeP(nkFormalParams, p) - addReturnType(params, rettyp) - parseFormalParams(p, params, pragmas) - - if pfCDecl in p.options.flags: - addSon(pragmas, newIdentNodeP("cdecl", p)) - elif pfStdcall in p.options.flags: - addSon(pragmas, newIdentNodeP("stdcall", p)) - # no pattern, no exceptions: - addSon(result, exportSym(p, name, origName), ast.emptyNode, ast.emptyNode) - addSon(result, params, pragmas, ast.emptyNode) # no exceptions - case p.tok.xkind - of pxSemicolon: - getTok(p) - addSon(result, ast.emptyNode) # nobody - if p.scopeCounter == 0: DoImport(origName, pragmas, p) - of pxCurlyLe: - addSon(result, compoundStatement(p)) - else: - parMessage(p, errTokenExpected, ";") - if sonsLen(result.sons[pragmasPos]) == 0: - result.sons[pragmasPos] = ast.emptyNode - else: - result = parseVarDecl(p, baseTyp, rettyp, origName) - assert result != nil - -proc createConst(name, typ, val: PNode, p: TParser): PNode = - result = newNodeP(nkConstDef, p) - addSon(result, name, typ, val) - -proc enumSpecifier(p: var TParser): PNode = - saveContext(p) - getTok(p, nil) # skip "enum" - case p.tok.xkind - of pxCurlyLe: - closeContext(p) - # make a const section out of it: - result = newNodeP(nkConstSection, p) - getTok(p, result) - var i = 0 - var hasUnknown = false - while true: - var name = skipIdentExport(p) - var val: PNode - if p.tok.xkind == pxAsgn: - getTok(p, name) - val = constantExpression(p) - if val.kind == nkIntLit: - i = int(val.intVal)+1 - hasUnknown = false - else: - hasUnknown = true - else: - if hasUnknown: - parMessage(p, warnUser, "computed const value may be wrong: " & - name.renderTree) - val = newIntNodeP(nkIntLit, i, p) - inc(i) - var c = createConst(name, ast.emptyNode, val, p) - addSon(result, c) - if p.tok.xkind != pxComma: break - getTok(p, c) - # allow trailing comma: - if p.tok.xkind == pxCurlyRi: break - eat(p, pxCurlyRi, result) - eat(p, pxSemicolon) - of pxSymbol: - var origName = p.tok.s - markTypeIdent(p, nil) - result = skipIdent(p) - case p.tok.xkind - of pxCurlyLe: - closeContext(p) - var name = result - # create a type section containing the enum - result = newNodeP(nkTypeSection, p) - var t = newNodeP(nkTypeDef, p) - getTok(p, t) - var e = enumFields(p) - addSon(t, exportSym(p, name, origName), ast.emptyNode, e) - addSon(result, t) - eat(p, pxCurlyRi, result) - eat(p, pxSemicolon) - of pxSemicolon: - # just ignore ``enum X;`` for now. - closeContext(p) - getTok(p, nil) - else: - backtrackContext(p) - result = declaration(p) - else: - closeContext(p) - parMessage(p, errTokenExpected, "{") - result = ast.emptyNode - -# Expressions - -proc setBaseFlags(n: PNode, base: TNumericalBase) = - case base - of base10: nil - of base2: incl(n.flags, nfBase2) - of base8: incl(n.flags, nfBase8) - of base16: incl(n.flags, nfBase16) - -proc unaryExpression(p: var TParser): PNode - -proc isDefinitelyAType(p: var TParser): bool = - var starFound = false - var words = 0 - while true: - case p.tok.xkind - of pxSymbol: - if declKeyword(p.tok.s): return true - elif starFound: return false - else: inc(words) - of pxStar: - starFound = true - of pxParRi: return words == 0 or words > 1 or starFound - else: return false - getTok(p, nil) - -proc castExpression(p: var TParser): PNode = - if p.tok.xkind == pxParLe: - saveContext(p) - result = newNodeP(nkCast, p) - getTok(p, result) - var t = isDefinitelyAType(p) - backtrackContext(p) - if t: - eat(p, pxParLe, result) - var a = typeDesc(p) - eat(p, pxParRi, result) - addSon(result, a) - addSon(result, castExpression(p)) - else: - # else it is just an expression in (): - result = newNodeP(nkPar, p) - eat(p, pxParLe, result) - addSon(result, expression(p)) - if p.tok.xkind != pxParRi: - # ugh, it is a cast, even though it does not look like one: - result.kind = nkCast - addSon(result, castExpression(p)) - eat(p, pxParRi, result) - #result = unaryExpression(p) - else: - result = unaryExpression(p) - -proc primaryExpression(p: var TParser): PNode = - case p.tok.xkind - of pxSymbol: - if p.tok.s == "NULL": - result = newNodeP(nkNilLit, p) - else: - result = mangledIdent(p.tok.s, p) - getTok(p, result) - of pxIntLit: - result = newIntNodeP(nkIntLit, p.tok.iNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p, result) - of pxInt64Lit: - result = newIntNodeP(nkInt64Lit, p.tok.iNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p, result) - of pxFloatLit: - result = newFloatNodeP(nkFloatLit, p.tok.fNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p, result) - of pxStrLit: - # Ansi C allows implicit string literal concatenations: - result = newStrNodeP(nkStrLit, p.tok.s, p) - getTok(p, result) - while p.tok.xkind == pxStrLit: - add(result.strVal, p.tok.s) - getTok(p, result) - of pxCharLit: - result = newIntNodeP(nkCharLit, ord(p.tok.s[0]), p) - getTok(p, result) - of pxParLe: - result = castExpression(p) - else: - result = ast.emptyNode - -proc multiplicativeExpression(p: var TParser): PNode = - result = castExpression(p) - while true: - case p.tok.xkind - of pxStar: - var a = result - result = newNodeP(nkInfix, p) - addSon(result, newIdentNodeP("*", p), a) - getTok(p, result) - var b = castExpression(p) - addSon(result, b) - of pxSlash: - var a = result - result = newNodeP(nkInfix, p) - addSon(result, newIdentNodeP("div", p), a) - getTok(p, result) - var b = castExpression(p) - addSon(result, b) - of pxMod: - var a = result - result = newNodeP(nkInfix, p) - addSon(result, newIdentNodeP("mod", p), a) - getTok(p, result) - var b = castExpression(p) - addSon(result, b) - else: break - -proc additiveExpression(p: var TParser): PNode = - result = multiplicativeExpression(p) - while true: - case p.tok.xkind - of pxPlus: - var a = result - result = newNodeP(nkInfix, p) - addSon(result, newIdentNodeP("+", p), a) - getTok(p, result) - var b = multiplicativeExpression(p) - addSon(result, b) - of pxMinus: - var a = result - result = newNodeP(nkInfix, p) - addSon(result, newIdentNodeP("-", p), a) - getTok(p, result) - var b = multiplicativeExpression(p) - addSon(result, b) - else: break - -proc incdec(p: var TParser, opr: string): PNode = - result = newNodeP(nkCall, p) - addSon(result, newIdentNodeP(opr, p)) - gettok(p, result) - addSon(result, unaryExpression(p)) - -proc unaryOp(p: var TParser, kind: TNodeKind): PNode = - result = newNodeP(kind, p) - getTok(p, result) - addSon(result, castExpression(p)) - -proc prefixCall(p: var TParser, opr: string): PNode = - result = newNodeP(nkPrefix, p) - addSon(result, newIdentNodeP(opr, p)) - gettok(p, result) - addSon(result, castExpression(p)) - -proc postfixExpression(p: var TParser): PNode = - result = primaryExpression(p) - while true: - case p.tok.xkind - of pxBracketLe: - var a = result - result = newNodeP(nkBracketExpr, p) - addSon(result, a) - getTok(p, result) - var b = expression(p) - addSon(result, b) - eat(p, pxBracketRi, result) - of pxParLe: - var a = result - result = newNodeP(nkCall, p) - addSon(result, a) - getTok(p, result) - if p.tok.xkind != pxParRi: - a = assignmentExpression(p) - addSon(result, a) - while p.tok.xkind == pxComma: - getTok(p, a) - a = assignmentExpression(p) - addSon(result, a) - eat(p, pxParRi, result) - of pxDot, pxArrow: - var a = result - result = newNodeP(nkDotExpr, p) - addSon(result, a) - getTok(p, result) - addSon(result, skipIdent(p)) - of pxPlusPlus: - var a = result - result = newNodeP(nkCall, p) - addSon(result, newIdentNodeP("inc", p)) - gettok(p, result) - addSon(result, a) - of pxMinusMinus: - var a = result - result = newNodeP(nkCall, p) - addSon(result, newIdentNodeP("dec", p)) - gettok(p, result) - addSon(result, a) - else: break - -proc unaryExpression(p: var TParser): PNode = - case p.tok.xkind - of pxPlusPlus: result = incdec(p, "inc") - of pxMinusMinus: result = incdec(p, "dec") - of pxAmp: result = unaryOp(p, nkAddr) - of pxStar: result = unaryOp(p, nkBracketExpr) - of pxPlus: result = prefixCall(p, "+") - of pxMinus: result = prefixCall(p, "-") - of pxTilde: result = prefixCall(p, "not") - of pxNot: result = prefixCall(p, "not") - of pxSymbol: - if p.tok.s == "sizeof": - result = newNodeP(nkCall, p) - addSon(result, newIdentNodeP("sizeof", p)) - getTok(p, result) - if p.tok.xkind == pxParLe: - getTok(p, result) - addson(result, typeDesc(p)) - eat(p, pxParRi, result) - else: - addSon(result, unaryExpression(p)) - else: - result = postfixExpression(p) - else: result = postfixExpression(p) - -proc expression(p: var TParser): PNode = - # we cannot support C's ``,`` operator - result = assignmentExpression(p) - if p.tok.xkind == pxComma: - getTok(p, result) - parMessage(p, errOperatorExpected, ",") - -proc conditionalExpression(p: var TParser): PNode - -proc constantExpression(p: var TParser): PNode = - result = conditionalExpression(p) - -proc lvalue(p: var TParser): PNode = - result = unaryExpression(p) - -proc asgnExpr(p: var TParser, opr: string, a: PNode): PNode = - closeContext(p) - getTok(p, a) - var b = assignmentExpression(p) - result = newNodeP(nkAsgn, p) - addSon(result, a, newBinary(opr, copyTree(a), b, p)) - -proc incdec(p: var TParser, opr: string, a: PNode): PNode = - closeContext(p) - getTok(p, a) - var b = assignmentExpression(p) - result = newNodeP(nkCall, p) - addSon(result, newIdentNodeP(getIdent(opr), p), a, b) - -proc assignmentExpression(p: var TParser): PNode = - saveContext(p) - var a = lvalue(p) - case p.tok.xkind - of pxAsgn: - closeContext(p) - getTok(p, a) - var b = assignmentExpression(p) - result = newNodeP(nkAsgn, p) - addSon(result, a, b) - of pxPlusAsgn: result = incDec(p, "inc", a) - of pxMinusAsgn: result = incDec(p, "dec", a) - of pxStarAsgn: result = asgnExpr(p, "*", a) - of pxSlashAsgn: result = asgnExpr(p, "/", a) - of pxModAsgn: result = asgnExpr(p, "mod", a) - of pxShlAsgn: result = asgnExpr(p, "shl", a) - of pxShrAsgn: result = asgnExpr(p, "shr", a) - of pxAmpAsgn: result = asgnExpr(p, "and", a) - of pxHatAsgn: result = asgnExpr(p, "xor", a) - of pxBarAsgn: result = asgnExpr(p, "or", a) - else: - backtrackContext(p) - result = conditionalExpression(p) - -proc shiftExpression(p: var TParser): PNode = - result = additiveExpression(p) - while p.tok.xkind in {pxShl, pxShr}: - var op = if p.tok.xkind == pxShl: "shl" else: "shr" - getTok(p, result) - var a = result - var b = additiveExpression(p) - result = newBinary(op, a, b, p) - -proc relationalExpression(p: var TParser): PNode = - result = shiftExpression(p) - # Nimrod uses ``<`` and ``<=``, etc. too: - while p.tok.xkind in {pxLt, pxLe, pxGt, pxGe}: - var op = TokKindToStr(p.tok.xkind) - getTok(p, result) - var a = result - var b = shiftExpression(p) - result = newBinary(op, a, b, p) - -proc equalityExpression(p: var TParser): PNode = - result = relationalExpression(p) - # Nimrod uses ``==`` and ``!=`` too: - while p.tok.xkind in {pxEquals, pxNeq}: - var op = TokKindToStr(p.tok.xkind) - getTok(p, result) - var a = result - var b = relationalExpression(p) - result = newBinary(op, a, b, p) - -proc andExpression(p: var TParser): PNode = - result = equalityExpression(p) - while p.tok.xkind == pxAmp: - getTok(p, result) - var a = result - var b = equalityExpression(p) - result = newBinary("and", a, b, p) - -proc exclusiveOrExpression(p: var TParser): PNode = - result = andExpression(p) - while p.tok.xkind == pxHat: - getTok(p, result) - var a = result - var b = andExpression(p) - result = newBinary("^", a, b, p) - -proc inclusiveOrExpression(p: var TParser): PNode = - result = exclusiveOrExpression(p) - while p.tok.xkind == pxBar: - getTok(p, result) - var a = result - var b = exclusiveOrExpression(p) - result = newBinary("or", a, b, p) - -proc logicalAndExpression(p: var TParser): PNode = - result = inclusiveOrExpression(p) - while p.tok.xkind == pxAmpAmp: - getTok(p, result) - var a = result - var b = inclusiveOrExpression(p) - result = newBinary("and", a, b, p) - -proc logicalOrExpression(p: var TParser): PNode = - result = logicalAndExpression(p) - while p.tok.xkind == pxBarBar: - getTok(p, result) - var a = result - var b = logicalAndExpression(p) - result = newBinary("or", a, b, p) - -proc conditionalExpression(p: var TParser): PNode = - result = logicalOrExpression(p) - if p.tok.xkind == pxConditional: - getTok(p, result) # skip '?' - var a = result - var b = expression(p) - eat(p, pxColon, b) - var c = conditionalExpression(p) - result = newNodeP(nkIfExpr, p) - var branch = newNodeP(nkElifExpr, p) - addSon(branch, a, b) - addSon(result, branch) - branch = newNodeP(nkElseExpr, p) - addSon(branch, c) - addSon(result, branch) - -# Statements - -proc buildStmtList(a: PNode): PNode = - if a.kind == nkStmtList: result = a - else: - result = newNodeI(nkStmtList, a.info) - addSon(result, a) - -proc nestedStatement(p: var TParser): PNode = - # careful: We need to translate: - # if (x) if (y) stmt; - # into: - # if x: - # if x: - # stmt - # - # Nimrod requires complex statements to be nested in whitespace! - const - complexStmt = {nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef, - nkTemplateDef, nkIteratorDef, nkIfStmt, - nkWhenStmt, nkForStmt, nkWhileStmt, nkCaseStmt, nkVarSection, - nkConstSection, nkTypeSection, nkTryStmt, nkBlockStmt, nkStmtList, - nkCommentStmt, nkStmtListExpr, nkBlockExpr, nkStmtListType, nkBlockType} - result = statement(p) - if result.kind in complexStmt: - result = buildStmtList(result) - -proc expressionStatement(p: var TParser): PNode = - # do not skip the comment after a semicolon to make a new nkCommentStmt - if p.tok.xkind == pxSemicolon: - getTok(p) - result = ast.emptyNode - else: - result = expression(p) - if p.tok.xkind == pxSemicolon: getTok(p) - else: parMessage(p, errTokenExpected, ";") - assert result != nil - -proc parseIf(p: var TParser): PNode = - # we parse additional "else if"s too here for better Nimrod code - result = newNodeP(nkIfStmt, p) - while true: - getTok(p) # skip ``if`` - var branch = newNodeP(nkElifBranch, p) - skipCom(p, branch) - eat(p, pxParLe, branch) - addSon(branch, expression(p)) - eat(p, pxParRi, branch) - addSon(branch, nestedStatement(p)) - addSon(result, branch) - if p.tok.s == "else": - getTok(p, result) - if p.tok.s != "if": - # ordinary else part: - branch = newNodeP(nkElse, p) - addSon(branch, nestedStatement(p)) - addSon(result, branch) - break - else: - break - -proc parseWhile(p: var TParser): PNode = - result = newNodeP(nkWhileStmt, p) - getTok(p, result) - eat(p, pxParLe, result) - addSon(result, expression(p)) - eat(p, pxParRi, result) - addSon(result, nestedStatement(p)) - -proc parseDoWhile(p: var TParser): PNode = - # we only support ``do stmt while (0)`` as an idiom for - # ``block: stmt`` - result = newNodeP(nkBlockStmt, p) - getTok(p, result) # skip "do" - addSon(result, ast.emptyNode, nestedStatement(p)) - eat(p, "while", result) - eat(p, pxParLe, result) - if p.tok.xkind == pxIntLit and p.tok.iNumber == 0: getTok(p, result) - else: parMessage(p, errTokenExpected, "0") - eat(p, pxParRi, result) - if p.tok.xkind == pxSemicolon: getTok(p) - -proc declarationOrStatement(p: var TParser): PNode = - if p.tok.xkind != pxSymbol: - result = expressionStatement(p) - elif declKeyword(p.tok.s): - result = declaration(p) - else: - # ordinary identifier: - saveContext(p) - getTok(p) # skip identifier to look ahead - case p.tok.xkind - of pxSymbol, pxStar: - # we parse - # a b - # a * b - # always as declarations! This is of course not correct, but good - # enough for most real world C code out there. - backtrackContext(p) - result = declaration(p) - of pxColon: - # it is only a label: - closeContext(p) - getTok(p) - result = statement(p) - else: - backtrackContext(p) - result = expressionStatement(p) - assert result != nil - -proc parseTuple(p: var TParser, isUnion: bool): PNode = - result = parseStructBody(p, isUnion, nkTupleTy) - -proc parseTrailingDefinedIdents(p: var TParser, result, baseTyp: PNode) = - var varSection = newNodeP(nkVarSection, p) - while p.tok.xkind notin {pxEof, pxSemicolon}: - var t = pointer(p, baseTyp) - expectIdent(p) - var def = newNodeP(nkIdentDefs, p) - addSon(def, varIdent(p.tok.s, p)) - getTok(p, def) - addSon(def, parseTypeSuffix(p, t)) - addInitializer(p, def) - addSon(varSection, def) - if p.tok.xkind != pxComma: break - getTok(p, def) - eat(p, pxSemicolon) - if sonsLen(varSection) > 0: - addSon(result, varSection) - -proc parseStandaloneStruct(p: var TParser, isUnion: bool): PNode = - result = newNodeP(nkStmtList, p) - saveContext(p) - getTok(p, result) # skip "struct" or "union" - var origName = "" - if p.tok.xkind == pxSymbol: - markTypeIdent(p, nil) - origName = p.tok.s - getTok(p, result) - if p.tok.xkind in {pxCurlyLe, pxSemiColon}: - if origName.len > 0: - var name = mangledIdent(origName, p) - var t = parseStruct(p, isUnion) - var typeSection = newNodeP(nkTypeSection, p) - addTypeDef(typeSection, structPragmas(p, name, origName), t) - addSon(result, typeSection) - parseTrailingDefinedIdents(p, result, name) - else: - var t = parseTuple(p, isUnion) - parseTrailingDefinedIdents(p, result, t) - else: - backtrackContext(p) - result = declaration(p) - -proc parseFor(p: var TParser, result: PNode) = - # 'for' '(' expression_statement expression_statement expression? ')' - # statement - getTok(p, result) - eat(p, pxParLe, result) - var initStmt = declarationOrStatement(p) - if initStmt.kind != nkEmpty: - addSon(result, initStmt) - var w = newNodeP(nkWhileStmt, p) - var condition = expressionStatement(p) - if condition.kind == nkEmpty: condition = newIdentNodeP("true", p) - addSon(w, condition) - var step = if p.tok.xkind != pxParRi: expression(p) else: ast.emptyNode - eat(p, pxParRi, step) - var loopBody = nestedStatement(p) - if step.kind != nkEmpty: - loopBody = buildStmtList(loopBody) - addSon(loopBody, step) - addSon(w, loopBody) - addSon(result, w) - -proc switchStatement(p: var TParser): PNode = - result = newNodeP(nkStmtList, p) - while true: - if p.tok.xkind in {pxEof, pxCurlyRi}: break - case p.tok.s - of "break": - getTok(p, result) - eat(p, pxSemicolon, result) - break - of "return", "continue", "goto": - addSon(result, statement(p)) - break - of "case", "default": - break - else: nil - addSon(result, statement(p)) - if sonsLen(result) == 0: - # translate empty statement list to Nimrod's ``nil`` statement - result = newNodeP(nkNilLit, p) - -proc rangeExpression(p: var TParser): PNode = - # We support GCC's extension: ``case expr...expr:`` - result = constantExpression(p) - if p.tok.xkind == pxDotDotDot: - getTok(p, result) - var a = result - var b = constantExpression(p) - result = newNodeP(nkRange, p) - addSon(result, a) - addSon(result, b) - -proc parseSwitch(p: var TParser): PNode = - # We cannot support Duff's device or C's crazy switch syntax. We just support - # sane usages of switch. ;-) - result = newNodeP(nkCaseStmt, p) - getTok(p, result) - eat(p, pxParLe, result) - addSon(result, expression(p)) - eat(p, pxParRi, result) - eat(p, pxCurlyLe, result) - var b: PNode - while (p.tok.xkind != pxCurlyRi) and (p.tok.xkind != pxEof): - case p.tok.s - of "default": - b = newNodeP(nkElse, p) - getTok(p, b) - eat(p, pxColon, b) - of "case": - b = newNodeP(nkOfBranch, p) - while p.tok.xkind == pxSymbol and p.tok.s == "case": - getTok(p, b) - addSon(b, rangeExpression(p)) - eat(p, pxColon, b) - else: - parMessage(p, errXExpected, "case") - addSon(b, switchStatement(p)) - addSon(result, b) - if b.kind == nkElse: break - eat(p, pxCurlyRi) - -proc addStmt(sl, a: PNode) = - # merge type sections if possible: - if a.kind != nkTypeSection or sonsLen(sl) == 0 or - lastSon(sl).kind != nkTypeSection: - addSon(sl, a) - else: - var ts = lastSon(sl) - for i in 0..sonsLen(a)-1: addSon(ts, a.sons[i]) - -proc embedStmts(sl, a: PNode) = - if a.kind != nkStmtList: - addStmt(sl, a) - else: - for i in 0..sonsLen(a)-1: - if a[i].kind != nkEmpty: addStmt(sl, a[i]) - -proc compoundStatement(p: var TParser): PNode = - result = newNodeP(nkStmtList, p) - eat(p, pxCurlyLe) - inc(p.scopeCounter) - while p.tok.xkind notin {pxEof, pxCurlyRi}: - var a = statement(p) - if a.kind == nkEmpty: break - embedStmts(result, a) - if sonsLen(result) == 0: - # translate ``{}`` to Nimrod's ``nil`` statement - result = newNodeP(nkNilLit, p) - dec(p.scopeCounter) - eat(p, pxCurlyRi) - -include cpp - -proc statement(p: var TParser): PNode = - case p.tok.xkind - of pxSymbol: - case p.tok.s - of "if": result = parseIf(p) - of "switch": result = parseSwitch(p) - of "while": result = parseWhile(p) - of "do": result = parseDoWhile(p) - of "for": - result = newNodeP(nkStmtList, p) - parseFor(p, result) - of "goto": - # we cannot support "goto"; in hand-written C, "goto" is most often used - # to break a block, so we convert it to a break statement with label. - result = newNodeP(nkBreakStmt, p) - getTok(p) - addSon(result, skipIdent(p)) - eat(p, pxSemicolon) - of "continue": - result = newNodeP(nkContinueStmt, p) - getTok(p) - eat(p, pxSemicolon) - addSon(result, ast.emptyNode) - of "break": - result = newNodeP(nkBreakStmt, p) - getTok(p) - eat(p, pxSemicolon) - addSon(result, ast.emptyNode) - of "return": - result = newNodeP(nkReturnStmt, p) - getTok(p) - # special case for ``return (expr)`` because I hate the redundant - # parenthesis ;-) - if p.tok.xkind == pxParLe: - getTok(p, result) - addSon(result, expression(p)) - eat(p, pxParRi, result) - elif p.tok.xkind != pxSemicolon: - addSon(result, expression(p)) - else: - addSon(result, ast.emptyNode) - eat(p, pxSemicolon) - of "enum": result = enumSpecifier(p) - of "typedef": result = parseTypeDef(p) - of "struct": result = parseStandaloneStruct(p, isUnion=false) - of "union": result = parseStandaloneStruct(p, isUnion=true) - else: result = declarationOrStatement(p) - of pxCurlyLe: - result = compoundStatement(p) - of pxDirective, pxDirectiveParLe: - result = parseDir(p) - of pxLineComment, pxStarComment: - result = newNodeP(nkCommentStmt, p) - skipCom(p, result) - of pxSemicolon: - # empty statement: - getTok(p) - if p.tok.xkind in {pxLineComment, pxStarComment}: - result = newNodeP(nkCommentStmt, p) - skipCom(p, result) - else: - result = newNodeP(nkNilLit, p) - else: - result = expressionStatement(p) - assert result != nil - -proc parseUnit(p: var TParser): PNode = - result = newNodeP(nkStmtList, p) - getTok(p) # read first token - while p.tok.xkind != pxEof: - var s = statement(p) - if s.kind != nkEmpty: embedStmts(result, s) - diff --git a/compiler/c2nim/cpp.nim b/compiler/c2nim/cpp.nim deleted file mode 100644 index 439b000e7..000000000 --- a/compiler/c2nim/cpp.nim +++ /dev/null @@ -1,347 +0,0 @@ -# -# -# c2nim - C to Nimrod source converter -# (c) Copyright 2012 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# Preprocessor support - -const - c2nimSymbol = "C2NIM" - -proc eatNewLine(p: var TParser, n: PNode) = - if p.tok.xkind == pxLineComment: - skipCom(p, n) - if p.tok.xkind == pxNewLine: getTok(p) - elif p.tok.xkind == pxNewLine: - eat(p, pxNewLine) - -proc skipLine(p: var TParser) = - while p.tok.xkind notin {pxEof, pxNewLine, pxLineComment}: getTok(p) - eatNewLine(p, nil) - -proc parseDefineBody(p: var TParser, tmplDef: PNode): string = - if p.tok.xkind == pxCurlyLe or - (p.tok.xkind == pxSymbol and ( - declKeyword(p.tok.s) or stmtKeyword(p.tok.s))): - addSon(tmplDef, statement(p)) - result = "stmt" - elif p.tok.xkind in {pxLineComment, pxNewLine}: - addSon(tmplDef, buildStmtList(newNodeP(nkNilLit, p))) - result = "stmt" - else: - addSon(tmplDef, buildStmtList(expression(p))) - result = "expr" - -proc parseDefine(p: var TParser): PNode = - if p.tok.xkind == pxDirectiveParLe: - # a macro with parameters: - result = newNodeP(nkTemplateDef, p) - getTok(p) - addSon(result, skipIdentExport(p)) - addSon(result, ast.emptyNode) - eat(p, pxParLe) - var params = newNodeP(nkFormalParams, p) - # return type; not known yet: - addSon(params, ast.emptyNode) - if p.tok.xkind != pxParRi: - var identDefs = newNodeP(nkIdentDefs, p) - while p.tok.xkind != pxParRi: - addSon(identDefs, skipIdent(p)) - skipStarCom(p, nil) - if p.tok.xkind != pxComma: break - getTok(p) - addSon(identDefs, newIdentNodeP("expr", p)) - addSon(identDefs, ast.emptyNode) - addSon(params, identDefs) - eat(p, pxParRi) - - addSon(result, ast.emptyNode) # no generic parameters - addSon(result, params) - addSon(result, ast.emptyNode) # no pragmas - addSon(result, ast.emptyNode) - var kind = parseDefineBody(p, result) - params.sons[0] = newIdentNodeP(kind, p) - eatNewLine(p, result) - else: - # a macro without parameters: - result = newNodeP(nkConstSection, p) - while p.tok.xkind == pxDirective and p.tok.s == "define": - getTok(p) # skip #define - var c = newNodeP(nkConstDef, p) - addSon(c, skipIdentExport(p)) - addSon(c, ast.emptyNode) - skipStarCom(p, c) - if p.tok.xkind in {pxLineComment, pxNewLine, pxEof}: - addSon(c, newIdentNodeP("true", p)) - else: - addSon(c, expression(p)) - addSon(result, c) - eatNewLine(p, c) - assert result != nil - -proc parseDefBody(p: var TParser, m: var TMacro, params: seq[string]) = - m.body = @[] - # A little hack: We safe the context, so that every following token will be - # put into a newly allocated TToken object. Thus we can just save a - # reference to the token in the macro's body. - saveContext(p) - while p.tok.xkind notin {pxEof, pxNewLine, pxLineComment}: - case p.tok.xkind - of pxSymbol: - # is it a parameter reference? - var tok = p.tok - for i in 0..high(params): - if params[i] == p.tok.s: - new(tok) - tok.xkind = pxMacroParam - tok.iNumber = i - break - m.body.add(tok) - of pxDirConc: - # just ignore this token: this implements token merging correctly - nil - else: - m.body.add(p.tok) - # we do not want macro expansion here: - rawGetTok(p) - eatNewLine(p, nil) - closeContext(p) - # newline token might be overwritten, but this is not - # part of the macro body, so it is safe. - -proc parseDef(p: var TParser, m: var TMacro) = - var hasParams = p.tok.xkind == pxDirectiveParLe - getTok(p) - expectIdent(p) - m.name = p.tok.s - getTok(p) - var params: seq[string] = @[] - # parse parameters: - if hasParams: - eat(p, pxParLe) - while p.tok.xkind != pxParRi: - expectIdent(p) - params.add(p.tok.s) - getTok(p) - skipStarCom(p, nil) - if p.tok.xkind != pxComma: break - getTok(p) - eat(p, pxParRi) - m.params = params.len - parseDefBody(p, m, params) - -proc isDir(p: TParser, dir: string): bool = - result = p.tok.xkind in {pxDirectiveParLe, pxDirective} and p.tok.s == dir - -proc parseInclude(p: var TParser): PNode = - result = newNodeP(nkImportStmt, p) - while isDir(p, "include"): - getTok(p) # skip "include" - if p.tok.xkind == pxStrLit and pfSkipInclude notin p.options.flags: - var file = newStrNodeP(nkStrLit, changeFileExt(p.tok.s, ""), p) - addSon(result, file) - getTok(p) - skipStarCom(p, file) - eatNewLine(p, nil) - else: - skipLine(p) - if sonsLen(result) == 0: - # we only parsed includes that we chose to ignore: - result = ast.emptyNode - -proc definedExprAux(p: var TParser): PNode = - result = newNodeP(nkCall, p) - addSon(result, newIdentNodeP("defined", p)) - addSon(result, skipIdent(p)) - -proc parseStmtList(p: var TParser): PNode = - result = newNodeP(nkStmtList, p) - while true: - case p.tok.xkind - of pxEof: break - of pxDirectiveParLe, pxDirective: - case p.tok.s - of "else", "endif", "elif": break - else: nil - addSon(result, statement(p)) - -proc eatEndif(p: var TParser) = - if isDir(p, "endif"): - skipLine(p) - else: - parMessage(p, errXExpected, "#endif") - -proc parseIfDirAux(p: var TParser, result: PNode) = - addSon(result.sons[0], parseStmtList(p)) - while isDir(p, "elif"): - var b = newNodeP(nkElifBranch, p) - getTok(p) - addSon(b, expression(p)) - eatNewLine(p, nil) - addSon(b, parseStmtList(p)) - addSon(result, b) - if isDir(p, "else"): - var s = newNodeP(nkElse, p) - skipLine(p) - addSon(s, parseStmtList(p)) - addSon(result, s) - eatEndif(p) - -proc skipUntilEndif(p: var TParser) = - var nested = 1 - while p.tok.xkind != pxEof: - if isDir(p, "ifdef") or isDir(p, "ifndef") or isDir(p, "if"): - inc(nested) - elif isDir(p, "endif"): - dec(nested) - if nested <= 0: - skipLine(p) - return - getTok(p) - parMessage(p, errXExpected, "#endif") - -type - TEndifMarker = enum - emElif, emElse, emEndif - -proc skipUntilElifElseEndif(p: var TParser): TEndifMarker = - var nested = 1 - while p.tok.xkind != pxEof: - if isDir(p, "ifdef") or isDir(p, "ifndef") or isDir(p, "if"): - inc(nested) - elif isDir(p, "elif") and nested <= 1: - return emElif - elif isDir(p, "else") and nested <= 1: - return emElse - elif isDir(p, "endif"): - dec(nested) - if nested <= 0: - return emEndif - getTok(p) - parMessage(p, errXExpected, "#endif") - -proc parseIfdef(p: var TParser): PNode = - getTok(p) # skip #ifdef - ExpectIdent(p) - case p.tok.s - of "__cplusplus": - skipUntilEndif(p) - result = ast.emptyNode - of c2nimSymbol: - skipLine(p) - result = parseStmtList(p) - skipUntilEndif(p) - else: - result = newNodeP(nkWhenStmt, p) - addSon(result, newNodeP(nkElifBranch, p)) - addSon(result.sons[0], definedExprAux(p)) - eatNewLine(p, nil) - parseIfDirAux(p, result) - -proc parseIfndef(p: var TParser): PNode = - result = ast.emptyNode - getTok(p) # skip #ifndef - ExpectIdent(p) - if p.tok.s == c2nimSymbol: - skipLine(p) - case skipUntilElifElseEndif(p) - of emElif: - result = newNodeP(nkWhenStmt, p) - addSon(result, newNodeP(nkElifBranch, p)) - getTok(p) - addSon(result.sons[0], expression(p)) - eatNewLine(p, nil) - parseIfDirAux(p, result) - of emElse: - skipLine(p) - result = parseStmtList(p) - eatEndif(p) - of emEndif: skipLine(p) - else: - result = newNodeP(nkWhenStmt, p) - addSon(result, newNodeP(nkElifBranch, p)) - var e = newNodeP(nkCall, p) - addSon(e, newIdentNodeP("not", p)) - addSon(e, definedExprAux(p)) - eatNewLine(p, nil) - addSon(result.sons[0], e) - parseIfDirAux(p, result) - -proc parseIfDir(p: var TParser): PNode = - result = newNodeP(nkWhenStmt, p) - addSon(result, newNodeP(nkElifBranch, p)) - getTok(p) - addSon(result.sons[0], expression(p)) - eatNewLine(p, nil) - parseIfDirAux(p, result) - -proc parsePegLit(p: var TParser): TPeg = - var col = getColumn(p.lex) + 2 - getTok(p) - if p.tok.xkind != pxStrLit: ExpectIdent(p) - try: - result = parsePeg( - pattern = if p.tok.xkind == pxStrLit: p.tok.s else: escapePeg(p.tok.s), - filename = p.lex.fileIdx.ToFilename, - line = p.lex.linenumber, - col = col) - getTok(p) - except EInvalidPeg: - parMessage(p, errUser, getCurrentExceptionMsg()) - -proc parseMangleDir(p: var TParser) = - var pattern = parsePegLit(p) - if p.tok.xkind != pxStrLit: ExpectIdent(p) - p.options.mangleRules.add((pattern, p.tok.s)) - getTok(p) - eatNewLine(p, nil) - -proc modulePragmas(p: var TParser): PNode = - if p.options.dynlibSym.len > 0 and not p.hasDeadCodeElimPragma: - p.hasDeadCodeElimPragma = true - result = newNodeP(nkPragma, p) - var e = newNodeP(nkExprColonExpr, p) - addSon(e, newIdentNodeP("deadCodeElim", p), newIdentNodeP("on", p)) - addSon(result, e) - else: - result = ast.emptyNode - -proc parseDir(p: var TParser): PNode = - result = ast.emptyNode - assert(p.tok.xkind in {pxDirective, pxDirectiveParLe}) - case p.tok.s - of "define": result = parseDefine(p) - of "include": result = parseInclude(p) - of "ifdef": result = parseIfdef(p) - of "ifndef": result = parseIfndef(p) - of "if": result = parseIfDir(p) - of "cdecl", "stdcall", "ref", "skipinclude", "typeprefixes", "skipcomments": - discard setOption(p.options, p.tok.s) - getTok(p) - eatNewLine(p, nil) - of "dynlib", "header", "prefix", "suffix": - var key = p.tok.s - getTok(p) - if p.tok.xkind != pxStrLit: ExpectIdent(p) - discard setOption(p.options, key, p.tok.s) - getTok(p) - eatNewLine(p, nil) - result = modulePragmas(p) - of "mangle": - parseMangleDir(p) - of "def": - var L = p.options.macros.len - setLen(p.options.macros, L+1) - parseDef(p, p.options.macros[L]) - of "private": - var pattern = parsePegLit(p) - p.options.privateRules.add(pattern) - eatNewLine(p, nil) - else: - # ignore unimportant/unknown directive ("undef", "pragma", "error") - skipLine(p) - diff --git a/compiler/c2nim/nimrod.cfg b/compiler/c2nim/nimrod.cfg deleted file mode 100644 index cfeda63ed..000000000 --- a/compiler/c2nim/nimrod.cfg +++ /dev/null @@ -1,4 +0,0 @@ -# Use the modules of the compiler - -path: "$nimrod/compiler" - diff --git a/compiler/c2nim/tests/systest.c b/compiler/c2nim/tests/systest.c deleted file mode 100644 index 51509e253..000000000 --- a/compiler/c2nim/tests/systest.c +++ /dev/null @@ -1,622 +0,0 @@ -/* This file has been written by Blablub. - * - * Another comment line. - */ - -#ifdef __cplusplus -# ifdef __SOME_OTHER_CRAP -extern "C" { -# endif -#endif - -#define interrupts() sei() - -enum -{ -/* 8bit, color or not */ - CV_LOAD_IMAGE_UNCHANGED =-1, -/* 8bit, gray */ - CV_LOAD_IMAGE_GRAYSCALE =0, -/* ?, color */ - CV_LOAD_IMAGE_COLOR =1, -/* any depth, ? */ - CV_LOAD_IMAGE_ANYDEPTH =2, -/* ?, any color */ - CV_LOAD_IMAGE_ANYCOLOR =4 -}; - -typedef void (*callback_t) (int rc); -typedef const char* (*callback2)(int rc, long L, const char* buffer); - -int aw_callback_set (AW_CALLBACK c, callback_t callback ); -int aw_instance_callback_set (AW_CALLBACK c, callback_t callback); - -unsigned long int wawa; - -#define MAX(x, y) ((x) < (y)? (y) : (x)) - -#define AW_BUILD 85 // AW 5.0 -// Limits -#define AW_MAX_AVCHANGE_PER_SECOND 10 - -#private expatDll - -#if !defined(expatDll) -# if defined(windows) -# define expatDll "expat.dll" -# elif defined(macosx) -# define expatDll "libexpat.dynlib" -# else -# define expatDll "libexpat.so(.1|)" -# endif -#endif - -#mangle "'XML_'{.*}" "$1" -#private "'XML_ParserStruct'" - -#mangle cuint cint - -unsigned int uiVar; - -#private "@('_'!.)" -unsigned int myPrivateVar__; - - -struct XML_ParserStruct; - -#def XMLCALL __cdecl - -typedef void (XMLCALL *XML_ElementDeclHandler) (void *userData, - const XML_Char *name, - XML_Content *model); - - -void* x; -void* fn(void); -void (*fn)(void); -void* (*fn)(void); -void* (*fn)(void*); - -/* - * Very ugly real world code ahead: - */ - -#def JMETHOD(rettype, name, params) rettype (*name) params - -typedef struct cjpeg_source_struct * cjpeg_source_ptr; - -struct cjpeg_source_struct { - JMETHOD(void, start_input, (j_compress_ptr cinfo, - cjpeg_source_ptr sinfo)); - JMETHOD(JDIMENSION, get_pixel_rows, (j_compress_ptr cinfo, - cjpeg_source_ptr sinfo)); - JMETHOD(void, finish_input, (j_compress_ptr cinfo, - cjpeg_source_ptr sinfo)); - - FILE *input_file; - - JSAMPARRAY buffer; - JDIMENSION buffer_height; -}; - -// Test standalone structs: - -union myunion { - char x, y, *z; - myint a, b; -} u; - -struct mystruct { - char x, y, *z; - myint a, b; -}; - -struct mystruct fn(i32 x, i64 y); - -struct mystruct { - char x, y, *z; - myint a, b; -} *myvar = NULL, **myvar2 = NULL; - -// anonymous struct: - -struct { - char x, y, *z; - myint a, b; -} varX, **varY; - -// empty anonymous struct: - -struct { - -} varX, **varY; - -// Test C2NIM skipping: - -#define MASK(x) ((x) & 0xff) -#define CAST1(x) ((int) &x) -#define CAST2(x) (typ*) &x -#define CAST3(x) ((const unsigned char**) &x) - -#ifndef C2NIM - #if someNestedCond - This is an invalid text that should generate a parser error, if not - #endif - skipped correctly. -#endif - -#ifndef C2NIM - #if someNestedCond - This is an invalid text that should generate a parser error, if not - #endif - skipped correctly. -#else -typedef char gchar; -typedef unsigned int gunsignedint; -typedef unsigned char guchar; -#endif - -#ifdef C2NIM -# mangle "'those'" "these" -int those; -#elif abc - #if someNestedCond - This is an invalid text that should generate a parser error, if not - #else - skipped correctly. - #endif -#else - Another crappy input line. -#endif - -point* newPoint(void) { - for (int i = 0; i < 89; ++i) echo("test" " string " "concatenation"); - for (; j < 54; j++) {} - for (;; j--) ; - for (;;) {} - mytype * x = y * z; - - if (**p == ' ') { - --p; - } else if (**p == '\t') { - p += 3; - } else { - p = 45 + (mytype*)45; - p = 45 + ((mytype*)45); - p = 45 + ((mytype)45); - // BUG: This does not parse: - // p = 45 + (mytype)45; - } - - while (x >= 6 && x <= 20) - --x; - - switch (*p) { - case 'A'...'Z': - case 'a'...'z': - ++p; - break; - case '0': - ++p; - break; - default: - return NULL; - } -} - -enum { - a1, a2 = 4, a3 -}; - -typedef enum crazyTAG { - x1, x2, x3 = 8, x4, x5 -} myEnum, *pMyEnum; - -typedef enum { - x1, x2, x3 = 8, x4, x5 -} myEnum, *pMyEnum; - -// Test multi-line macro: - -#define MUILTILINE "abc" \ - "xyz" \ - "def" - -#define MULTILINE(x, y) do { \ - ++y; ++x; \ -} while (0) - -#ifdef C2NIM -# dynlib iupdll -# cdecl -# mangle "'GTK_'{.*}" "TGtk$1" -# mangle "'PGTK_'{.*}" "PGtk$1" -# if defined(windows) -# define iupdll "iup.dll" -# elif defined(macosx) -# define iupdll "libiup.dynlib" -# else -# define iupdll "libiup.so" -# endif -#endif - -typedef struct stupidTAG { - mytype a, b; -} GTK_MyStruct, *PGTK_MyStruct; - -typedef struct { - mytype a, b; -} GTK_MyStruct, *PGTK_MyStruct; - -int IupConvertXYToPos(PIhandle ih, int x, int y); - -#ifdef DEBUG -# define OUT(x) printf("%s\n", x) -#else -# define OUT(x) -#endif - - - #ifdef C2NIM - # def EXTERN(x) static x - # def TWO_ARGS(x, y) x* y - #endif - // parses now! - EXTERN(int) f(void); - EXTERN(int) g(void); - - - #def EXPORT - // does parse now! - EXPORT int f(void); - EXPORT int g(void); - - static TWO_ARGS(int, x) = TWO_ARGS(56, 45); - - -# define abc 34 -# define xyz 42 - -# define wuseldusel "my string\nconstant" - -#undef ignoreThis - -char* x; - -typedef struct { - char x, y, *z; -} point; - -char* __stdcall printf(char* frmt, const char* const** ptrToStrArray, - const int* const dummy, ...); - -inline char* myinlineProc(char* frmt, const char* const* strArray, - const int* const dummy, ...); - -// Test void parameter list: -void myVoidProc(void); - -void emptyReturn(void) { return; } - -// POSIX stuff: - -#ifdef C2NIM -#prefix posix_ -int c2nimBranch; -#elif defined(MACOSX) -int* x, y, z; -#else -int dummy; -#endif - -#ifndef C2NIM -int dontTranslateThis; -#elif defined(Windows) -int WindowsTrue = true; -#endif - -int posix_spawn(pid_t *restrict, const char *restrict, - const posix_spawn_file_actions_t *, - const posix_spawnattr_t *restrict, char *const [restrict], - char *const [restrict]); -int posix_spawn_file_actions_addclose(posix_spawn_file_actions_t *, - int); -int posix_spawn_file_actions_adddup2(posix_spawn_file_actions_t *, - int, int); -int posix_spawn_file_actions_addopen(posix_spawn_file_actions_t *restrict, - int, const char *restrict, int, mode_t); -int posix_spawn_file_actions_destroy(posix_spawn_file_actions_t *); -int posix_spawn_file_actions_init(posix_spawn_file_actions_t *); -int posix_spawnattr_destroy(posix_spawnattr_t *); -int posix_spawnattr_getsigdefault(const posix_spawnattr_t *restrict, - sigset_t *restrict); -int posix_spawnattr_getflags(const posix_spawnattr_t *restrict, - short *restrict); -int posix_spawnattr_getpgroup(const posix_spawnattr_t *restrict, - pid_t *restrict); -int posix_spawnattr_getschedparam(const posix_spawnattr_t *restrict, - struct sched_param *restrict); -int posix_spawnattr_getschedpolicy(const posix_spawnattr_t *restrict, - int *restrict); -int posix_spawnattr_getsigmask(const posix_spawnattr_t *restrict, - sigset_t *restrict); -int posix_spawnattr_init(posix_spawnattr_t *); -int posix_spawnattr_setsigdefault(posix_spawnattr_t *restrict, - const sigset_t *restrict); -int posix_spawnattr_setflags(posix_spawnattr_t *, short); -int posix_spawnattr_setpgroup(posix_spawnattr_t *, pid_t); - - -int posix_spawnattr_setschedparam(posix_spawnattr_t *restrict, - const struct sched_param *restrict); -int posix_spawnattr_setschedpolicy(posix_spawnattr_t *, int); -int posix_spawnattr_setsigmask(posix_spawnattr_t *restrict, - const sigset_t *restrict); -int posix_spawnp(pid_t *restrict, const char *restrict, - const posix_spawn_file_actions_t *, - const posix_spawnattr_t *restrict, - char *const [restrict], char *const [restrict]); - -typedef struct -{ - float R, G, B; -} -RGBType; -typedef struct -{ - float H, W, B; -} -HWBType; - -static HWBType * -RGB_to_HWB (RGBType RGB, HWBType * HWB) -{ - HWBType* myArray[20]; - /* - * RGB are each on [0, 1]. W and B are returned on [0, 1] and H is - * returned on [0, 6]. Exception: H is returned UNDEFINED if W == 1 - B. - */ - - float R = RGB.R, G = RGB.G, B = RGB.B, w, v, b, f; - int i; - - w = MIN3 (R, G, B); - v = MAX3 (R, G, B); - b &= 1 - v; - if (v == w) - RETURN_HWB (HWB_UNDEFINED, w, b); - f = (R == w) ? G - B : ((G == w) ? B - R : R - G); - i = (R == w) ? 3 : ((G == w) ? 5 : 1); - RETURN_HWB (i - f / (v - w), w, b); - -} - -static int -clip_1d (int *x0, int *y0, int *x1, int *y1, int mindim, int maxdim) -{ - double m; // gradient of line - if (*x0 < mindim) - { // start of line is left of window - if (*x1 < mindim) // as is the end, so the line never cuts the window - return 0; - m = (*y1 - *y0) / (double) (*x1 - *x0); // calculate the slope of the line - // adjust x0 to be on the left boundary (ie to be zero), and y0 to match - *y0 -= m * (*x0 - mindim); - *x0 = mindim; - // now, perhaps, adjust the far end of the line as well - if (*x1 > maxdim) - { - *y1 += m * (maxdim - *x1); - *x1 = maxdim; - } - return 1; - } - if (*x0 > maxdim) - { // start of line is right of window - complement of above - if (*x1 > maxdim) // as is the end, so the line misses the window - return 0; - m = (*y1 - *y0) / (double) (*x1 - *x0); // calculate the slope of the line - *y0 += m * (maxdim - *x0); // adjust so point is on the right - // boundary - *x0 = maxdim; - // now, perhaps, adjust the end of the line - if (*x1 < mindim) - { - *y1 -= m * (*x1 - mindim); - *x1 = mindim; - } - return 1; - } - // the final case - the start of the line is inside the window - if (*x1 > maxdim) - { // other end is outside to the right - m = (*y1 - *y0) / (double) (*x1 - *x0); // calculate the slope of the line - *y1 += m * (maxdim - *x1); - *x1 = maxdim; - return 1; - } - if (*x1 < mindim) - { // other end is outside to the left - m = (*y1 - *y0) / (double) (*x1 - *x0); // calculate the slope of line - *y1 -= m * (*x1 - mindim); - *x1 = mindim; - return 1; - } - // only get here if both points are inside the window - return 1; -} - -// end of line clipping code - -static void -gdImageBrushApply (gdImagePtr im, int x, int y) -{ - int lx, ly; - int hy; - int hx; - int x1, y1, x2, y2; - int srcx, srcy; - if (!im->brush) - { - return; - } - hy = gdImageSY (im->brush) / 2; - y1 = y - hy; - y2 = y1 + gdImageSY (im->brush); - hx = gdImageSX (im->brush) / 2; - x1 = x - hx; - x2 = x1 + gdImageSX (im->brush); - srcy = 0; - if (im->trueColor) - { - if (im->brush->trueColor) - { - for (ly = y1; (ly < y2); ly++) - { - srcx = 0; - for (lx = x1; (lx < x2); lx++) - { - int p; - p = gdImageGetTrueColorPixel (im->brush, srcx, srcy); - // 2.0.9, Thomas Winzig: apply simple full transparency - if (p != gdImageGetTransparent (im->brush)) - { - gdImageSetPixel (im, lx, ly, p); - } - srcx++; - } - srcy++; - } - } - else - { - // 2.0.12: Brush palette, image truecolor (thanks to Thorben Kundinger - // for pointing out the issue) - for (ly = y1; (ly < y2); ly++) - { - srcx = 0; - for (lx = x1; (lx < x2); lx++) - { - int p, tc; - p = gdImageGetPixel (im->brush, srcx, srcy); - tc = gdImageGetTrueColorPixel (im->brush, srcx, srcy); - // 2.0.9, Thomas Winzig: apply simple full transparency - if (p != gdImageGetTransparent (im->brush)) - { - gdImageSetPixel (im, lx, ly, tc); - } - srcx++; - } - srcy++; - } - } - } - else - { - for (ly = y1; (ly < y2); ly++) - { - srcx = 0; - for (lx = x1; (lx < x2); lx++) - { - int p; - p = gdImageGetPixel (im->brush, srcx, srcy); - // Allow for non-square brushes! - if (p != gdImageGetTransparent (im->brush)) - { - // Truecolor brush. Very slow - // on a palette destination. - if (im->brush->trueColor) - { - gdImageSetPixel (im, lx, ly, - gdImageColorResolveAlpha(im, - gdTrueColorGetRed(p), - gdTrueColorGetGreen(p), - gdTrueColorGetBlue(p), - gdTrueColorGetAlpha(p))); - } - else - { - gdImageSetPixel (im, lx, ly, im->brushColorMap[p]); - } - } - srcx++; - } - srcy++; - } - } -} - - -void gdImageSetPixel (gdImagePtr im, int x, int y, int color) -{ - int p; - switch (color) - { - case gdStyled: - if (!im->style) - { - // Refuse to draw if no style is set. - return; - } - else - { - p = im->style[im->stylePos++]; - } - if (p != (gdTransparent)) - { - gdImageSetPixel (im, x, y, p); - } - im->stylePos = im->stylePos % im->styleLength; - break; - case gdStyledBrushed: - if (!im->style) - { - // Refuse to draw if no style is set. - return; - } - p = im->style[im->stylePos++]; - if ((p != gdTransparent) && (p != 0)) - { - gdImageSetPixel (im, x, y, gdBrushed); - } - im->stylePos = im->stylePos % im->styleLength; - break; - case gdBrushed: - gdImageBrushApply (im, x, y); - break; - case gdTiled: - gdImageTileApply (im, x, y); - break; - case gdAntiAliased: - // This shouldn't happen (2.0.26) because we just call - // gdImageAALine now, but do something sane. - gdImageSetPixel(im, x, y, im->AA_color); - break; - default: - if (gdImageBoundsSafeMacro (im, x, y)) - { - if (im->trueColor) - { - if (im->alphaBlendingFlag) - { - im->tpixels[y][x] = gdAlphaBlend (im->tpixels[y][x], color); - } - else - { - im->tpixels[y][x] = color; - } - } - else - { - im->pixels[y][x] = color; - } - } - break; - } -} - -#ifdef __cplusplus -} -#endif - - diff --git a/compiler/c2nim/tests/systest2.c b/compiler/c2nim/tests/systest2.c deleted file mode 100644 index bf3027cfc..000000000 --- a/compiler/c2nim/tests/systest2.c +++ /dev/null @@ -1,17 +0,0 @@ -#ifdef C2NIM -# header "iup.h" -# cdecl -# mangle "'GTK_'{.*}" "TGtk$1" -# mangle "'PGTK_'{.*}" "PGtk$1" -#endif - -typedef struct stupidTAG { - mytype a, b; -} GTK_MyStruct, *PGTK_MyStruct; - -typedef struct { - mytype a, b; -} GTK_MyStruct, *PGTK_MyStruct; - -int IupConvertXYToPos(PIhandle ih, int x, int y); - 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 1d6df3c15..ac607e3ad 100644 --- a/compiler/ccgcalls.nim +++ b/compiler/ccgcalls.nim @@ -1,7 +1,7 @@ # # -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -9,300 +9,857 @@ # # 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: PRope) = - var pl = con(callee, ~"(", params) + callee, params: Rope) = + 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(typ.sons[0]): - if params != nil: pl.app(~", ") + 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) - elif d.k notin {locExpr, locTemp} and not hasNoInit(ri): + 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: - resetLoc(p, d) - app(pl, addrLoc(d)) - app(pl, ~");$n") + discard "resetLoc(p, d)" + pl.add(addrLoc(p.config, d)) + pl.add(");\n") line(p, cpsStmts, pl) else: - var tmp: TLoc - getTemp(p, typ.sons[0], tmp) - app(pl, addrLoc(tmp)) - app(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: - app(pl, ~")") - if d.k == locNone: getTemp(p, typ.sons[0], d) - assert(d.t != nil) # generate an assignment to d: - var list: TLoc - initLoc(list, locCall, d.t, OnUnknown) - list.r = pl - genAssignment(p, d, list, {}) # no need for deep copying + 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 = 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: - app(pl, ~");$n") + pl.add(");\n") line(p, cpsStmts, pl) + if canRaise: raiseExit(p) -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,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. +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: nil + else: + result = true -proc openArrayLoc(p: BProc, n: PNode): PRope = - var a: TLoc - initLocExpr(p, n, a) - case skipTypes(a.t, abstractVar).kind +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: - result = ropef("$1, $1Len0", [rdLoc(a)]) + 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: - if skipTypes(n.typ, abstractInst).kind == tyVar: - result = ropef("(*$1)->data, (*$1)->$2", [a.rdLoc, lenField()]) + 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 = ropef("$1->data, $1->$2", [a.rdLoc, lenField()]) - of tyArray, tyArrayConstr: - result = ropef("$1, $2", [rdLoc(a), toRope(lengthOrd(a.t))]) - else: InternalError("openArrayLoc: " & typeToString(a.t)) + 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 genArgStringToCString(p: BProc, - n: PNode): PRope {.inline.} = - var a: TLoc - initLocExpr(p, n.sons[0], a) - result = ropef("$1->data", [a.rdLoc]) - -proc genArg(p: BProc, n: PNode, param: PSym): PRope = +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: + 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: + var a = initLocExpr(p, if n.kind == nkHiddenStdConv: n[1] else: n) + case skipTypes(a.t, abstractVar+{tyStatic}).kind + of tyOpenArray, tyVarargs: + if reifiedOpenArray(n): + if a.t.kind in {tyVar, tyLent}: + result.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: + 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.add "($4) ? ($1$3) : NIM_NIL, $2" % + [a.rdLoc, lenExpr(p, a), dataField(p), dataFieldAccessor(p, a.rdLoc)] + of tyArray: + result.add "$1, $2" % [rdLoc(a), rope(lengthOrd(p.config, a.t))] + of tyPtr, tyRef: + case elementType(a.t).kind + of tyString, tySequence: + 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.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 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; 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(param): - initLocExpr(p, n, a) - result = addrLoc(a) + 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: + # bug #23748: we need to introduce a temporary here. The expression type + # will be a reference in C++ and we cannot create a temporary reference + # variable. Thus, we create a temporary pointer variable instead. + let needsIndirect = mapType(p.config, n[0].typ, mapTypeChooser(n[0]) == skParam) != ctArray + if needsIndirect: + n.typ = n.typ.exactReplica + n.typ.flags.incl tfVarIsPtr + a = initLocExprSingleUse(p, n) + a = withTmpIfNeeded(p, a, needsTmp) + if needsIndirect: a.flags.incl lfIndirect + # if the proc is 'importc'ed but not 'importcpp'ed then 'var T' still + # means '*T'. See posix.nim for lots of examples that do that in the wild. + let callee = call[0] + if callee.kind == nkSym and + {sfImportc, sfInfixCall, sfCompilerProc} * callee.sym.flags == {sfImportc} and + {lfHeader, lfNoDecl} * callee.sym.loc.flags != {} and + needsIndirect: + addAddrLoc(p.config, a, result) + else: + addRdLoc(a, result) else: - initLocExpr(p, n, a) - result = rdLoc(a) + 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): PRope = +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: + 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: - initLocExpr(p, n, a) - result = rdLoc(a) + 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: PRope + 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): - if ri.sons[i].typ.isCompileTimeOnly: continue - if params != nil: app(params, ~", ") - if i < sonsLen(typ): - assert(typ.n.sons[i].kind == nkSym) - app(params, genArg(p, ri.sons[i], typ.n.sons[i].sym)) - else: - app(params, genArgNoParam(p, ri.sons[i])) - fixupCall(p, le, ri, d, op.r, params) + + var params = newRopeAppender() + genParams(p, ri, typ, params) + + 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 getRawProcType(p: BProc, t: PType): PRope = - result = getClosureType(p.module, t, clHalf) + proc addComma(r: Rope): Rope = + if r.len == 0: r else: r & ", " - proc addComma(r: PRope): PRope = - result = if r == nil: r else: con(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 - const CallPattern = "$1.ClEnv? $1.ClPrc($3$1.ClEnv) : (($4)($1.ClPrc))($2)" - var op: TLoc - initLocExpr(p, ri.sons[0], op) - var pl: PRope - - 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)) - if i < sonsLen(typ): - assert(typ.n.sons[i].kind == nkSym) - app(pl, genArg(p, ri.sons[i], typ.n.sons[i].sym)) - else: - app(pl, genArgNoParam(p, ri.sons[i])) - if i < length - 1: app(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) - if typ.sons[0] != nil: - if isInvalidReturnType(typ.sons[0]): - if sonsLen(ri) > 1: app(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) - elif d.k notin {locExpr, locTemp} and not hasNoInit(ri): + 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: - resetLoc(p, d) - app(pl, addrLoc(d)) + discard "resetLoc(p, d)" + pl.add(addrLoc(p.config, d)) genCallPattern() + if canRaise: raiseExit(p) else: - var tmp: TLoc - getTemp(p, typ.sons[0], tmp) - app(pl, addrLoc(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.t, OnUnknown) - list.r = ropef(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; result: var Rope; + argsCounter: var int) = + if i < typ.n.len: + # 'var T' is 'T&' in C++. This means we ignore the request of + # any nkHiddenAddr when it's a 'var T'. + let paramType = typ.n[i] + assert(paramType.kind == nkSym) + if paramType.typ.isCompileTimeOnly: + 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: + 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") + else: + if argsCounter > 0: result.add ", " + genArgNoParam(p, ri[i], result) + inc argsCounter + +discard """ +Dot call syntax in C++ +====================== + +so c2nim translates 'this' sometimes to 'T' and sometimes to 'var T' +both of which are wrong, but often more convenient to use. +For manual wrappers it can also be 'ptr T' + +Fortunately we know which parameter is the 'this' parameter and so can fix this +mess in the codegen. +now ... if the *argument* is a 'ptr' the codegen shall emit -> and otherwise . +but this only depends on the argument and not on how the 'this' was declared +however how the 'this' was declared affects whether we end up with +wrong 'addr' and '[]' ops... + +Since I'm tired I'll enumerate all the cases here: + +var + x: ptr T + y: T + +proc t(x: T) +x[].t() --> (*x).t() is correct. +y.t() --> y.t() is correct + +proc u(x: ptr T) +x.u() --> needs to become x->u() +(addr y).u() --> needs to become y.u() + +proc v(x: var T) +--> first skip the implicit 'nkAddr' node +x[].v() --> (*x).v() is correct, but might have been eliminated due + to the nkAddr node! So for this case we need to generate '->' +y.v() --> y.v() is correct + +""" + +proc skipAddrDeref(node: PNode): PNode = + var n = node + var isAddr = false + case n.kind + of nkAddr, nkHiddenAddr: + n = n[0] + isAddr = true + of nkDerefExpr, nkHiddenDeref: + n = n[0] + else: return n + if n.kind == nkObjDownConv: n = n[0] + if isAddr and n.kind in {nkDerefExpr, nkHiddenDeref}: + result = n[0] + elif n.kind in {nkAddr, nkHiddenAddr}: + result = n[0] + else: + result = node + +proc genThisArg(p: BProc; ri: PNode; i: int; typ: PType; result: var Rope) = + # for better or worse c2nim translates the 'this' argument to a 'var T'. + # However manual wrappers may also use 'ptr T'. In any case we support both + # for convenience. + internalAssert p.config, i < typ.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[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: + genArgNoParam(p, x, result) + result.add("->") + elif x.kind in {nkHiddenDeref, nkDerefExpr} and x[0].typ.kind == tyPtr: + genArgNoParam(p, x[0], result) + result.add("->") + else: + genArgNoParam(p, x, result) + result.add(".") + elif t.kind == tyPtr: + if ri.kind in {nkAddr, nkHiddenAddr}: + genArgNoParam(p, ri[0], result) + result.add(".") + else: + genArgNoParam(p, ri, result) + result.add("->") + else: + ri = skipAddrDeref(ri) + if ri.kind in {nkAddr, nkHiddenAddr}: ri = ri[0] + genArgNoParam(p, ri, result) #, typ.n[i].sym) + result.add(".") + +proc genPatternCall(p: BProc; ri: PNode; pat: string; typ: PType; result: var Rope) = + var i = 0 + var j = 1 + while i < pat.len: + case pat[i] + of '@': + var argsCounter = 0 + for k in j..<ri.len: + genOtherArg(p, ri, k, typ, result, argsCounter) + inc i + of '#': + if i+1 < pat.len and pat[i+1] in {'+', '@'}: + let ri = ri[j] + if ri.kind in nkCallKinds: + let typ = skipTypes(ri[0].typ, abstractInst) + if pat[i+1] == '+': genArgNoParam(p, ri[0], result) + result.add("(") + if 1 < ri.len: + 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 i+1 < pat.len and pat[i+1] == '.': + genThisArg(p, ri, j, typ, result) + inc i + elif i+1 < pat.len and pat[i+1] == '[': + var arg = ri[j].skipAddrDeref + while arg.kind in {nkAddr, nkHiddenAddr, nkObjDownConv}: arg = arg[0] + genArgNoParam(p, arg, result) + #result.add debugTree(arg, 0, 10) + else: + var argsCounter = 0 + genOtherArg(p, ri, j, typ, result, argsCounter) + inc j + inc i + of '\'': + var idx, stars: int = 0 + if scanCppGenericSlot(pat, i, idx, stars): + var t = resolveStarsInCppType(typ, idx, stars) + if t == nil: result.add("void") + else: result.add(getTypeDesc(p.module, t)) + else: + let start = i + while i < pat.len: + if pat[i] notin {'@', '#', '\''}: inc(i) + else: break + if i - 1 >= start: + result.add(substr(pat, start, i - 1)) + proc genInfixCall(p: BProc, le, ri: PNode, d: var TLoc) = - var op, a: TLoc - initLocExpr(p, ri.sons[0], op) - var pl: PRope = nil + 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)) - - var param = typ.n.sons[1].sym - app(pl, genArg(p, ri.sons[1], param)) - - if skipTypes(param.typ, {tyGenericInst}).kind == tyPtr: app(pl, ~"->") - else: app(pl, ~".") - app(pl, op.r) - var params: PRope - for i in countup(2, length - 1): - if params != nil: params.app(~", ") - assert(sonsLen(typ) == sonsLen(typ.n)) - if i < sonsLen(typ): - assert(typ.n.sons[i].kind == nkSym) - app(params, genArg(p, ri.sons[i], typ.n.sons[i].sym)) + # don't call '$' here for efficiency: + let pat = $ri[0].sym.loc.snippet + internalAssert p.config, pat.len > 0 + if pat.contains({'#', '(', '@', '\''}): + var pl = newRopeAppender() + genPatternCall(p, ri, pat, typ, pl) + # simpler version of 'fixupCall' that works with the pl+params combination: + var typ = skipTypes(ri[0].typ, abstractInst) + if typ.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.snippet = pl + excl d.flags, lfSingleUse + else: + if d.k == locNone: d = getTemp(p, typ.returnType) + assert(d.t != nil) # generate an assignment to d: + var list: TLoc = initLoc(locCall, d.lode, OnUnknown) + list.snippet = pl + genAssignment(p, d, list, {}) # no need for deep copying else: - app(params, genArgNoParam(p, ri.sons[i])) - fixupCall(p, le, ri, d, pl, params) + pl.add(";\n") + line(p, cpsStmts, pl) + else: + var pl = newRopeAppender() + var argsCounter = 0 + if 1 < ri.len: + 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, a: 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)) - - if length > 1: - app(pl, genArg(p, ri.sons[1], typ.n.sons[1].sym)) - app(pl, ~" ") - app(pl, op.r) - if length > 2: - app(pl, ~": ") - app(pl, genArg(p, ri.sons[2], typ.n.sons[2].sym)) - for i in countup(3, length-1): - assert(sonsLen(typ) == sonsLen(typ.n)) - if i >= sonsLen(typ): - InternalError(ri.info, "varargs for objective C method?") - assert(typ.n.sons[i].kind == nkSym) - var param = typ.n.sons[i].sym - app(pl, ~" ") - app(pl, param.name.s) - app(pl, ~": ") - app(pl, genArg(p, ri.sons[i], param)) - if typ.sons[0] != nil: - if isInvalidReturnType(typ.sons[0]): - if sonsLen(ri) > 1: app(pl, ~" ") + + # don't call '$' here for efficiency: + let pat = $ri[0].sym.loc.snippet + internalAssert p.config, pat.len > 0 + var start = 3 + if ' ' in pat: + start = 1 + pl.add(op.snippet) + if ri.len > 1: + pl.add(": ") + genArg(p, ri[1], typ.n[1].sym, ri, pl) + start = 2 + else: + 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[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) - app(pl, ~"Result: ") - app(pl, addrLoc(d)) - app(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) - app(pl, addrLoc(tmp)) - app(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: - app(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, nil, OnUnknown) - list.r = pl + var list: TLoc = initLoc(locCall, ri, OnUnknown) + list.snippet = pl genAssignment(p, d, list, {}) # no need for deep copying else: - app(pl, ~"];$n") + pl.add("];\n") line(p, cpsStmts, pl) -proc genCall(p: BProc, e: PNode, d: var TLoc) = - if e.sons[0].typ.callConv == ccClosure: - genClosureCall(p, nil, e, d) - elif e.sons[0].kind == nkSym and sfInfixCall in e.sons[0].sym.flags and - e.len >= 2: - 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) - when false: - if d.s == onStack and containsGarbageCollectedRef(d.t): keepAlive(p, d) +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.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 and - ri.len >= 2: + 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) - when false: - if d.s == onStack and containsGarbageCollectedRef(d.t): keepAlive(p, d) +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 bb1035ab6..545d43ae8 100644 --- a/compiler/ccgexprs.nim +++ b/compiler/ccgexprs.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2013 Andreas Rumpf # # See the file "copying.txt", included in this @@ -9,135 +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 intLiteral(i: biggestInt): PRope = - if (i > low(int32)) and (i <= high(int32)): - result = toRope(i) - elif i == low(int32): - # Nimrod has the same bug for the same reasons :-) - result = ~"(-2147483647 -1)" - elif i > low(int64): - result = rfmt(nil, "IL64($1)", toRope(i)) - else: - result = ~"(IL64(-9223372036854775807) - IL64(1))" +proc rdSetElemLoc(conf: ConfigRef; a: TLoc, typ: PType; result: var Rope) -proc int32Literal(i: Int): PRope = - if i == int(low(int32)): - result = ~"(-2147483647 -1)" +proc int64Literal(i: BiggestInt; result: var Rope) = + if i > low(int64): + result.add "IL64($1)" % [rope(i)] else: - result = toRope(i) + result.add "(IL64(-9223372036854775807) - IL64(1))" + +proc uint64Literal(i: uint64; result: var Rope) = result.add rope($i & "ULL") -proc genHexLiteral(v: PNode): PRope = - # hex literals are unsigned in C - # so we don't generate hex literals any longer. - if not (v.kind in {nkIntLit..nkUInt64Lit}): - internalError(v.info, "genHexLiteral") - result = intLiteral(v.intVal) +proc intLiteral(i: BiggestInt; result: var Rope) = + if i > low(int32) and i <= high(int32): + result.add rope(i) + elif i == low(int32): + # Nim has the same bug for the same reasons :-) + result.add "(-2147483647 -1)" + elif i > low(int64): + result.add "IL64($1)" % [rope(i)] + else: + result.add "(IL64(-9223372036854775807) - IL64(1))" -proc getStrLit(m: BModule, s: string): PRope = - discard cgsym(m, "TGenericSeq") - result = con("TMP", toRope(backendId())) - appf(m.s[cfsData], "STRING_LITERAL($1, $2, $3);$n", - [result, makeCString(s), ToRope(len(s))]) +proc intLiteral(i: Int128; result: var Rope) = + intLiteral(toInt64(i), result) -proc genLiteral(p: BProc, n: PNode, ty: PType): PRope = - if ty == nil: internalError(n.info, "genLiteral: ty is nil") +proc genLiteral(p: BProc, n: PNode, ty: PType; result: var Rope) = case n.kind of nkCharLit..nkUInt64Lit: - case skipTypes(ty, abstractVarRange).kind - of tyChar, tyInt64, tyNil: - result = intLiteral(n.intVal) - of tyInt: - if (n.intVal >= low(int32)) and (n.intVal <= high(int32)): - result = int32Literal(int32(n.intVal)) - else: - result = intLiteral(n.intVal) + 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: + intLiteral(n.intVal, result) of tyBool: - if n.intVal != 0: result = ~"NIM_TRUE" - else: result = ~"NIM_FALSE" + 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 = ropef("(($1) $2)", [getTypeDesc(p.module, - skipTypes(ty, abstractVarRange)), 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: - var id = NodeTableTestOrSet(p.module.dataCache, n, gBackendId) - result = con("TMP", toRope(id)) - if id == gBackendId: + 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) + let tmpName = p.module.tmpBase & rope(id) + if id == p.module.labels: # not found in cache: - inc(gBackendId) - appf(p.module.s[cfsData], + inc(p.module.labels) + p.module.s[cfsStrData].addf( "static NIM_CONST $1 $2 = {NIM_NIL,NIM_NIL};$n", - [getTypeDesc(p.module, t), result]) + [getTypeDesc(p.module, ty), tmpName]) + result.add tmpName + elif k in {tyPointer, tyNil, tyProc}: + result.add rope("NIM_NIL") else: - result = toRope("NIM_NIL") + result.add "(($1) NIM_NIL)" % [getTypeDesc(p.module, ty)] of nkStrLit..nkTripleStrLit: - if skipTypes(ty, abstractVarRange).kind == tyString: - var id = NodeTableTestOrSet(p.module.dataCache, n, gBackendId) - if id == gBackendId: - # string literal not found in the cache: - result = ropecg(p.module, "((#NimStringDesc*) &$1)", - [getStrLit(p.module, n.strVal)]) + let k = if ty == nil: tyString + else: skipTypes(ty, abstractVarRange + {tyStatic, tyUserTypeClass, tyUserTypeClassInst}).kind + case k + of tyNil: + genNilStringLiteral(p.module, n.info, result) + of tyString: + # with the new semantics for not 'nil' strings, we can map "" to nil and + # save tons of allocations: + if n.strVal.len == 0 and optSeqDestructors notin p.config.globalOptions: + genNilStringLiteral(p.module, n.info, result) else: - result = ropecg(p.module, "((#NimStringDesc*) &TMP$1)", [toRope(id)]) + genStringLiteral(p.module, n, result) + else: + result.add makeCString(n.strVal) + of nkFloatLit, nkFloat64Lit: + if ty.kind == tyFloat32: + result.add rope(n.floatVal.float32.toStrMaxPrecision) else: - result = makeCString(n.strVal) - of nkFloatLit..nkFloat64Lit: - result = toRope(n.floatVal.ToStrMaxPrecision) + result.add rope(n.floatVal.toStrMaxPrecision) + of nkFloat32Lit: + result.add rope(n.floatVal.float32.toStrMaxPrecision) else: - InternalError(n.info, "genLiteral(" & $n.kind & ')') - result = nil + internalError(p.config, n.info, "genLiteral(" & $n.kind & ')') -proc genLiteral(p: BProc, n: PNode): PRope = - result = genLiteral(p, n, n.typ) +proc genLiteral(p: BProc, n: PNode; result: var Rope) = + genLiteral(p, n, n.typ, result) -proc bitSetToWord(s: TBitSet, size: int): 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 genRawSetData(cs: TBitSet, size: int): PRope = - var frmt: TFormatStr +proc genRawSetData(cs: TBitSet, size: int; result: var Rope) = if size > 8: - result = ropef("{$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" - appf(result, frmt, [toRope(toHex(Ze64(cs[i]), 2))]) + res.add "}\n" + + result.add rope(res) else: - result = intLiteral(bitSetToWord(cs, size)) - # result := toRope('0x' + ToHex(bitSetToWord(cs, size), size * 2)) + intLiteral(cast[BiggestInt](bitSetToWord(cs, size)), result) -proc genSetNode(p: BProc, n: PNode): PRope = - var cs: TBitSet - var size = int(getSize(n.typ)) - toBitSet(n, cs) +proc genSetNode(p: BProc, n: PNode; result: var Rope) = + var size = int(getSize(p.config, n.typ)) + let cs = toBitSet(p.config, n) if size > 8: - var id = NodeTableTestOrSet(p.module.dataCache, n, gBackendId) - result = con("TMP", toRope(id)) - if id == gBackendId: + let id = nodeTableTestOrSet(p.module.dataCache, n, p.module.labels) + let tmpName = p.module.tmpBase & rope(id) + if id == p.module.labels: # not found in cache: - inc(gBackendId) - appf(p.module.s[cfsData], "static NIM_CONST $1 $2 = $3;$n", - [getTypeDesc(p.module, n.typ), result, genRawSetData(cs, size)]) + inc(p.module.labels) + 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 @@ -146,51 +159,50 @@ proc getStorageLoc(n: PNode): TStorageLoc = of skVar, skForVar, skResult, skLet: if sfGlobal in n.sym.flags: result = OnHeap else: result = OnStack - of skConst: + of skConst: if sfGlobal in n.sym.flags: result = OnHeap else: result = OnUnknown else: result = OnUnknown of nkDerefExpr, nkHiddenDeref: - case n.sons[0].typ.kind - of tyVar: result = OnUnknown + case n[0].typ.kind + of tyVar, tyLent: result = OnUnknown of tyPtr: result = OnStack of tyRef: result = OnHeap - else: InternalError(n.info, "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 genRefAssign(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = - if dest.s == OnStack or not usesNativeGC(): - linefmt(p, cpsStmts, "$1 = $2;$n", rdLoc(dest), rdLoc(src)) - if needToKeepAlive in flags: keepAlive(p, dest) - elif dest.s == 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(dest), rdLoc(src)) - else: - linefmt(p, cpsStmts, "#asgnRefNoCycle((void**) $1, $2);$n", - addrLoc(dest), rdLoc(src)) +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 + # generation! + 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) = + 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: + linefmt(p, cpsStmts, "#asgnRef((void**) $1, $2);$n", + [addrLoc(p.config, dest), rdLoc(src)]) else: linefmt(p, cpsStmts, "#unsureAsgnRef((void**) $1, $2);$n", - addrLoc(dest), rdLoc(src)) - if needToKeepAlive in flags: keepAlive(p, dest) + [addrLoc(p.config, dest), rdLoc(src)]) proc asgnComplexity(n: PNode): int = if n != nil: @@ -200,148 +212,265 @@ 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: nil + else: result = 0 + else: + result = 0 -proc optAsgnLoc(a: TLoc, t: PType, field: PRope): TLoc = - result.k = locField - result.s = a.s - result.t = t - result.r = rdLoc(a).con(".").con(field) - result.heapRoot = a.heapRoot +proc optAsgnLoc(a: TLoc, t: PType, field: Rope): TLoc = + 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) = - for i in 0 .. <dest.t.len: - let t = dest.t.sons[i] - let field = ropef("Field$1", i.toRope) - genAssignment(p, optAsgnLoc(dest, t, field), - optAsgnLoc(src, t, field), flags) + let newflags = + if src.storage == OnStatic: + flags + {needToCopy} + elif tfShallow in dest.t.flags: + flags - {needToCopy} + else: + flags + let t = skipTypes(dest.t, abstractInst).getUniqueType() + for i, t in t.ikids: + let field = "Field$1" % [i.rope] + genAssignment(p, optAsgnLoc(dest, t, field), + optAsgnLoc(src, t, field), newflags) proc genOptAsgnObject(p: BProc, dest, src: TLoc, flags: TAssignmentFlags, - t: PNode) = + t: PNode, typ: PType) = if t == nil: return + let newflags = + if src.storage == OnStatic: + flags + {needToCopy} + elif tfShallow in dest.t.flags: + flags - {needToCopy} + else: + flags case t.kind of nkSym: let field = t.sym - genAssignment(p, optAsgnLoc(dest, field.typ, field.loc.r), - optAsgnLoc(src, field.typ, field.loc.r), flags) + 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, flags, child) - else: nil + for child in items(t): genOptAsgnObject(p, dest, src, newflags, child, typ) + else: discard proc genGenericAsgn(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = - # Consider: + # Consider: # type TMyFastString {.shallow.} = string # Due to the implementation of pragmas this would end up to set the # 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.s == OnStack or not usesNativeGC(): + 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(dest), addrLoc(src), rdLoc(dest)) - if needToKeepAlive in flags: keepAlive(p, 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(dest), addrLoc(src), genTypeInfo(p.module, dest.t)) + [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(dest), addrLoc(src), genTypeInfo(p.module, dest.t)) + [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 - var ty = skipTypes(dest.t, abstractRange) + 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: - 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(dest), rdLoc(src), genTypeInfo(p.module, dest.t)) + [addrLoc(p.config, dest), rdLoc(src), + genTypeInfoV1(p.module, dest.t, dest.lode.info)]) of tyString: - if needToCopy notin flags: - 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.s == OnStack or not usesNativeGC(): - linefmt(p, cpsStmts, "$1 = #copyString($2);$n", dest.rdLoc, src.rdLoc) - if needToKeepAlive in flags: keepAlive(p, dest) - elif dest.s == OnHeap: + 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(dest), rdLoc(src)) - if needToKeepAlive in flags: keepAlive(p, dest) + [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, "ClEnv".toRope) - let b = optAsgnLoc(src, dest.t, "ClEnv".toRope) - genRefAssign(p, a, b, flags) - linefmt(p, cpsStmts, "$1.ClPrc = $2.ClPrc;$n", rdLoc(dest), rdLoc(src)) + let a = optAsgnLoc(dest, dest.t, "ClE_0".rope) + let b = optAsgnLoc(src, dest.t, "ClE_0".rope) + 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 needsComplexAssignment(dest.t): - if asgnComplexity(dest.t.n) <= 4: - discard getTypeDesc(p.module, dest.t) - genOptAsgnObject(p, dest, src, flags, dest.t.n) + if ty.isImportedCppType: + linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) + elif not isObjLackingTypeField(ty): + genGenericAsgn(p, dest, src, flags) + 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)) - of tyArray, tyArrayConstr: - if needsComplexAssignment(dest.t): + linefmt(p, cpsStmts, "$1 = $2;$n", [rdLoc(dest), rdLoc(src)]) + of tyArray: + if containsGarbageCollectedRef(dest.t) and p.config.selectedGC notin {gcArc, gcAtomicArc, gcOrc, gcHooks}: genGenericAsgn(p, dest, src, flags) else: linefmt(p, cpsStmts, - "memcpy((void*)$1, (NIM_CONST void*)$2, sizeof($1));$n", - rdLoc(dest), rdLoc(src)) + "#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, $1Len0, $3);$n", - addrLoc(dest), addrLoc(src), genTypeInfo(p.module, dest.t)) + "#genericAssignOpenArray((void*)$1, (void*)$2, $1Len_0, $3);$n", + [addrLoc(p.config, dest), addrLoc(p.config, src), + genTypeInfoV1(p.module, dest.t, dest.lode.info)]) else: linefmt(p, cpsStmts, - "memcpy((void*)$1, (NIM_CONST void*)$2, sizeof($1[0])*$1Len0);$n", - rdLoc(dest), rdLoc(src)) + # 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)]) of tySet: - if mapType(ty) == ctArray: - linefmt(p, cpsStmts, "memcpy((void*)$1, (NIM_CONST void*)$2, $3);$n", - rdLoc(dest), rdLoc(src), toRope(getSize(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, 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), getSize(p.config, dest.t), + makeCString(toFullPath(p.config, p.currLineInfo)), + 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) + genAssignment(p, tmp, a, {}) + addrLoc(p.config, tmp) else: - linefmt(p, cpsStmts, "$1 = $2;$n", rdLoc(dest), rdLoc(src)) - of tyPtr, tyPointer, tyChar, tyBool, tyEnum, tyCString, - tyInt..tyUInt64, tyRange, tyVar: - linefmt(p, cpsStmts, "$1 = $2;$n", rdLoc(dest), rdLoc(src)) - else: InternalError("genAssignment(" & $ty.kind & ')') + addrLoc(p.config, a) -proc getDestLoc(p: BProc, d: var TLoc, typ: PType) = - if d.k == locNone: getTemp(p, typ, d) + 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), + genTypeInfoV1(p.module, dest.t, dest.lode.info)]) + of tySequence, tyString: + 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, $2->Field1, $3);$n", + [addrLoc(p.config, dest), source, + genTypeInfoV1(p.module, dest.t, dest.lode.info)]) + of tySet: + if mapSetType(p.config, ty) == ctArray: + 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, + tyInt..tyUInt64, tyRange, tyVar, tyLent: + 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) = if d.k != locNone: @@ -350,453 +479,666 @@ proc putLocIntoDest(p: BProc, d: var TLoc, s: TLoc) = else: d = s # ``d`` is free, so fill it with ``s`` -proc putIntoDest(p: BProc, d: var TLoc, t: PType, r: PRope) = - var a: TLoc +proc putDataIntoDest(p: BProc, d: var TLoc, n: PNode, r: Rope) = if d.k != locNone: + var a: TLoc = initLoc(locData, n, OnStatic) # need to generate an assignment here - initLoc(a, locExpr, getUniqueType(t), OnUnknown) - a.r = r + a.snippet = r if lfNoDeepCopy in d.flags: genAssignment(p, d, a, {}) else: genAssignment(p, d, a, {needToCopy}) else: # we cannot call initLoc() here as that would overwrite # the flags field! - d.k = locExpr - d.t = getUniqueType(t) - d.r = r - d.a = -1 - -proc binaryStmt(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a, b: TLoc - if d.k != locNone: InternalError(e.info, "binaryStmt") - InitLocExpr(p, e.sons[1], a) - InitLocExpr(p, e.sons[2], b) - lineCg(p, cpsStmts, frmt, rdLoc(a), rdLoc(b)) + d.k = locData + d.lode = n + d.snippet = r -proc unaryStmt(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a: TLoc - if d.k != locNone: InternalError(e.info, "unaryStmt") - InitLocExpr(p, e.sons[1], a) +proc putIntoDest(p: BProc, d: var TLoc, n: PNode, r: Rope; s=OnUnknown) = + if d.k != locNone: + # need to generate an assignment here + 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: + # we cannot call initLoc() here as that would overwrite + # the flags field! + d.k = locExpr + d.lode = n + d.snippet = r + +proc binaryStmt(p: BProc, e: PNode, d: var TLoc, op: string) = + if d.k != locNone: internalError(p.config, e.info, "binaryStmt") + var a = initLocExpr(p, e[1]) + var b = initLocExpr(p, e[2]) + lineCg(p, cpsStmts, "$1 $2 $3;$n", [rdLoc(a), op, rdLoc(b)]) + +proc binaryStmtAddr(p: BProc, e: PNode, d: var TLoc, cpname: string) = + 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") + var a: TLoc = initLocExpr(p, e[1]) lineCg(p, cpsStmts, frmt, [rdLoc(a)]) -proc binaryStmtChar(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a, b: TLoc - if (d.k != locNone): InternalError(e.info, "binaryStmtChar") - InitLocExpr(p, e.sons[1], a) - InitLocExpr(p, e.sons[2], b) - lineCg(p, cpsStmts, frmt, [rdCharLoc(a), rdCharLoc(b)]) - -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) - putIntoDest(p, d, e.typ, 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) - putIntoDest(p, d, e.typ, 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) - putIntoDest(p, d, e.typ, 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) - putIntoDest(p, d, e.typ, ropecg(p.module, frmt, [rdCharLoc(a)])) +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)])) + +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])) + +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)])) + +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)])) + +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) + 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}: + 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..mModi64, string] = ["addInt", "subInt", "mulInt", - "divInt", "modInt", "addInt64", "subInt64", "mulInt64", "divInt64", - "modInt64"] - opr: array[mAddi..mModi64, 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) - var t = skipTypes(e.typ, abstractRange) - if optOverflowCheck notin p.options: - putIntoDest(p, d, e.typ, ropef("(NI$4)($2 $1 $3)", [toRope(opr[m]), - rdLoc(a), rdLoc(b), toRope(getSize(t) * 8)])) - else: - var storage: PRope - var size = getSize(t) - if size < platform.IntSize: - storage = toRope("NI") - else: - storage = getTypeDesc(p.module, t) - var tmp = getTempName() - linefmt(p, cpsLocals, "$1 $2;$n", storage, tmp) - lineCg(p, cpsStmts, "$1 = #$2($3, $4);$n", - tmp, toRope(prc[m]), rdLoc(a), rdLoc(b)) - if size < platform.IntSize or t.kind in {tyRange, tyEnum, tySet}: - linefmt(p, cpsStmts, "if ($1 < $2 || $1 > $3) #raiseOverflow();$n", - tmp, intLiteral(firstOrd(t)), intLiteral(lastOrd(t))) - putIntoDest(p, d, e.typ, ropef("(NI$1)($2)", [toRope(getSize(t)*8), tmp])) + prc: array[mAddI..mPred, string] = [ + "nimAddInt", "nimSubInt", + "nimMulInt", "nimDivInt", "nimModInt", + "nimAddInt", "nimSubInt" + ] + prc64: array[mAddI..mPred, string] = [ + "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 or (m in {mSucc, mPred} and t.kind in {tyUInt..tyUInt64}): + let res = "($1)($2 $3 $4)" % [getTypeDesc(p.module, e.typ), rdLoc(a), rope(opr[m]), rdLoc(b)] + putIntoDest(p, d, e, res) + else: + # we handle div by zero here so that we know that the compilerproc's + # result is only for overflows. + var needsOverflowCheck = true + if m in {mDivI, mModI}: + 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..mAbsI64, string] = [ - mUnaryMinusI: "((NI$2)-($1))", - mUnaryMinusI64: "-($1)", - mAbsI: "(NI$2)abs($1)", - mAbsI64: "($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(t))) - putIntoDest(p, d, e.typ, ropef(opr[m], [rdLoc(a), toRope(getSize(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] = [ - "($1 + $2)", # AddF64 - "($1 - $2)", # SubF64 - "($1 * $2)", # MulF64 - "($1 / $2)", # DivF64 - "($4)((NU$3)($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 - "($4)((NU64)($1) >> (NU64)($2))", # ShrI64 - "($4)((NU64)($1) << (NU64)($2))", # ShlI64 - "($4)($1 & $2)", # BitandI64 - "($4)($1 | $2)", # BitorI64 - "($4)($1 ^ $2)", # BitxorI64 - "(($1 <= $2) ? $1 : $2)", # MinI64 - "(($1 >= $2) ? $1 : $2)", # MaxI64 - "(($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)", # EqI64 - "($1 <= $2)", # LeI64 - "($1 < $2)", # LtI64 - "($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)", # EqCString - "($1 != $2)"] # Xor var - a, b: TLoc - s: 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(a.t), getSize(b.t)) * 8 - putIntoDest(p, d, e.typ, - ropef(binArithTab[op], [rdLoc(a), rdLoc(b), toRope(s), - getSimpleTypeDesc(p.module, e.typ)])) + s = max(getSize(p.config, a.t), getSize(p.config, b.t)) * 8 + k = getSize(p.config, a.t) * 8 + + 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.callConv == ccClosure: - putIntoDest(p, d, e.typ, - ropef("($1.ClPrc == $2.ClPrc && $1.ClEnv == $2.ClEnv)", [ - rdLoc(a), rdLoc(b)])) + 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.typ, ropef("($1 == $2)", [rdLoc(a), rdLoc(b)])) + 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.ClPrc == 0") + unaryExpr(p, e, d, "($1.ClP_0 == 0)") else: - unaryExpr(p, e, d, "$1 == 0") + 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", # UnaryPlusI64 - "($3)((NU$2) ~($1))", # BitnotI64 - "$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.typ, - ropef(unArithTab[op], [rdLoc(a), toRope(getSize(t) * 8), - getSimpleTypeDesc(p.module, e.typ)])) + + 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, abstractInstOwned).kind in {tyVar} and + tfVarIsPtr notin skipTypes(typ, abstractInstOwned).flags proc genDeref(p: BProc, e: PNode, d: var TLoc) = - var a: TLoc - if mapType(e.sons[0].typ) == ctArray: + 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? - expr(p, e.sons[0], d) - else: - initLocExpr(p, e.sons[0], a) - case skipTypes(a.t, abstractInst).kind - of tyRef: - d.s = OnHeap - of tyVar: - d.s = OnUnknown - of tyPtr: - d.s = OnUnknown # BUGFIX! - else: InternalError(e.info, "genDeref " & $a.t.kind) - putIntoDest(p, d, a.t.sons[0], ropef("(*$1)", [rdLoc(a)])) + expr(p, e[0], d) + if e[0].typ.skipTypes(abstractInstOwned).kind == tyRef: + d.storage = OnHeap + else: + var a: TLoc + var typ = e[0].typ + if typ.kind in {tyUserTypeClass, tyUserTypeClassInst} and typ.isResolvedUserTypeClass: + 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: + 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 + # been assigned to. + case typ.kind + of tyRef: + d.storage = OnHeap + of tyVar, tyLent: + d.storage = OnUnknown + if tfVarIsPtr notin typ.flags and p.module.compileToCpp and + e.kind == nkHiddenDeref: + putIntoDest(p, d, e, rdLoc(a), a.storage) + return + of tyPtr: + d.storage = OnUnknown # BUGFIX! + else: + internalError(p.config, e.info, "genDeref " & $typ.kind) + elif p.module.compileToCpp: + if typ.kind in {tyVar} and tfVarIsPtr notin typ.flags and + e.kind == nkHiddenDeref: + putIntoDest(p, d, e, rdLoc(a), a.storage) + return + 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, 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.typ, con("&", a.r)) + 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(e.sons[0].typ) == ctArray: - 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) - putIntoDest(p, d, e.typ, addrLoc(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.s = a.s - if d.heapRoot == nil: - d.heapRoot = if a.heapRoot != nil: a.heapRoot else: a.r - -proc genRecordFieldAux(p: BProc, e: PNode, d, a: var TLoc): PType = - initLocExpr(p, e.sons[0], a) - if e.sons[1].kind != nkSym: InternalError(e.info, "genRecordFieldAux") + if d.k == locNone: d.storage = a.storage + +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 - result = a.t proc genTupleElem(p: BProc, e: PNode, d: var TLoc) = var - a: TLoc - i: int - initLocExpr(p, e.sons[0], a) + i: int = 0 + var a: TLoc = initLocExpr(p, e[0]) + let tupType = a.t.skipTypes(abstractInst+{tyVar}) + assert tupType.kind == tyTuple d.inheritLocation(a) discard getTypeDesc(p.module, a.t) # fill the record's fields.loc - var ty = a.t var r = rdLoc(a) - case e.sons[1].kind - of nkIntLit..nkUInt64Lit: i = int(e.sons[1].intVal) - else: internalError(e.info, "genTupleElem") - when false: - if ty.n != nil: - var field = ty.n.sons[i].sym - if field == nil: InternalError(e.info, "genTupleElem") - if field.loc.r == nil: InternalError(e.info, "genTupleElem") - appf(r, ".$1", [field.loc.r]) - else: - appf(r, ".Field$1", [toRope(i)]) - putIntoDest(p, d, ty.sons[i], r) + case e[1].kind + of nkIntLit..nkUInt64Lit: i = int(e[1].intVal) + else: internalError(p.config, e.info, "genTupleElem") + 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 != "" + while ty != nil: + ty = ty.skipTypes(skipPtrs) + assert(ty.kind in {tyTuple, tyObject}) + result = lookupInRecord(ty.n, field.name) + if result != nil: + if resTyp != nil: resTyp[] = ty + break + 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 ty = genRecordFieldAux(p, e, d, a) + 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 + 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 - appf(r, ".Field$1", [toRope(f.position)]) - putIntoDest(p, d, f.typ, r) - else: - var field: PSym = nil - while ty != nil: - if ty.kind notin {tyTuple, tyObject}: - InternalError(e.info, "genRecordField") - field = lookupInRecord(ty.n, f.name) - if field != nil: break - if gCmd != cmdCompileToCpp: app(r, ".Sup") - ty = GetUniqueType(ty.sons[0]) - if field == nil: InternalError(e.info, "genRecordField 2 ") - if field.loc.r == nil: InternalError(e.info, "genRecordField 3") - appf(r, ".$1", [field.loc.r]) - putIntoDest(p, d, field.typ, r) + r.add ".Field" + r.add rope(f.position) + putIntoDest(p, d, e, r, a.storage) + else: + var rtyp: PType = nil + let field = lookupFieldAgain(p, ty, f, r, addr rtyp) + 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: PRope, field: PSym) = +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] - assert(it.sons[2].kind == nkSym) - initLoc(test, locNone, it.typ, OnStack) - InitLocExpr(p, it.sons[1], u) - initLoc(v, locExpr, it.sons[2].typ, OnUnknown) - v.r = ropef("$1.$2", [obj, it.sons[2].sym.loc.r]) + 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) + 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), gBackendId) - let strLit = if id == gBackendId: getStrLit(p.module, field.name.s) - else: con("TMP", toRope(id)) - if op.magic == mNot: - linefmt(p, cpsStmts, - "if ($1) #raiseFieldError(((#NimStringDesc*) &$2));$n", - rdLoc(test), strLit) + 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(((#NimStringDesc*) &$2));$n", - rdLoc(test), strLit) + # 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 - f, field: PSym - ty: PType - r: PRope - ty = genRecordFieldAux(p, e.sons[0], d, a) - r = rdLoc(a) - f = e.sons[0].sons[1].sym - field = nil - while ty != nil: - assert(ty.kind in {tyTuple, tyObject}) - field = lookupInRecord(ty.n, f.name) - if field != nil: break - if gCmd != cmdCompileToCpp: app(r, ".Sup") - ty = getUniqueType(ty.sons[0]) - if field == nil: InternalError(e.info, "genCheckedRecordField") - if field.loc.r == nil: - InternalError(e.info, "genCheckedRecordField") # generate the checks: + var a: TLoc = default(TLoc) + genRecordFieldAux(p, e[0], d, a) + let ty = skipTypes(a.t, abstractInst + tyUserTypeClasses) + var r = rdLoc(a) + let f = e[0][1].sym + let field = lookupFieldAgain(p, ty, f, r) + if field.loc.snippet == "": fillObjectFields(p.module, ty) + if field.loc.snippet == "": + internalError(p.config, e.info, "genCheckedRecordField") # generate the checks: genFieldCheck(p, e, r, field) - app(r, rfmt(nil, ".$1", field.loc.r)) - putIntoDest(p, d, field.typ, r) + 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 genArrayElem(p: BProc, e: PNode, d: var TLoc) = - var a, b: TLoc - initLocExpr(p, e.sons[0], a) - initLocExpr(p, e.sons[1], b) - var ty = skipTypes(skipTypes(a.t, abstractVarRange), abstractPtrs) - var first = intLiteral(firstOrd(ty)) +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 = initLocExpr(p, x) + var b = initLocExpr(p, y) + var ty = skipTypes(a.t, abstractVarRange + abstractPtrs + tyUserTypeClasses) + var first = newRopeAppender() + intLiteral(firstOrd(p.config, ty), first) # emit range check: - if (optBoundsCheck in p.options): - if not isConstExpr(e.sons[1]): + if optBoundsCheck in p.options and ty.kind != tyUncheckedArray: + if not isConstExpr(y): # semantic pass has already checked for const index expressions - if firstOrd(ty) == 0: - if (firstOrd(b.t) < firstOrd(ty)) or (lastOrd(b.t) > lastOrd(ty)): - linefmt(p, cpsStmts, "if ((NU)($1) > (NU)($2)) #raiseIndexError();$n", - rdCharLoc(b), intLiteral(lastOrd(ty))) + 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)): + 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(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(e.sons[1]) - if idx < firstOrd(ty) or idx > lastOrd(ty): - localError(e.info, errIndexOutOfBounds) + let idx = getOrdValue(y) + if idx < firstOrd(p.config, ty) or idx > lastOrd(p.config, ty): + localError(p.config, x.info, formatErrorIndexBound(idx, firstOrd(p.config, ty), lastOrd(p.config, ty))) d.inheritLocation(a) - putIntoDest(p, d, elemType(skipTypes(ty, abstractVar)), - rfmt(nil, "$1[($2)- $3]", rdLoc(a), rdCharLoc(b), first)) - -proc genCStringElem(p: BProc, e: PNode, d: var TLoc) = - var a, b: TLoc - initLocExpr(p, e.sons[0], a) - initLocExpr(p, e.sons[1], b) - var ty = skipTypes(a.t, abstractVarRange) - if d.k == locNone: d.s = a.s - putIntoDest(p, d, elemType(skipTypes(ty, abstractVar)), - rfmt(nil, "$1[$2]", rdLoc(a), rdCharLoc(b))) - -proc genOpenArrayElem(p: BProc, e: PNode, d: var TLoc) = - var a, b: TLoc - initLocExpr(p, e.sons[0], a) - initLocExpr(p, e.sons[1], b) # emit range check: - if optBoundsCheck in p.options: - linefmt(p, cpsStmts, "if ((NU)($1) >= (NU)($2Len0)) #raiseIndexError();$n", - rdLoc(b), rdLoc(a)) # BUGFIX: ``>=`` and not ``>``! - if d.k == locNone: d.s = a.s - putIntoDest(p, d, elemType(skipTypes(a.t, abstractVar)), - rfmt(nil, "$1[$2]", rdLoc(a), rdCharLoc(b))) - -proc genSeqElem(p: BPRoc, e: PNode, d: var TLoc) = - var a, b: TLoc - initLocExpr(p, e.sons[0], a) - initLocExpr(p, e.sons[1], b) - var ty = skipTypes(a.t, abstractVarRange) - if ty.kind in {tyRef, tyPtr}: - ty = skipTypes(ty.sons[0], abstractVarRange) # emit range check: - if optBoundsCheck in p.options: - if ty.kind == tyString: + putIntoDest(p, d, n, + 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 = initLocExpr(p, x) + var b = initLocExpr(p, y) + inheritLocation(d, a) + putIntoDest(p, d, n, + ropecg(p.module, "$1[$2]", [rdLoc(a), rdCharLoc(b)]), a.storage) + +proc genBoundsCheck(p: BProc; arr, a, b: TLoc; arrTyp: PType) = + let ty = arrTyp + case ty.kind + of tyOpenArray, tyVarargs: + if reifiedOpenArray(arr.lode): linefmt(p, cpsStmts, - "if ((NU)($1) > (NU)($2->$3)) #raiseIndexError();$n", - rdLoc(b), rdLoc(a), lenField()) + "if ($2-$1 != -1 && " & + "($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 ((NU)($1) >= (NU)($2->$3)) #raiseIndexError();$n", - rdLoc(b), rdLoc(a), lenField()) - if d.k == locNone: d.s = OnHeap - d.heapRoot = a.r + "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 && " & + "($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 = 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 = initLocExpr(p, x) + var b = initLocExpr(p, y) + var ty = skipTypes(a.t, abstractVarRange) + if ty.kind in {tyRef, tyPtr}: + ty = skipTypes(ty.elementType, abstractVarRange) + # emit range check: + if optBoundsCheck in p.options: + 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 = rfmt(nil, "(*$1)", a.r) - putIntoDest(p, d, elemType(skipTypes(a.t, abstractVar)), - rfmt(nil, "$1->data[$2]", rdLoc(a), rdCharLoc(b))) + 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$3[$2]", [rdLoc(a), rdCharLoc(b), dataField(p)]), a.storage) + +proc genBracketExpr(p: BProc; n: PNode; d: var TLoc) = + var ty = skipTypes(n[0].typ, abstractVarRange + tyUserTypeClasses) + if ty.kind in {tyRef, tyPtr}: ty = skipTypes(ty.elementType, abstractVarRange) + case ty.kind + of tyUncheckedArray: genUncheckedArrayElem(p, n, n[0], n[1], d) + of tyArray: genArrayElem(p, n, n[0], n[1], d) + of tyOpenArray, tyVarargs: genOpenArrayElem(p, n, n[0], n[1], d) + of tySequence, tyString: genSeqElem(p, n, n[0], n[1], d) + of tyCstring: genCStringElem(p, n, n[0], n[1], d) + of 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? @@ -819,37 +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! - 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 + 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. - var args: PRope = nil - var a: TLoc - for i in countup(1, n.len-1): - initLocExpr(p, n.sons[i], a) - appf(args, ", ($1)->data", [rdLoc(a)]) - linefmt(p, cpsStmts, "printf($1$2);$n", - makeCString(repeatStr(n.len-1, "%s") & tnl), args) + internalAssert p.config, n.kind == nkBracket + if p.config.target.targetOS == osGenode: + # echo directly to the Genode LOG session + var args: Rope = "" + var a: TLoc + for i, it in n.sons: + if it.skipConv.kind == nkNilLit: + 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>") + 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]) + else: + 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", []) + +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) = - # <Nimrod code> - # s = 'Hello ' & name & ', how do you feel?' & 'z' + # <Nim code> + # s = "Hello " & name & ", how do you feel?" & 'z' # # <generated C code> # { @@ -864,34 +1256,35 @@ 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: PRope = nil - var lens: PRope = 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: - Inc(L) - app(appends, rfmt(p.module, "#appendChar($1, $2);$n", tmp.r, rdLoc(a))) + a = initLocExpr(p, e[i + 1]) + if skipTypes(e[i + 1].typ, abstractVarRange).kind == tyChar: + inc(L) + appends.add(ropecg(p.module, "#appendChar($1, $2);$n", [strLoc(p, tmp), rdLoc(a)])) 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: - appf(lens, "$1->$2 + ", [rdLoc(a), lenField()]) - app(appends, rfmt(p.module, "#appendString($1, $2);$n", tmp.r, rdLoc(a))) - linefmt(p, cpsStmts, "$1 = #rawNewString($2$3);$n", tmp.r, lens, toRope(L)) - app(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 - keepAlive(p, tmp) else: - genAssignment(p, d, tmp, {needToKeepAlive}) # no need for deep copying + genAssignment(p, d, tmp, {}) # no need for deep copying + gcUsage(p.config, e) proc genStrAppend(p: BProc, e: PNode, d: var TLoc) = - # <Nimrod code> - # s &= 'Hello ' & name & ', how do you feel?' & 'z' + # <Nim code> + # s &= "Hello " & name & ", how do you feel?" & 'z' # // BUG: what if s is on the left side too? # <generated C code> # { @@ -902,938 +1295,1746 @@ proc genStrAppend(p: BProc, e: PNode, d: var TLoc) = # appendChar(s, 'z'); # } var - a, dest: TLoc - appends, lens: PRope + 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: - Inc(L) - app(appends, rfmt(p.module, "#appendChar($1, $2);$n", - rdLoc(dest), rdLoc(a))) - else: - if e.sons[i + 2].kind in {nkStrLit..nkTripleStrLit}: - Inc(L, len(e.sons[i + 2].strVal)) + a = initLocExpr(p, e[i + 2]) + if skipTypes(e[i + 2].typ, abstractVarRange).kind == tyChar: + inc(L) + appends.add(ropecg(p.module, "#appendChar($1, $2);$n", + [strLoc(p, dest), rdLoc(a)])) + else: + if e[i + 2].kind in {nkStrLit..nkTripleStrLit}: + inc(L, e[i + 2].strVal.len) else: - appf(lens, "$1->$2 + ", [rdLoc(a), lenField()]) - app(appends, rfmt(p.module, "#appendString($1, $2);$n", - rdLoc(dest), rdLoc(a))) - linefmt(p, cpsStmts, "$1 = #resizeString($1, $2$3);$n", - rdLoc(dest), lens, toRope(L)) - keepAlive(p, dest) - app(p.s(cpsStmts), appends) + 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 gCmd != cmdCompileToCpp: - "$1 = ($2) #incrSeq(&($1)->Sup, sizeof($3));$n" - else: - "$1 = ($2) #incrSeq($1, sizeof($3));$n" - var a, b, dest: TLoc - InitLocExpr(p, e.sons[1], a) - InitLocExpr(p, e.sons[2], b) - lineCg(p, cpsStmts, seqAppendPattern, [ - rdLoc(a), - getTypeDesc(p.module, skipTypes(e.sons[1].typ, abstractVar)), - getTypeDesc(p.module, skipTypes(e.sons[2].Typ, abstractVar))]) - keepAlive(p, a) - initLoc(dest, locExpr, b.t, OnHeap) - dest.r = rfmt(nil, "$1->data[$1->$2-1]", rdLoc(a), lenField()) - genAssignment(p, dest, b, {needToCopy, afDestIsNil}) - -proc genReset(p: BProc, n: PNode) = - var a: TLoc - InitLocExpr(p, n.sons[1], a) - linefmt(p, cpsStmts, "#genericReset((void*)$1, $2);$n", - addrLoc(a), genTypeInfo(p.module, skipTypes(a.t, abstractVarRange))) - -proc rawGenNew(p: BProc, a: TLoc, sizeExpr: PRope) = + 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) + 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 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: var TLoc, sizeExpr: Rope; needsInit: bool) = var sizeExpr = sizeExpr - let refType = skipTypes(a.t, abstractVarRange) - var b: TLoc - initLoc(b, locExpr, a.t, OnHeap) - if sizeExpr.isNil: - sizeExpr = ropef("sizeof($1)", - getTypeDesc(p.module, skipTypes(reftype.sons[0], abstractRange))) - let args = [getTypeDesc(p.module, reftype), - genTypeInfo(p.module, refType), - sizeExpr] - if a.s == OnHeap and usesNativeGC(): - # use newObjRC1 as an optimization; and we don't need 'keepAlive' either - if canFormAcycle(a.t): - linefmt(p, cpsStmts, "if ($1) #nimGCunref($1);$n", a.rdLoc) - else: - linefmt(p, cpsStmts, "if ($1) #nimGCunrefNoCycle($1);$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, {needToKeepAlive}) # set the object type: - let bt = skipTypes(refType.sons[0], abstractRange) - genObjectInit(p, cpsStmts, bt, a, false) + let typ = a.t + var b: TLoc = initLoc(locExpr, a.lode, OnHeap) + let refType = typ.skipTypes(abstractInstOwned) + assert refType.kind == tyRef + 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: PRope) = +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), length] - var call: TLoc - initLoc(call, locExpr, dest.t, OnHeap) - if dest.s == OnHeap and usesNativeGC(): - if canFormAcycle(dest.t): - linefmt(p, cpsStmts, "if ($1) #nimGCunref($1);$n", dest.rdLoc) - else: - linefmt(p, cpsStmts, "if ($1) #nimGCunrefNoCycle($1);$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) - genAssignment(p, dest, call, {needToKeepAlive}) - + 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) - + 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[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 handleConstExpr(p: BProc, n: PNode, d: var TLoc): bool = + if d.k == locNone and n.len > ord(n.kind == nkObjConstr) and n.isDeepConstExpr: + 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) = - var tmp: TLoc - var t = e.typ.skipTypes(abstractInst) - getTemp(p, t, tmp) + # inheritance in C++ does not allow struct initialization so + # we skip this step here: + if not p.module.compileToCpp and optSeqDestructors notin p.config.globalOptions: + # 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(abstractInstOwned) let isRef = t.kind == tyRef - var r = rdLoc(tmp) - if isRef: - rawGenNew(p, tmp, nil) - t = t.sons[0].skipTypes(abstractInst) - r = ropef("(*$1)", r) - # XXX object initialization? but not necessary for temps, is it? - discard getTypeDesc(p.module, t) - for i in 1 .. <e.len: - let it = e.sons[i] - var tmp2: TLoc - tmp2.r = r - var field: PSym = nil - var ty = t - while ty != nil: - field = lookupInRecord(ty.n, it.sons[0].sym.name) - if field != nil: break - if gCmd != cmdCompileToCpp: app(tmp2.r, ".Sup") - ty = GetUniqueType(ty.sons[0]) - if field == nil or field.loc.r == nil: InternalError(e.info, "genObjConstr") - if it.len == 3 and optFieldCheck in p.options: - genFieldCheck(p, it.sons[2], r, field) - app(tmp2.r, ".") - app(tmp2.r, field.loc.r) - tmp2.k = locTemp - tmp2.t = field.loc.t - tmp2.s = onHeap - tmp2.heapRoot = tmp.r - expr(p, it.sons[1], tmp2) - if d.k == locNone: - d = tmp + + # check if we need to construct the object in a temporary + var useTemp = + isRef or + (d.k notin {locTemp,locLocalVar,locGlobalVar,locParam,locField}) or + (isPartOf(d.lode, e) != arNo) + + var tmp: TLoc = default(TLoc) + var r: Rope + let needsZeroMem = p.config.selectedGC notin {gcArc, gcAtomicArc, gcOrc} or nfAllFieldsSet notin e.flags + if useTemp: + tmp = getTemp(p, t) + r = rdLoc(tmp) + if isRef: + rawGenNew(p, tmp, "", needsInit = nfAllFieldsSet notin e.flags) + t = t.elementType.skipTypes(abstractInstOwned) + r = "(*$1)" % [r] + gcUsage(p.config, e) + elif needsZeroMem: + constructLoc(p, tmp) + else: + genObjectInit(p, cpsStmts, t, tmp, constructObj) else: - genAssignment(p, d, tmp, {}) - -proc genSeqConstr(p: BProc, t: PNode, d: var TLoc) = + 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: + 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 + else: + 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: TLoc - if d.k == locNone: - getTemp(p, t.typ, d) - # generate call to newSeq before adding the elements per hand: - genNewSeqAux(p, d, intLiteral(sonsLen(t))) - for i in countup(0, sonsLen(t) - 1): - initLoc(arr, locExpr, elemType(skipTypes(t.typ, typedescInst)), OnHeap) - arr.r = rfmt(nil, "$1->data[$2]", rdLoc(d), intLiteral(i)) - arr.s = OnHeap # we know that sequences are on the heap - expr(p, t.sons[i], arr) - -proc genArrToSeq(p: BProc, t: PNode, d: var TLoc) = - var elem, a, arr: TLoc - if t.kind == nkBracket: - t.sons[1].typ = t.typ - genSeqConstr(p, t.sons[1], d) + var tmp: TLoc = default(TLoc) + # bug #668 + 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) + + 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) + if doesAlias: + if d.k == locNone: + d = tmp + else: + genAssignment(p, d, tmp, {}) + +proc genArrToSeq(p: BProc, n: PNode, d: var TLoc) = + var elem, arr: TLoc + if n[1].kind == nkBracket: + n[1].typ = n.typ + genSeqConstr(p, n[1], d) return if d.k == locNone: - getTemp(p, t.typ, d) + d = getTemp(p, n.typ) + var a = initLocExpr(p, n[1]) # generate call to newSeq before adding the elements per hand: - var L = int(lengthOrd(t.sons[1].typ)) - - genNewSeqAux(p, d, intLiteral(L)) - initLocExpr(p, t.sons[1], a) - for i in countup(0, L - 1): - initLoc(elem, locExpr, elemType(skipTypes(t.typ, abstractInst)), OnHeap) - elem.r = rfmt(nil, "$1->data[$2]", rdLoc(d), intLiteral(i)) - elem.s = OnHeap # we know that sequences are on the heap - initLoc(arr, locExpr, elemType(skipTypes(t.sons[1].typ, abstractInst)), a.s) - arr.r = rfmt(nil, "$1[$2]", rdLoc(a), intLiteral(i)) - genAssignment(p, elem, arr, {afDestIsNil, needToCopy}) - + 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 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 + 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 + 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: PRope - oldModule: BModule - refType = skipTypes(e.sons[1].typ, abstractVarRange) - InitLocExpr(p, e.sons[1], a) - InitLocExpr(p, e.sons[2], f) - initLoc(b, locExpr, a.t, OnHeap) - ti = genTypeInfo(p.module, refType) - appf(p.module.s[cfsTypeInit3], "$1->finalizer = (void*)$2;$n", [ti, rdLoc(f)]) - b.r = ropecg(p.module, "($1) #newObj($2, sizeof($3))", [ + ti: Rope + 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.sons[0], abstractRange))]) - genAssignment(p, a, b, {needToKeepAlive}) # set the object type: - bt = skipTypes(refType.sons[0], abstractRange) - genObjectInit(p, cpsStmts, bt, a, false) + ti, getTypeDesc(p.module, skipTypes(refType.elementType, abstractRange))]) + genAssignment(p, a, b, {}) # set the object type: + 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; 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: PRope = nil - var t = skipTypes(a.t, abstractInst) - while t.kind in {tyVar, tyPtr, tyRef}: - if t.kind != tyVar: nilCheck = r - r = rfmt(nil, "(*$1)", r) - t = skipTypes(t.sons[0], typedescInst) - if gCmd != cmdCompileToCpp: - while (t.kind == tyObject) and (t.sons[0] != nil): - app(r, ~".Sup") - t = skipTypes(t.sons[0], typedescInst) + 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.elementType, typedescInst+{tyOwned}) + discard getTypeDesc(p.module, t) + if not p.module.compileToCpp: + while t.kind == tyObject and t.baseClass != nil: + r.add(".Sup") + t = skipTypes(t.baseClass, skipPtrs) if isObjLackingTypeField(t): - GlobalError(x.info, errGenerated, + globalError(p.config, x.info, "no 'of' operator available for pure objects") - if nilCheck != nil: - r = rfmt(p.module, "(($1) && #isObj($2.m_type, $3))", - nilCheck, r, genTypeInfo(p.module, dest)) + + 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 = rfmt(p.module, "#isObj($1.m_type, $2)", - r, genTypeInfo(p.module, dest)) - putIntoDest(p, d, getSysType(tyBool), r) + 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) = - # XXX we don't generate keep alive info for now here - 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.typ, - ropecg(p.module, "#reprInt((NI64)$1)", [rdLoc(a)])) + putIntoDest(p, d, e, + ropecg(p.module, "#reprInt((NI64)$1)", [rdLoc(a)]), a.storage) of tyFloat..tyFloat128: - putIntoDest(p, d, e.typ, ropecg(p.module, "#reprFloat($1)", [rdLoc(a)])) + putIntoDest(p, d, e, ropecg(p.module, "#reprFloat($1)", [rdLoc(a)]), a.storage) of tyBool: - putIntoDest(p, d, e.typ, ropecg(p.module, "#reprBool($1)", [rdLoc(a)])) + putIntoDest(p, d, e, ropecg(p.module, "#reprBool($1)", [rdLoc(a)]), a.storage) of tyChar: - putIntoDest(p, d, e.typ, ropecg(p.module, "#reprChar($1)", [rdLoc(a)])) + putIntoDest(p, d, e, ropecg(p.module, "#reprChar($1)", [rdLoc(a)]), a.storage) of tyEnum, tyOrdinal: - putIntoDest(p, d, e.typ, - ropecg(p.module, "#reprEnum($1, $2)", [ - rdLoc(a), genTypeInfo(p.module, t)])) + putIntoDest(p, d, e, + ropecg(p.module, "#reprEnum((NI)$1, $2)", [ + rdLoc(a), genTypeInfoV1(p.module, t, e.info)]), a.storage) of tyString: - putIntoDest(p, d, e.typ, ropecg(p.module, "#reprStr($1)", [rdLoc(a)])) + putIntoDest(p, d, e, ropecg(p.module, "#reprStr($1)", [rdLoc(a)]), a.storage) of tySet: - putIntoDest(p, d, e.typ, ropecg(p.module, "#reprSet($1, $2)", [ - addrLoc(a), genTypeInfo(p.module, t)])) + putIntoDest(p, d, e, ropecg(p.module, "#reprSet($1, $2)", [ + addrLoc(p.config, a), genTypeInfoV1(p.module, t, e.info)]), a.storage) of tyOpenArray, tyVarargs: - var b: TLoc - case a.t.kind + var b: TLoc = default(TLoc) + case skipTypes(a.t, abstractVarRange).kind of tyOpenArray, tyVarargs: - putIntoDest(p, b, e.typ, ropef("$1, $1Len0", [rdLoc(a)])) + putIntoDest(p, b, e, "$1, $1Len_0" % [rdLoc(a)], a.storage) of tyString, tySequence: - putIntoDest(p, b, e.typ, - ropef("$1->data, $1->$2", [rdLoc(a), lenField()])) - of tyArray, tyArrayConstr: - putIntoDest(p, b, e.typ, - ropef("$1, $2", [rdLoc(a), toRope(lengthOrd(a.t))])) - else: InternalError(e.sons[0].info, "genRepr()") - putIntoDest(p, d, e.typ, + putIntoDest(p, b, e, + "($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[0].info, "genRepr()") + putIntoDest(p, d, e, ropecg(p.module, "#reprOpenArray($1, $2)", [rdLoc(b), - genTypeInfo(p.module, elemType(t))])) - of tyCString, tyArray, tyArrayConstr, tyRef, tyPtr, tyPointer, tyNil, - tySequence: - putIntoDest(p, d, e.typ, + 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)])) + 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.typ, ropecg(p.module, "#reprAny($1, $2)", - [addrLoc(a), genTypeInfo(p.module, t)])) + putIntoDest(p, d, e, ropecg(p.module, "#reprAny($1, $2)", + [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) = - var t = skipTypes(e.sons[1].typ, abstractVarRange) - putIntoDest(p, d, e.typ, genTypeInfo(p.module, t)) +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) - genAssignment(p, d, a, {needToKeepAlive}) +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 typ = skipTypes(a.Typ, abstractVar) + 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, "($1Len0-1)") - else: unaryExpr(p, e, d, "$1Len0") - of tyCstring: - if op == mHigh: unaryExpr(p, e, d, "(strlen($1)-1)") - else: unaryExpr(p, e, d, "strlen($1)") - of tyString, tySequence: - if gCmd != cmdCompileToCpp: - if op == mHigh: unaryExpr(p, e, d, "($1->Sup.len-1)") - else: unaryExpr(p, e, d, "$1->Sup.len") + # 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: + putIntoDest(p, d, e, ropecg(p.module, "(($2)-($1))", [rdLoc(b), rdLoc(c)])) + else: + putIntoDest(p, d, e, ropecg(p.module, "(($2)-($1)+1)", [rdLoc(b), rdLoc(c)])) else: - if op == mHigh: unaryExpr(p, e, d, "($1->len-1)") - else: unaryExpr(p, e, d, "$1->len") - of tyArray, tyArrayConstr: + if not reifiedOpenArray(a): + if op == mHigh: unaryExpr(p, e, d, "($1Len_0-1)") + else: unaryExpr(p, e, d, "$1Len_0") + else: + 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.typ, toRope(lastOrd(Typ))) - else: putIntoDest(p, d, e.typ, toRope(lengthOrd(typ))) - else: InternalError(e.info, "genArrayLen()") + if op == mHigh: putIntoDest(p, d, e, rope(lastOrd(p.config, typ))) + else: putIntoDest(p, d, e, rope(lengthOrd(p.config, typ))) + else: internalError(p.config, e.info, "genArrayLen()") proc 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) - InitLocExpr(p, e.sons[1], a) - InitLocExpr(p, e.sons[2], b) - var t = skipTypes(e.sons[1].typ, abstractVar) - let setLenPattern = if gCmd != cmdCompileToCpp: - "$1 = ($3) #setLengthSeq(&($1)->Sup, sizeof($4), $2);$n" - else: - "$1 = ($3) #setLengthSeq($1, sizeof($4), $2);$n" + var x = e[1] + if x.kind in {nkAddr, nkHiddenAddr}: x = x[0] + var a = initLocExpr(p, x) + var b = initLocExpr(p, e[2]) + let t = skipTypes(e[1].typ, {tyVar}) + + 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), + genTypeInfoV1(p.module, t.skipTypes(abstractInst), e.info)]) - lineCg(p, cpsStmts, setLenPattern, [ + else: + const setLenPattern = "($3) #setLengthSeqV2($1, $4, $2)" + call.snippet = ropecg(p.module, setLenPattern, [ rdLoc(a), rdLoc(b), getTypeDesc(p.module, t), - getTypeDesc(p.module, t.sons[0])]) - keepAlive(p, a) + 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") - keepAlive(P, d) + 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(a: TLoc, setType: PType): PRope = - # read a location of an set element; it may need a substraction operation +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(setType) != 0: - result = ropef("($1- $2)", [result, toRope(firstOrd(setType))]) + if firstOrd(conf, setType) != 0: + result.add " - " + result.add rope(firstOrd(conf, setType)) + result.add ")" -proc fewCmps(s: PNode): bool = +proc fewCmps(conf: ConfigRef; s: PNode): bool = # this function estimates whether it is better to emit code # for constructing the set or generating a bunch of comparisons directly - if s.kind != nkCurly: InternalError(s.info, "fewCmps") - if (getSize(s.typ) <= platform.intSize) and (nfAllConst in s.flags): + if s.kind != nkCurly: return false + if (getSize(conf, s.typ) <= conf.target.intSize) and (nfAllConst in s.flags): result = false # it is better to emit the set generation code - elif elemType(s.typ).Kind in {tyInt, tyInt16..tyInt64}: + 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.typ, ropef(frmt, [rdLoc(a), rdSetElemLoc(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(skipTypes(e.sons[1].typ, abstractVar))) - of 1: binaryExprIn(p, e, a, b, d, "(($1 &(1<<(($2)&7)))!=0)") - of 2: binaryExprIn(p, e, a, b, d, "(($1 &(1<<(($2)&15)))!=0)") - of 4: binaryExprIn(p, e, a, b, d, "(($1 &(1<<(($2)&31)))!=0)") - of 8: binaryExprIn(p, e, a, b, d, "(($1 &(IL64(1)<<(($2)&IL64(63))))!=0)") - else: binaryExprIn(p, e, a, b, d, "(($1[$2/8] &(1<<($2%8)))!=0)") - -proc binaryStmtInExcl(p: BProc, e: PNode, d: var TLoc, frmt: string) = - var a, b: TLoc + 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)") + +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(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(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.typ, OnUnknown) - b.r = toRope("(") - var length = sonsLen(e.sons[1]) - for i in countup(0, length - 1): - if e.sons[1].sons[i].Kind == nkRange: - InitLocExpr(p, e.sons[1].sons[i].sons[0], x) - InitLocExpr(p, e.sons[1].sons[i].sons[1], y) - appf(b.r, "$1 >= $2 && $1 <= $3", - [rdCharLoc(a), rdCharLoc(x), rdCharLoc(y)]) - else: - InitLocExpr(p, e.sons[1].sons[i], x) - appf(b.r, "$1 == $2", [rdCharLoc(a), rdCharLoc(x)]) - if i < length - 1: app(b.r, " || ") - app(b.r, ")") - putIntoDest(p, d, e.typ, 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) - var size = int(getSize(setType)) + " $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 = "NI" & $(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 = "NI" & $(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(e.info, "genSetOp()") + else: internalError(p.config, e.info, "genSetOp()") else: case op - of mIncl: binaryStmtInExcl(p, e, d, "$1[$2/8] |=(1<<($2%8));$n") - of mExcl: binaryStmtInExcl(p, e, d, "$1[$2/8] &= ~(1<<($2%8));$n") - of mCard: unaryExprChar(p, e, d, "#cardSet($1, " & $size & ')') + of mIncl: binaryStmtInExcl(p, e, d, "$1[(NU)($2)>>3] |=(1U<<($2&7U));$n") + of mExcl: binaryStmtInExcl(p, e, d, "$1[(NU)($2)>>3] &= ~(1U<<($2&7U));$n") + of mCard: + var a: TLoc = initLocExpr(p, e[1]) + putIntoDest(p, d, e, ropecg(p.module, "#cardSet($1, $2)", [rdCharLoc(a), size])) of mLtSet, mLeSet: - getTemp(p, getSysType(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) - lineF(p, cpsStmts, lookupOpr[op], - [rdLoc(i), toRope(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: - 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(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" & + "for ($1 = 0; $1 < $2; $1++) $n" & " $3[$1] = $4[$1] $6 $5[$1];$n", [ - rdLoc(i), toRope(size), rdLoc(d), rdLoc(a), rdLoc(b), - toRope(lookupOpr[op])]) + rdLoc(i), rope(size), rdLoc(d), rdLoc(a), rdLoc(b), + rope(lookupOpr[op])]) of mInSet: genInOp(p, e, d) - else: internalError(e.info, "genSetOp") + else: internalError(p.config, e.info, "genSetOp") proc genOrd(p: BProc, e: PNode, d: var TLoc) = unaryExprChar(p, e, d, "$1") proc genSomeCast(p: BProc, e: PNode, d: var TLoc) = const - ValueTypes = {tyTuple, tyObject, tyArray, tyOpenArray, tyVarargs, - tyArrayConstr} + 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.typ, ropef("(*($1*) ($2))", - [getTypeDesc(p.module, e.typ), addrLoc(a)])) - elif etyp.kind == tyProc and etyp.callConv == ccClosure: - putIntoDest(p, d, e.typ, ropef("(($1) ($2))", - [getClosureType(p.module, etyp, clHalfWithEnv), rdCharLoc(a)])) + 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 and srcTyp.callConv != ccClosure: + putIntoDest(p, d, e, "(($1) ($2))" % + [getClosureType(p.module, etyp, clHalfWithEnv), rdCharLoc(a)], a.storage) else: - putIntoDest(p, d, e.typ, ropef("(($1) ($2))", - [getTypeDesc(p.module, e.typ), rdCharLoc(a)])) + # 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) proc genCast(p: BProc, e: PNode, d: var TLoc) = - const floatTypes = {tyFloat..tyFloat128} - let + const ValueTypes = {tyFloat..tyFloat128, tyTuple, tyObject, tyArray} + let destt = skipTypes(e.typ, abstractRange) - srct = skipTypes(e.sons[1].typ, abstractRange) - if destt.kind in floatTypes or srct.kind in floatTypes: + 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.toRope - var tmp: TLoc - tmp.r = ropef("LOC$1.source", lbl) - linefmt(p, cpsLocals, "union { $1 source; $2 dest; } LOC$3;$n", - getTypeDesc(p.module, srct), getTypeDesc(p.module, destt), lbl) + var lbl = p.labels.rope + 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.a = -1 - tmp.t = srct - tmp.s = OnStack + tmp.lode = lodeTyp srct + tmp.storage = OnStack tmp.flags = {} - expr(p, e.sons[1], tmp) - putIntoDest(p, d, e.typ, ropef("LOC$#.dest", lbl)) + 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.kind in {tyUInt..tyUInt64}: - InitLocExpr(p, n.sons[0], a) - putIntoDest(p, d, n.typ, ropef("(($1) ($2))", - [getTypeDesc(p.module, dest), rdCharLoc(a)])) - else: - InitLocExpr(p, n.sons[0], a) - if leValue(n.sons[2], n.sons[1]): - InternalError(n.info, "range check will always fail; empty range") - putIntoDest(p, d, 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), - toRope(magic)])) + 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: + 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) = - if compareTypes(e.typ, e.sons[1].typ, dcEqIgnoreDistinct): - expr(p, e.sons[1], d) + let destType = e.typ.skipTypes({tyVar, tyLent, tyGenericInst, tyAlias, tySink}) + 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, skipTypes(n.typ, abstractVar), ropef("$1->data", - [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, skipTypes(n.typ, abstractVar), - ropecg(p.module, "#cstrToNimstr($1)", [rdLoc(a)])) + 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] - if (a.kind == nkNilLit) or (b.kind == nkNilLit): - binaryExpr(p, e, d, "($1 == $2)") - elif (a.kind in {nkStrLit..nkTripleStrLit}) and (a.strVal == ""): - initLocExpr(p, e.sons[2], x) - putIntoDest(p, d, e.typ, - rfmt(nil, "(($1) && ($1)->$2 == 0)", rdLoc(x), lenField())) - elif (b.kind in {nkStrLit..nkTripleStrLit}) and (b.strVal == ""): - initLocExpr(p, e.sons[1], x) - putIntoDest(p, d, e.typ, - rfmt(nil, "(($1) && ($1)->$2 == 0)", rdLoc(x), lenField())) + var a = e[1] + var b = e[2] + if a.kind in {nkStrLit..nkTripleStrLit} and a.strVal == "": + x = initLocExpr(p, e[2]) + putIntoDest(p, d, e, + ropecg(p.module, "($1 == 0)", [lenExpr(p, x)])) + elif b.kind in {nkStrLit..nkTripleStrLit} and b.strVal == "": + x = initLocExpr(p, e[1]) + putIntoDest(p, d, e, + 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 != {}: + 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) - putIntoDest(p, d, e.typ, rfmt(nil, "($2 $1 $3)", - toRope(opr[m]), rdLoc(a), rdLoc(b))) - if optNanCheck in p.options: - linefmt(p, cpsStmts, "#nanCheck($1);$n", rdLoc(d)) + 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))", + [opr[m], rdLoc(a), rdLoc(b), + getSimpleTypeDesc(p.module, e[1].typ)])) + if optNaNCheck in p.options: + 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) = - var line, filen: PRope case op of mOr, mAnd: genAndOr(p, e, d, op) - of mNot..mToBiggestInt: unaryArith(p, e, d, op) - of mUnaryMinusI..mAbsI64: unaryArithOverflow(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) of mEqProc: genEqProc(p, e, d) - of mAddi..mModi64: binaryArithOverflow(p, e, d, op) + 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 not (optOverflowCheck in p.Options): unaryExpr(p, e, d, "$1 - 1") - else: unaryExpr(p, e, d, "#subInt($1, 1)") - of mPred: - # XXX: range checking? - if not (optOverflowCheck in p.Options): binaryExpr(p, e, d, "$1 - $2") - else: binaryExpr(p, e, d, "#subInt($1, $2)") - of mSucc: - # XXX: range checking? - if not (optOverflowCheck in p.Options): binaryExpr(p, e, d, "$1 + $2") - else: binaryExpr(p, e, d, "#addInt($1, $2)") - of mInc: - if not (optOverflowCheck in p.Options): - binaryStmt(p, e, d, "$1 += $2;$n") - elif skipTypes(e.sons[1].typ, abstractVar).kind == tyInt64: - binaryStmt(p, e, d, "$1 = #addInt64($1, $2);$n") - else: - binaryStmt(p, e, d, "$1 = #addInt($1, $2);$n") - of ast.mDec: - if not (optOverflowCheck in p.Options): - binaryStmt(p, e, d, "$1 -= $2;$n") - elif skipTypes(e.sons[1].typ, abstractVar).kind == tyInt64: - binaryStmt(p, e, d, "$1 = #subInt64($1, $2);$n") - else: - binaryStmt(p, e, d, "$1 = #subInt($1, $2);$n") + of mInc, mDec: + 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: + 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[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[1], "($#)($#)" % [ + getTypeDesc(p.module, ranged), res]) + of mConStrStr: genStrConcat(p, e, d) of mAppendStrCh: - binaryStmt(p, e, d, "$1 = #addChar($1, $2);$n") - # strictly speaking we need to generate "keepAlive" here too, but this - # very likely not needed and would slow down the code too much I fear + 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.typ, ropef("((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 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, mRand: - 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.ropeToStr) + 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 mEcho: genEcho(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: - localError(e.info, errCannotGenerateCodeForX, e.sons[0].sym.name.s) - of mSlurp..mQuoteAst: - localError(e.info, errXMustBeCompileTime, e.sons[0].sym.name.s) - else: internalError(e.info, "genMagicExpr: " & $op) - -proc genConstExpr(p: BProc, n: PNode): PRope -proc handleConstExpr(p: BProc, n: PNode, d: var TLoc): bool = - if (nfAllConst in n.flags) and (d.k == locNone) and (sonsLen(n) > 0): - var t = getUniqueType(n.typ) - discard getTypeDesc(p.module, t) # so that any fields are initialized - var id = NodeTableTestOrSet(p.module.dataCache, n, gBackendId) - fillLoc(d, locData, t, con("TMP", toRope(id)), OnHeap) - if id == gBackendId: - # expression not found in the cache: - inc(gBackendId) - appf(p.module.s[cfsData], "NIM_CONST $1 $2 = $3;$n", - [getTypeDesc(p.module, t), d.r, genConstExpr(p, n)]) - result = true + of mNLen..mNError, mSlurp..mQuoteAst: + localError(p.config, e.info, strutils.`%`(errXMustBeCompileTime, e[0].sym.name.s)) + of mSpawn: + when defined(leanCompiler): + p.config.quitOrRaise "compiler built without support for the 'spawn' statement" + else: + let n = spawn.wrapProcForSpawn(p.module.g.graph, p.module.idgen, p.module.module, e, e.typ, nil, nil) + expr(p, n, d) + of mParallel: + 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: + 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] + 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: - result = false + when defined(debugMagics): + echo p.prc.name.s, " ", p.prc.id, " ", p.prc.flags, " ", p.prc.ast[genericParamsPos].kind + internalError(p.config, e.info, "genMagicExpr: " & $op) 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.typ, 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 getSize(e.typ) > 8: + if d.k == locNone: d = getTemp(p, e.typ) + if getSize(p.config, e.typ) > 8: # big set: - lineF(p, cpsStmts, "memset($1, 0, sizeof($1));$n", [rdLoc(d)]) - for i in countup(0, sonsLen(e) - 1): - if e.sons[i].kind == nkRange: - getTemp(p, getSysType(tyInt), idx) # our counter - initLocExpr(p, e.sons[i].sons[0], a) - initLocExpr(p, e.sons[i].sons[1], b) + linefmt(p, cpsStmts, "#nimZeroMem($1, sizeof($2));$n", + [rdLoc(d), getTypeDesc(p.module, e.typ)]) + for it in e.sons: + if it.kind == nkRange: + 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[$1/8] |=(1<<($1%8));$n", [rdLoc(idx), rdLoc(d), - rdSetElemLoc(a, e.typ), rdSetElemLoc(b, e.typ)]) + "$2[(NU)($1)>>3] |=(1U<<((NU)($1)&7U));$n", [rdLoc(idx), rdLoc(d), + aa, bb]) else: - initLocExpr(p, e.sons[i], a) - lineF(p, cpsStmts, "$1[$2/8] |=(1<<($2%8));$n", - [rdLoc(d), rdSetElemLoc(a, e.typ)]) + 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), aa]) else: # small set - var ts = "NI" & $(getSize(e.typ) * 8) + var ts = "NU" & $(getSize(p.config, e.typ) * 8) lineF(p, cpsStmts, "$1 = 0;$n", [rdLoc(d)]) - for i in countup(0, sonsLen(e) - 1): - if e.sons[i].kind == nkRange: - getTemp(p, getSysType(tyInt), idx) # our counter - initLocExpr(p, e.sons[i].sons[0], a) - initLocExpr(p, e.sons[i].sons[1], b) + for it in e.sons: + if it.kind == nkRange: + 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 |=(1<<((" & ts & ")($1)%(sizeof(" & ts & ")*8)));$n", [ - rdLoc(idx), rdLoc(d), rdSetElemLoc(a, e.typ), - rdSetElemLoc(b, e.typ)]) + "$2 |=(($5)(1)<<(($1)%(sizeof($5)*8)));$n", [ + rdLoc(idx), rdLoc(d), aa, bb, rope(ts)]) else: - initLocExpr(p, e.sons[i], a) + a = initLocExpr(p, it) + var aa = newRopeAppender() + rdSetElemLoc(p.config, a, e.typ, aa) lineF(p, cpsStmts, - "$1 |=(1<<((" & ts & ")($2)%(sizeof(" & ts & ")*8)));$n", - [rdLoc(d), rdSetElemLoc(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): - var t = getUniqueType(n.typ) + 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.typ, d.s) - rec.r = ropef("$1.Field$2", [rdLoc(d), toRope(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) - when false: - initLoc(rec, locExpr, it.typ, d.s) - if (t.n.sons[i].kind != nkSym): InternalError(n.info, "genTupleConstr") - rec.r = ropef("$1.$2", - [rdLoc(d), mangleRecFieldName(t.n.sons[i].sym, t)]) - expr(p, it, rec) - -proc IsConstClosure(n: PNode): bool {.inline.} = - result = n.sons[0].kind == nkSym and isRoutine(n.sons[0].sym) and - n.sons[1].kind == nkNilLit - + + if doesAlias: + if d.k == locNone: + d = tmp + else: + genAssignment(p, d, tmp, {}) + +proc isConstClosure(n: PNode): bool {.inline.} = + result = n[0].kind == nkSym and isRoutine(n[0].sym) and + n[1].kind == nkNilLit + proc genClosure(p: BProc, n: PNode, d: var TLoc) = - assert n.kind == nkClosure - - if IsConstClosure(n): - inc(p.labels) - var tmp = con("LOC", toRope(p.labels)) - appf(p.module.s[cfsData], "NIM_CONST $1 $2 = $3;$n", - [getTypeDesc(p.module, n.typ), tmp, genConstExpr(p, n)]) - putIntoDest(p, d, n.typ, tmp) - else: - var tmp, a, b: TLoc - initLocExpr(p, n.sons[0], a) - initLocExpr(p, n.sons[1], b) - getTemp(p, n.typ, tmp) - linefmt(p, cpsStmts, "$1.ClPrc = $2; $1.ClEnv = $3;$n", - tmp.rdLoc, a.rdLoc, b.rdLoc) - putLocIntoDest(p, d, tmp) + assert n.kind in {nkPar, nkTupleConstr, nkClosure} + + if isConstClosure(n): + inc(p.module.labels) + var tmp = "CNSTCLOSURE" & rope(p.module.labels) + 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: 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]) + else: + tmp = getTemp(p, n.typ) + linefmt(p, cpsStmts, "$1.ClP_0 = $2; $1.ClE_0 = $3;$n", + [tmp.rdLoc, a.rdLoc, b.rdLoc]) + putLocIntoDest(p, d, tmp) 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, elemType(skipTypes(n.typ, abstractInst)), d.s) - arr.r = ropef("$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.} = + #let hasNimFrame = magicsys.getCompilerProc("nimFrame") != nil + let hasNimFrame = p.prc != nil and + sfSystemModule notin p.module.module.flags and + optStackTrace in p.prc.options + var frameName: Rope = "" + for i in 0..<n.len - 1: + let it = n[i] + if it.kind == nkComesFrom: + if hasNimFrame and frameName == "": + inc p.labels + frameName = "FR" & rope(p.labels) & "_" + let theMacro = it[0].sym + add p.s(cpsStmts), initFrameNoDebug(p, frameName, + makeCString theMacro.name.s, + quotedFilename(p.config, theMacro.info), it.info.line.int) + else: + genStmts(p, it) + if n.len > 0: exprOrStmt + if frameName != "": + p.s(cpsStmts).add deinitFrameNoDebug(p, frameName) + proc genStmtListExpr(p: BProc, n: PNode, d: var TLoc) = - var length = sonsLen(n) - for i in countup(0, length - 2): genStmts(p, n.sons[i]) - if length > 0: expr(p, n.sons[length - 1], d) + genStmtListExprImpl: + expr(p, n[^1], d) + +proc genStmtList(p: BProc, n: PNode) = + genStmtListExprImpl: + 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 dest = skipTypes(n.typ, abstractPtrs) + 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: PRope = nil - var t = skipTypes(a.t, abstractInst) - while t.kind in {tyVar, tyPtr, tyRef}: - if t.kind != tyVar: nilCheck = r - r = ropef("(*$1)", [r]) - t = skipTypes(t.sons[0], abstractInst) - if gCmd != cmdCompileToCpp: - while t.kind == tyObject and t.sons[0] != nil: - app(r, ".Sup") - t = skipTypes(t.sons[0], abstractInst) - if nilCheck != nil: - linefmt(p, cpsStmts, "if ($1) #chckObj($2.m_type, $3);$n", - nilCheck, r, genTypeInfo(p.module, dest)) - else: - linefmt(p, cpsStmts, "#chckObj($1.m_type, $2);$n", - r, genTypeInfo(p.module, dest)) - if n.sons[0].typ.kind != tyObject: - putIntoDest(p, d, n.typ, - ropef("(($1) ($2))", [getTypeDesc(p.module, n.typ), rdLoc(a)])) - else: - putIntoDest(p, d, n.typ, ropef("(*($1*) ($2))", - [getTypeDesc(p.module, dest), addrLoc(a)])) + 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 gCmd == cmdCompileToCpp: - expr(p, n.sons[0], d) # downcast does C++ for us + var arg = n[0] + while arg.kind == nkObjDownConv: arg = arg[0] + + 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 dest = skipTypes(n.typ, abstractPtrs) - var src = skipTypes(n.sons[0].typ, abstractPtrs) - var a: TLoc - initLocExpr(p, n.sons[0], a) - var r = rdLoc(a) - if skipTypes(n.sons[0].typ, abstractInst).kind in {tyRef, tyPtr, tyVar} and - n.sons[0].kind notin {nkHiddenAddr, nkAddr, nkObjDownConv}: - app(r, "->Sup") - for i in countup(2, abs(inheritanceDiff(dest, src))): app(r, ".Sup") - r = con("&", r) - else: - for i in countup(1, abs(inheritanceDiff(dest, src))): app(r, ".Sup") - putIntoDest(p, d, n.typ, r) + 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) = - var t = getUniqueType(n.typ) + let t = n.typ discard getTypeDesc(p.module, t) # so that any fields are initialized - var id = NodeTableTestOrSet(p.module.dataCache, n, gBackendId) - var tmp = con("TMP", toRope(id)) - - if id == gBackendId: + let id = nodeTableTestOrSet(p.module.dataCache, n, p.module.labels) + let tmp = p.module.tmpBase & rope(id) + + if id == p.module.labels: # expression not found in the cache: - inc(gBackendId) - appf(p.module.s[cfsData], "NIM_CONST $1 $2 = $3;$n", - [getTypeDesc(p.module, t), tmp, genConstExpr(p, n)]) - + inc(p.module.labels) + 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, t, tmp, OnHeap) + fillLoc(d, locData, n, tmp, OnStatic) + else: + putDataIntoDest(p, d, n, tmp) + # This fixes bug #4551, but we really need better dataflow + # analysis to make this 100% safe. + 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: - putIntoDest(p, d, t, tmp) + 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 + case sym.kind of skMethod: - if sym.getBody.kind == nkEmpty or sfDispatcher in sym.flags: + if useAliveDataFromDce in p.module.flags or {sfDispatcher, sfForward} * sym.flags != {}: # we cannot produce code for the dispatcher yet: - fillProcLoc(sym) + fillProcLoc(p.module, n) genProcPrototype(p.module, sym) else: genProc(p.module, sym) putLocIntoDest(p, d, sym.loc) - of skProc, skConverter, skIterator: - genProc(p.module, sym) - if sym.loc.r == nil or sym.loc.t == nil: - InternalError(n.info, "expr: proc not init " & sym.name.s) + of skProc, skConverter, skIterator, skFunc: + #if sym.kind == skIterator: + # echo renderTree(sym.getBody, {renderIds}) + if sfCompileTime in sym.flags: + localError(p.config, n.info, "request to generate code for .compileTime proc: " & + sym.name.s) + 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 sfFakeConst in sym.flags: - if sfGlobal in sym.flags: genVarPrototype(p.module, sym) + if isSimpleConst(sym.typ): + 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) - elif isSimpleConst(sym.typ): - putIntoDest(p, d, n.typ, genLiteral(p, sym.ast, sym.typ)) else: genComplexConst(p, sym, d) of skEnumField: - putIntoDest(p, d, n.typ, toRope(sym.position)) + # we never reach this case - as of the time of this comment, + # skEnumField is folded to an int in semfold.nim, but this code + # remains for robustness + putIntoDest(p, d, n, rope(sym.position)) of skVar, skForVar, skResult, skLet: - if sfGlobal in sym.flags: genVarPrototype(p.module, sym) - if sym.loc.r == nil or sym.loc.t == nil: - InternalError(n.info, "expr: var not init " & sym.name.s) + if {sfGlobal, sfThread} * sym.flags != {}: + genVarPrototype(p.module, n) + 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(): - putIntoDest(p, d, sym.loc.t, con("NimTV->", sym.loc.r)) + accessThreadLocalVar(p, sym) + if emulatedThreadVars(p.config): + 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: - InternalError(n.info, "expr: temp not init " & sym.name.s) + 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: - InternalError(n.info, "expr: param not init " & sym.name.s) + 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}) + internalError(p.config, n.info, "expr: param not init " & sym.name.s & "_" & $sym.id) putLocIntoDest(p, d, sym.loc) - else: InternalError(n.info, "expr(" & $sym.kind & "); unknown symbol") + else: internalError(p.config, n.info, "expr(" & $sym.kind & "); unknown symbol") of nkNilLit: if not isEmptyType(n.typ): - putIntoDest(p, d, n.typ, genLiteral(p, n)) - of nkStrLit..nkTripleStrLit, nkIntLit..nkUInt64Lit, - nkFloatLit..nkFloat128Lit, nkCharLit: - putIntoDest(p, d, n.typ, genLiteral(p, n)) + var lit = newRopeAppender() + genLiteral(p, n, lit) + putIntoDest(p, d, n, lit) + of nkStrLit..nkTripleStrLit: + 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: @@ -1846,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.typ, genSetNode(p, n)) + var lit = newRopeAppender() + genSetNode(p, n, lit) + putIntoDest(p, d, n, lit) else: genSetConstr(p, n, d) of nkBracket: @@ -1856,152 +3059,417 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = genSeqConstr(p, n, d) else: genArrayConstr(p, n, d) - of nkPar: - if isDeepConstExpr(n) and n.len != 0: + of nkPar, nkTupleConstr: + 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 nkBracketExpr: - var ty = skipTypes(n.sons[0].typ, abstractVarRange) - if ty.kind in {tyRef, tyPtr}: ty = skipTypes(ty.sons[0], abstractVarRange) - case ty.kind - of tyArray, tyArrayConstr: genArrayElem(p, n, d) - of tyOpenArray, tyVarargs: genOpenArrayElem(p, n, d) - of tySequence, tyString: genSeqElem(p, n, d) - of tyCString: genCStringElem(p, n, d) - of tyTuple: genTupleElem(p, n, d) - else: InternalError(n.info, "expr(nkBracketExpr, " & $ty.kind & ')') + 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) of nkCheckedFieldExpr: genCheckedRecordField(p, n, d) of nkBlockExpr, nkBlockStmt: genBlock(p, n, d) of nkStmtListExpr: genStmtListExpr(p, n, d) - of nkStmtList: - for i in countup(0, sonsLen(n) - 1): genStmts(p, n.sons[i]) + of nkStmtList: genStmtList(p, n) of nkIfExpr, nkIfStmt: genIf(p, n, d) + of nkWhen: + # This should be a "when nimvm" node. + 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.t == nil: - InternalError(n.info, "expr: proc not init " & sym.name.s) + 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) - of nkMetaNode: expr(p, n.sons[0], d) - of nkEmpty: nil + of nkEmpty: discard of nkWhileStmt: genWhileStmt(p, n) of nkVarSection, nkLetSection: genVarStmt(p, n) - of nkConstSection: genConstStmt(p, n) - of nkForStmt: internalError(n.info, "for statement not eliminated") + 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: genAsgn(p, n, fastAsgn=false) - of nkFastAsgn: - # transf is overly aggressive with 'nkFastAsgn', so we work around here. - # See tests/run/tcnstseq3 for an example that would fail otherwise. - genAsgn(p, n, fastAsgn=p.prc != nil) + of nkAsgn: + cow(p, n[1]) + if nfPreventCg notin n.flags: + genAsgn(p, n, fastAsgn=false) + 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. + genAsgn(p, n, fastAsgn=p.prc != nil) of nkDiscardStmt: - if n.sons[0].kind != nkEmpty: - var a: TLoc + let ex = n[0] + if ex.kind != nkEmpty: genLineDir(p, n) - initLocExpr(p, n.sons[0], a) + var a: TLoc = initLocExprSingleUse(p, ex) + line(p, cpsStmts, "(void)(" & a.snippet & ");\L") of nkAsmStmt: genAsmStmt(p, n) - of nkTryStmt: - if gCmd == cmdCompileToCpp: genTryCpp(p, n, d) - else: genTry(p, n, d) + of nkTryStmt, nkHiddenTryStmt: + case p.config.exc + of excGoto: + genTryGoto(p, n, d) + of excCpp: + genTryCpp(p, n, d) + else: + genTrySetjmp(p, n, d) of nkRaiseStmt: genRaiseStmt(p, n) of nkTypeSection: # we have to emit the type information for object types here to support # separate compilation: genTypeSection(p.module, n) - of nkCommentStmt, nkIteratorDef, nkIncludeStmt, - nkImportStmt, nkImportExceptStmt, nkExportStmt, nkExportExceptStmt, - nkFromStmt, nkTemplateDef, nkMacroDef: - nil + of nkCommentStmt, nkIteratorDef, nkIncludeStmt, + nkImportStmt, nkImportExceptStmt, nkExportStmt, nkExportExceptStmt, + nkFromStmt, nkTemplateDef, nkMacroDef, nkStaticStmt: + discard of nkPragma: genPragma(p, n) - of nkProcDef, 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.owner.kind == skModule: - if (optDeadCodeElim notin gGlobalOptions and - sfDeadCodeElim notin getModule(prc).flags) or - ({sfExportc, sfCompilerProc} * prc.flags == {sfExportc}) or + of nkPragmaBlock: + var inUncheckedAssignSection = 0 + let pragmaList = n[0] + for pi in pragmaList: + if whichPragma(pi) == wCast: + case whichPragma(pi[1]) + of wUncheckedAssign: + inUncheckedAssignSection = 1 + else: + discard + + inc p.inUncheckedAssignSection, inUncheckedAssignSection + expr(p, n.lastSon, d) + dec p.inUncheckedAssignSection, inUncheckedAssignSection + + of nkProcDef, nkFuncDef, nkMethodDef, nkConverterDef: + if n[genericParamsPos].kind == nkEmpty: + var prc = n[namePos].sym + if useAliveDataFromDce in p.module.flags: + if p.module.alive.contains(prc.itemId.item) and + prc.magic in 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) + (prc.kind == skMethod): + # 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 nkBreakState: genBreakState(p, n) - else: InternalError(n.info, "expr(" & $n.kind & "); unknown node kind") - -proc genNamedConstExpr(p: BProc, n: PNode): PRope = - if n.kind == nkExprColonExpr: result = genConstExpr(p, n.sons[1]) - else: result = genConstExpr(p, n) - -proc genConstSimpleList(p: BProc, n: PNode): PRope = - var length = sonsLen(n) - result = toRope("{") - for i in countup(0, length - 2): - appf(result, "$1,$n", [genNamedConstExpr(p, n.sons[i])]) - if length > 0: app(result, genNamedConstExpr(p, n.sons[length - 1])) - appf(result, "}$n") - -proc genConstSeq(p: BProc, n: PNode, t: PType): PRope = - var data = ropef("{{$1, $1}", n.len.toRope) - if n.len > 0: + 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 getDefaultValue(p: BProc; typ: PType; info: TLineInfo; result: var Rope) = + var t = skipTypes(typ, abstractRange+{tyOwned}-{tyTypeDesc}) + case t.kind + 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.add "NIM_NIL" + else: + result.add "{NIM_NIL, NIM_NIL}" + of tyObject: + var count = 0 + result.add "{" + getNullValueAuxT(p, t, t, t.n, nil, result, count, true, info) + result.add "}" + of tyTuple: + result.add "{" + if p.vccAndC and t.isEmptyTupleType: + result.add "0" + for i, a in t.ikids: + if i > 0: result.add ", " + getDefaultValue(p, a, info, result) + result.add "}" + 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 mapSetType(p.config, t) == ctArray: result.add "{}" + else: result.add "0" + else: + globalError(p.config, info, "cannot create null element for: " & $t.kind) + +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, constOrNil, result, count, isConst, info) + of nkRecCase: + 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 + 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 + # not found, produce default value: + getDefaultValue(p, field.typ, info, result) + else: + localError(p.config, info, "cannot create null element for: " & $obj) + +proc getNullValueAuxT(p: BProc; orig, t: PType; obj, constOrNil: PNode, + result: var Rope; count: var int; + isConst: bool, info: TLineInfo) = + var base = t.baseClass + let oldRes = result + let oldcount = count + if base != nil: + result.add "{" + base = skipTypes(base, skipPtrs) + 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, constOrNil, result, count, isConst, info) + # do not emit '{}' as that is not valid C: + if oldcount == count: result = oldRes + +proc genConstObjConstr(p: BProc; n: PNode; isConst: bool; result: var Rope) = + let t = n.typ.skipTypes(abstractInstOwned) + var count = 0 + #if not isObjLackingTypeField(t) and not p.module.compileToCpp: + # result.addf("{$1}", [genTypeInfo(p.module, t)]) + # inc count + result.add "{" + if t.kind == tyObject: + getNullValueAuxT(p, t, t, t.n, n, result, count, isConst, n.info) + result.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.app(", {") - for i in countup(0, n.len - 1): - if i > 0: data.appf(",$n") - data.app genConstExpr(p, n.sons[i]) - data.app("}") - data.app("}") - - inc(gBackendId) - result = con("CNSTSEQ", gBackendId.toRope) - - appcg(p.module, cfsData, - "NIM_CONST struct {$n" & - " #TGenericSeq Sup;$n" & - " $1 data[$2];$n" & - "} $3 = $4;$n", [ - getTypeDesc(p.module, t.sons[0]), n.len.toRope, result, data]) + data.add(", {") + for i in 0..<n.len: + if i > 0: data.addf(",$n", []) + genBracedInit(p, n[i], isConst, base, data) + data.add("}") + data.add("}") - result = ropef("(($1)&$2)", [getTypeDesc(p.module, t), result]) + let tmpName = getTempName(p.module) -proc genConstExpr(p: BProc, n: PNode): PRope = - case n.Kind + appcg(p.module, cfsStrData, + "static $5 struct {$n" & + " #TGenericSeq Sup;$n" & + " $1 data[$2];$n" & + "} $3 = $4;$n", [ + 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("}") + + 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 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(n, cs) - result = genRawSetData(cs, int(getSize(n.typ))) - of nkBracket, nkPar, nkClosure: - var t = skipTypes(n.typ, abstractInst) - if t.kind == tySequence: - result = genConstSeq(p, n, t) - else: - result = genConstSimpleList(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 new file mode 100644 index 000000000..cbef6771f --- /dev/null +++ b/compiler/ccgliterals.nim @@ -0,0 +1,118 @@ +# +# +# The Nim Compiler +# (c) Copyright 2018 Andreas Rumpf +# +# See the file "copying.txt", included in this +# 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. +## The price is that seqs and strings are not purely a library +## implementation. + +template detectVersion(field, corename) = + if m.g.field == 0: + let core = getCompilerProc(m.g.graph, corename) + if core == nil or core.kind != skConst: + m.g.field = 1 + else: + m.g.field = toInt(ast.getInt(core.astdef)) + result = m.g.field + +proc detectStrVersion(m: BModule): int = + detectVersion(strVersion, "nimStrVersion") + +proc detectSeqVersion(m: BModule): int = + detectVersion(seqVersion, "nimSeqVersion") + +# ----- Version 1: GC'ed strings and seqs -------------------------------- + +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; result: var Rope) = + if s.isNil: + 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: + appcg(m, result, "((#NimStringDesc*) &", []) + genStringLiteralDataOnlyV1(m, n.strVal, result) + result.add ")" + else: + appcg(m, result, "((#NimStringDesc*) &$1$2)", + [m.tmpBase, id]) + +# ------ Version 2: destructor based strings and seqs ----------------------- + +proc genStringLiteralDataOnlyV2(m: BModule, s: string; result: Rope; isConst: bool) = + m.s[cfsStrData].addf("static $4 struct {$n" & + " NI cap; NIM_CHAR data[$2+1];$n" & + "} $1 = { $2 | NIM_STRLIT_FLAG, $3 };$n", + [result, rope(s.len), makeCString(s), + rope(if isConst: "const" else: "")]) + +proc genStringLiteralV2(m: BModule; n: PNode; isConst: bool; 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: + m.s[cfsStrData].addf("static $4 NimStringV2 $1 = {$2, (NimStrPayload*)&$3};$n", + [tmp, rope(n.strVal.len), pureLit, rope(if isConst: "const" else: "")]) + else: + 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; + isConst: bool; result: var Rope) = + case detectStrVersion(m) + 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 genNilStringLiteral(m: BModule; info: TLineInfo; result: var Rope) = + appcg(m, result, "((#NimStringDesc*) NIM_NIL)", []) + +proc genStringLiteral(m: BModule; n: PNode; result: var Rope) = + case detectStrVersion(m) + 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.nim deleted file mode 100644 index c6c294b97..000000000 --- a/compiler/ccgmerge.nim +++ /dev/null @@ -1,326 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements the merge operation of 2 different C files. This -## is needed for incremental compilation. - -import - ast, astalgo, ropes, options, strutils, nimlexbase, msgs, cgendata, rodutils, - intsets, platform, llstream - -# 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", - cfsForwardTypes: "NIM_merge_FORWARD_TYPES", - cfsTypes: "NIM_merge_TYPES", - cfsSeqTypes: "NIM_merge_SEQ_TYPES", - cfsFieldInfo: "NIM_merge_FIELD_INFO", - cfsTypeInfo: "NIM_merge_TYPE_INFO", - cfsProcHeaders: "NIM_merge_PROC_HEADERS", - cfsData: "NIM_merge_DATA", - cfsVars: "NIM_merge_VARS", - cfsProcs: "NIM_merge_PROCS", - cfsInitProc: "NIM_merge_INIT_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", - ] - CProcSectionNames: array[TCProcSection, string] = [ - cpsLocals: "NIM_merge_PROC_LOCALS", - cpsInit: "NIM_merge_PROC_INIT", - cpsStmts: "NIM_merge_PROC_BODY" - ] - NimMergeEndMark = "/*\tNIM_merge_END:*/" - -proc genSectionStart*(fs: TCFileSection): PRope = - if compilationCachePresent: - result = toRope(tnl) - app(result, "/*\t") - app(result, CFileSectionNames[fs]) - app(result, ":*/") - app(result, tnl) - -proc genSectionEnd*(fs: TCFileSection): PRope = - if compilationCachePresent: - result = toRope(NimMergeEndMark & tnl) - -proc genSectionStart*(ps: TCProcSection): PRope = - if compilationCachePresent: - result = toRope(tnl) - app(result, "/*\t") - app(result, CProcSectionNames[ps]) - app(result, ":*/") - app(result, tnl) - -proc genSectionEnd*(ps: TCProcSection): PRope = - if compilationCachePresent: - result = toRope(NimMergeEndMark & tnl) - -proc writeTypeCache(a: TIdTable, s: var string) = - var i = 0 - for id, value in pairs(a): - if i == 10: - i = 0 - s.add(tnl) - else: - s.add(' ') - encodeVInt(id, s) - s.add(':') - encodeStr(PRope(value).ropeToStr, s) - inc i - s.add('}') - -proc writeIntSet(a: TIntSet, s: var string) = - var i = 0 - for x in items(a): - if i == 10: - i = 0 - s.add(tnl) - else: - s.add(' ') - encodeVInt(x, s) - inc i - s.add('}') - -proc genMergeInfo*(m: BModule): PRope = - if optSymbolFiles notin gGlobalOptions: return nil - var s = "/*\tNIM_merge_INFO:" - s.add(tnl) - s.add("typeCache:{") - writeTypeCache(m.typeCache, s) - s.add("declared:{") - writeIntSet(m.declaredThings, s) - s.add("typeInfo:{") - writeIntSet(m.typeInfoMarker, s) - s.add("labels:") - encodeVInt(m.labels, s) - s.add(" hasframe:") - encodeVInt(ord(m.FrameDeclared), s) - s.add(tnl) - s.add("*/") - result = s.toRope - -template `^`(pos: expr): expr = L.buf[pos] - -proc skipWhite(L: var TBaseLexer) = - var pos = L.bufpos - while true: - case ^pos - of CR: pos = nimlexbase.HandleCR(L, pos) - of LF: pos = nimlexbase.HandleLF(L, pos) - of ' ': inc pos - else: break - L.bufpos = pos - -proc skipUntilCmd(L: var TBaseLexer) = - var pos = L.bufpos - while true: - case ^pos - of CR: pos = nimlexbase.HandleCR(L, pos) - of LF: pos = nimlexbase.HandleLF(L, pos) - of '\0': break - of '/': - if ^(pos+1) == '*' and ^(pos+2) == '\t': - inc pos, 3 - break - inc pos - else: inc pos - L.bufpos = pos - -proc atEndMark(buf: cstring, pos: int): bool = - var s = 0 - while s < NimMergeEndMark.len and buf[pos+s] == NimMergeEndMark[s]: inc s - result = s == NimMergeEndMark.len - -when false: - proc readVerbatimSection(L: var TBaseLexer): PRope = - var pos = L.bufpos - var buf = L.buf - result = newMutableRope(30_000) - while true: - case buf[pos] - of CR: - pos = nimlexbase.HandleCR(L, pos) - buf = L.buf - result.data.add(tnl) - of LF: - pos = nimlexbase.HandleLF(L, pos) - buf = L.buf - result.data.add(tnl) - of '\0': - InternalError("ccgmerge: expected: " & NimMergeEndMark) - break - else: - if atEndMark(buf, pos): - inc pos, NimMergeEndMark.len - break - result.data.add(buf[pos]) - inc pos - L.bufpos = pos - freezeMutableRope(result) - -proc readVerbatimSection(L: var TBaseLexer): PRope = - var pos = L.bufpos - var buf = L.buf - var r = newStringOfCap(30_000) - while true: - case buf[pos] - of CR: - pos = nimlexbase.HandleCR(L, pos) - buf = L.buf - r.add(tnl) - of LF: - pos = nimlexbase.HandleLF(L, pos) - buf = L.buf - r.add(tnl) - of '\0': - InternalError("ccgmerge: expected: " & NimMergeEndMark) - break - else: - if atEndMark(buf, pos): - inc pos, NimMergeEndMark.len - break - r.add(buf[pos]) - inc pos - L.bufpos = pos - result = r.toRope - -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]) - inc pos - if buf[pos] != ':': internalError("ccgmerge: ':' expected") - L.bufpos = pos + 1 # skip ':' - -proc NewFakeType(id: int): PType = - new(result) - result.id = id - -proc readTypeCache(L: var TBaseLexer, result: var TIdTable) = - if ^L.bufpos != '{': internalError("ccgmerge: '{' expected") - inc L.bufpos - while ^L.bufpos != '}': - skipWhite(L) - var key = decodeVInt(L.buf, L.bufpos) - if ^L.bufpos != ':': internalError("ccgmerge: ':' expected") - inc L.bufpos - var value = decodeStr(L.buf, L.bufpos) - # XXX little hack: we create a "fake" type object with the correct Id - # better would be to adapt the data structure to not even store the - # object as key, but only the Id - IdTablePut(result, newFakeType(key), value.toRope) - inc L.bufpos - -proc readIntSet(L: var TBaseLexer, result: var TIntSet) = - if ^L.bufpos != '{': internalError("ccgmerge: '{' expected") - inc L.bufpos - while ^L.bufpos != '}': - skipWhite(L) - var key = decodeVInt(L.buf, L.bufpos) - result.incl(key) - inc L.bufpos - -proc processMergeInfo(L: var TBaseLexer, m: BModule) = - var k = newStringOfCap("typeCache".len) - while true: - skipWhite(L) - if ^L.bufpos == '*' and ^(L.bufpos+1) == '/': - inc(L.bufpos, 2) - break - readKey(L, k) - case k - of "typeCache": readTypeCache(L, m.typeCache) - of "declared": readIntSet(L, m.declaredThings) - of "typeInfo": readIntSet(L, m.typeInfoMarker) - of "labels": m.labels = decodeVInt(L.buf, L.bufpos) - of "hasframe": m.FrameDeclared = decodeVInt(L.buf, L.bufpos) != 0 - else: InternalError("ccgmerge: unkown key: " & k) - -when not defined(nimhygiene): - {.pragma: inject.} - -template withCFile(cfilename: string, body: stmt) {.immediate.} = - var s = LLStreamOpen(cfilename, fmRead) - if s == nil: return - var L {.inject.}: TBaseLexer - openBaseLexer(L, s) - var k {.inject.} = newStringOfCap("NIM_merge_FORWARD_TYPES".len) - while true: - skipUntilCmd(L) - if ^L.bufpos == '\0': break - body - closeBaseLexer(L) - -proc readMergeInfo*(cfilename: string, m: BModule) = - ## reads the merge meta information into `m`. - withCFile(cfilename): - readKey(L, k) - if k == "NIM_merge_INFO": - processMergeInfo(L, m) - break - -type - TMergeSections = object {.pure.} - f: TCFileSections - p: TCProcSections - -proc readMergeSections(cfilename: string, m: var TMergeSections) = - ## reads the merge sections into `m`. - withCFile(cfilename): - readKey(L, k) - if k == "NIM_merge_INFO": - nil - elif ^L.bufpos == '*' and ^(L.bufpos+1) == '/': - inc(L.bufpos, 2) - # read back into section - skipWhite(L) - var verbatim = readVerbatimSection(L) - skipWhite(L) - var sectionA = CFileSectionNames.find(k) - if sectionA > 0 and sectionA <= high(TCFileSection).int: - m.f[TCFileSection(sectionA)] = verbatim - else: - var sectionB = CProcSectionNames.find(k) - if sectionB >= 0 and sectionB <= high(TCProcSection).int: - m.p[TCProcSection(sectionB)] = verbatim - else: - InternalError("ccgmerge: unknown section: " & k) - else: - InternalError("ccgmerge: '*/' expected") - -proc mergeRequired*(m: BModule): bool = - for i in cfsHeaders..cfsProcs: - if m.s[i] != nil: - #echo "not empty: ", i, " ", ropeToStr(m.s[i]) - return true - for i in low(TCProcSection)..high(TCProcSection): - if m.initProc.s(i) != nil: - #echo "not empty: ", i, " ", ropeToStr(m.initProc.s[i]) - return true - -proc mergeFiles*(cfilename: string, 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): - m.s[i] = con(old.f[i], m.s[i]) - for i in low(TCProcSection)..high(TCProcSection): - m.initProc.s(i) = con(old.p[i], m.initProc.s(i)) - diff --git a/compiler/ccgmerge_unused.nim b/compiler/ccgmerge_unused.nim new file mode 100644 index 000000000..a1413034f --- /dev/null +++ b/compiler/ccgmerge_unused.nim @@ -0,0 +1,283 @@ +# +# +# The Nim Compiler +# (c) Copyright 2012 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## This module implements the merge operation of 2 different C files. This +## is needed for incremental compilation. + +import + 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] = [ + cfsHeaders: "NIM_merge_HEADERS", + cfsFrameDefines: "NIM_merge_FRAME_DEFINES", + cfsForwardTypes: "NIM_merge_FORWARD_TYPES", + cfsTypes: "NIM_merge_TYPES", + cfsSeqTypes: "NIM_merge_SEQ_TYPES", + cfsTypeInfo: "NIM_merge_TYPE_INFO", + cfsProcHeaders: "NIM_merge_PROC_HEADERS", + 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", + cfsTypeInit3: "NIM_merge_TYPE_INIT3", + cfsDynLibInit: "NIM_merge_DYNLIB_INIT" + ] + CProcSectionNames: array[TCProcSection, string] = [ + cpsLocals: "NIM_merge_PROC_LOCALS", + cpsInit: "NIM_merge_PROC_INIT", + cpsStmts: "NIM_merge_PROC_BODY" + ] + 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 + result.add("\n/*\t") + result.add(CFileSectionNames[fs]) + result.add(":*/\n") + +proc genSectionEnd*(fs: TCFileSection; conf: ConfigRef): Rope = + if compilationCachePresent(conf): + result = rope(NimMergeEndMark & "\n") + +proc genSectionStart*(ps: TCProcSection; conf: ConfigRef): Rope = + if compilationCachePresent(conf): + result = rope("") + result.add("\n/*\t") + result.add(CProcSectionNames[ps]) + result.add(":*/\n") + +proc genSectionEnd*(ps: TCProcSection; conf: ConfigRef): Rope = + if compilationCachePresent(conf): + result = rope(NimMergeEndMark & "\n") + +proc writeTypeCache(a: TypeCache, s: var string) = + var i = 0 + for id, value in pairs(a): + if i == 10: + i = 0 + s.add('\L') + else: + s.add(' ') + encodeStr($id, s) + s.add(':') + encodeStr($value, s) + inc i + s.add('}') + +proc writeIntSet(a: IntSet, s: var string) = + var i = 0 + for x in items(a): + if i == 10: + i = 0 + s.add('\L') + else: + s.add(' ') + encodeVInt(x, s) + inc i + s.add('}') + +proc genMergeInfo*(m: BModule): Rope = + if not compilationCachePresent(m.config): return nil + var s = "/*\tNIM_merge_INFO:\n" + s.add("typeCache:{") + writeTypeCache(m.typeCache, s) + s.add("declared:{") + writeIntSet(m.declaredThings, s) + when false: + s.add("typeInfo:{") + writeIntSet(m.typeInfoMarker, s) + s.add("labels:") + encodeVInt(m.labels, s) + s.add(" flags:") + encodeVInt(cast[int](m.flags), s) + s.add("\n*/") + result = s.rope + +template `^`(pos: int): untyped = L.buf[pos] + +proc skipWhite(L: var TBaseLexer) = + var pos = L.bufpos + while true: + case ^pos + of CR: pos = nimlexbase.handleCR(L, pos) + of LF: pos = nimlexbase.handleLF(L, pos) + of ' ': inc pos + else: break + L.bufpos = pos + +proc skipUntilCmd(L: var TBaseLexer) = + var pos = L.bufpos + while true: + case ^pos + of CR: pos = nimlexbase.handleCR(L, pos) + of LF: pos = nimlexbase.handleLF(L, pos) + of '\0': break + of '/': + if ^(pos+1) == '*' and ^(pos+2) == '\t': + inc pos, 3 + break + inc pos + else: inc pos + L.bufpos = pos + +proc atEndMark(buf: cstring, pos: int): bool = + var s = 0 + while s < NimMergeEndMark.len and buf[pos+s] == NimMergeEndMark[s]: inc s + result = s == NimMergeEndMark.len + +proc readVerbatimSection(L: var TBaseLexer): Rope = + var pos = L.bufpos + var r = newStringOfCap(30_000) + while true: + case L.buf[pos] + of CR: + pos = nimlexbase.handleCR(L, pos) + r.add('\L') + of LF: + pos = nimlexbase.handleLF(L, pos) + r.add('\L') + of '\0': + doAssert(false, "ccgmerge: expected: " & NimMergeEndMark) + break + else: + if atEndMark(L.buf, pos): + inc pos, NimMergeEndMark.len + break + 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 + setLen(result, 0) + while L.buf[pos] in IdentChars: + result.add(L.buf[pos]) + inc pos + if L.buf[pos] != ':': doAssert(false, "ccgmerge: ':' expected") + L.bufpos = pos + 1 # skip ':' + +proc readTypeCache(L: var TBaseLexer, result: var TypeCache) = + if ^L.bufpos != '{': doAssert(false, "ccgmerge: '{' expected") + inc L.bufpos + while ^L.bufpos != '}': + skipWhite(L) + var key = decodeStr(L.buf, L.bufpos) + if ^L.bufpos != ':': doAssert(false, "ccgmerge: ':' expected") + inc L.bufpos + discard decodeStr(L.buf, L.bufpos) + inc L.bufpos + +proc readIntSet(L: var TBaseLexer, result: var IntSet) = + if ^L.bufpos != '{': doAssert(false, "ccgmerge: '{' expected") + inc L.bufpos + while ^L.bufpos != '}': + skipWhite(L) + var key = decodeVInt(L.buf, L.bufpos) + result.incl(key) + inc L.bufpos + +proc processMergeInfo(L: var TBaseLexer, m: BModule) = + var k = newStringOfCap("typeCache".len) + while true: + skipWhite(L) + if ^L.bufpos == '*' and ^(L.bufpos+1) == '/': + inc(L.bufpos, 2) + break + readKey(L, k) + case k + of "typeCache": readTypeCache(L, m.typeCache) + of "declared": readIntSet(L, m.declaredThings) + of "typeInfo": + when false: readIntSet(L, m.typeInfoMarker) + of "labels": m.labels = decodeVInt(L.buf, L.bufpos) + of "flags": + m.flags = cast[set[CodegenFlag]](decodeVInt(L.buf, L.bufpos) != 0) + else: doAssert(false, "ccgmerge: unknown key: " & k) + +template withCFile(cfilename: AbsoluteFile, body: untyped) = + var s = llStreamOpen(cfilename, fmRead) + if s == nil: return + var L {.inject.}: TBaseLexer + openBaseLexer(L, s) + var k {.inject.} = newStringOfCap("NIM_merge_FORWARD_TYPES".len) + while true: + skipUntilCmd(L) + if ^L.bufpos == '\0': break + body + closeBaseLexer(L) + +proc readMergeInfo*(cfilename: AbsoluteFile, m: BModule) = + ## reads the merge meta information into `m`. + withCFile(cfilename): + readKey(L, k) + if k == "NIM_merge_INFO": + processMergeInfo(L, m) + break + +type + TMergeSections = object + f: TCFileSections + p: TCProcSections + +proc readMergeSections(cfilename: AbsoluteFile, m: var TMergeSections) = + ## reads the merge sections into `m`. + withCFile(cfilename): + readKey(L, k) + if k == "NIM_merge_INFO": + discard + elif ^L.bufpos == '*' and ^(L.bufpos+1) == '/': + inc(L.bufpos, 2) + # read back into section + skipWhite(L) + var verbatim = readVerbatimSection(L) + skipWhite(L) + var sectionA = CFileSectionNames.find(k) + if sectionA > 0 and sectionA <= high(TCFileSection).int: + m.f[TCFileSection(sectionA)] = verbatim + else: + var sectionB = CProcSectionNames.find(k) + if sectionB >= 0 and sectionB <= high(TCProcSection).int: + m.p[TCProcSection(sectionB)] = verbatim + else: + doAssert(false, "ccgmerge: unknown section: " & k) + else: + doAssert(false, "ccgmerge: '*/' expected") + +proc mergeRequired*(m: BModule): bool = + for i in cfsHeaders..cfsProcs: + if m.s[i] != nil: + #echo "not empty: ", i, " ", m.s[i] + return true + for i in TCProcSection: + if m.initProc.s(i) != nil: + #echo "not empty: ", i, " ", m.initProc.s[i] + return true + +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 TCFileSection: + m.s[i] = old.f[i] & m.s[i] + 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 beffab50b..883108f2c 100644 --- a/compiler/ccgstmts.nim +++ b/compiler/ccgstmts.nim @@ -1,100 +1,181 @@ # # -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # # 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 gSelectedGc in {gcMarkAndSweep, gcGenerational} 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) - linefmt(p.module.initProc, cpsStmts, - "#nimRegisterGlobalMarker($1);$n", prc) - -proc genVarTuple(p: BProc, n: PNode) = - var tup, field: TLoc - if n.kind != nkVarTuple: InternalError(n.info, "genVarTuple") - var L = sonsLen(n) + 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.preInitProc.procSec(cpsInit), + "$n\t#nimRegisterThreadLocalMarker($1);$n$n", [traverseProc]) + else: + appcg(p.module, p.module.preInitProc.procSec(cpsInit), + "$n\t#nimRegisterGlobalMarker($1);$n$n", [traverseProc]) + +proc isAssignedImmediately(conf: ConfigRef; n: PNode): bool {.inline.} = + if n.kind == nkEmpty: + 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) = + if n.kind != nkVarTuple: internalError(p.config, n.info, "genVarTuple") + + # if we have a something that's been captured, use the lowering instead: + for i in 0..<n.len-2: + if n[i].kind != nkSym: + 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 t = tup.t - for i in countup(0, L-3): - var v = n.sons[i].sym + var tup = initLocExpr(p, n[^1]) + var t = tup.t.skipTypes(abstractInst) + for i in 0..<n.len-2: + let vn = n[i] + let v = vn.sym if sfCompileTime in v.flags: continue if sfGlobal in v.flags: - assignGlobalVar(p, v) - 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, v) - initLocalVar(p, v, immediateAsgn=true) - initLoc(field, locExpr, t.sons[i], tup.s) - if t.kind == tyTuple: - field.r = ropef("$1.Field$2", [rdLoc(tup), toRope(i)]) - else: - if t.n.sons[i].kind != nkSym: InternalError(n.info, "genVarTuple") - field.r = ropef("$1.$2", - [rdLoc(tup), mangleRecFieldName(t.n.sons[i].sym, t)]) + assignLocalVar(p, vn) + initLocalVar(p, v, immediateAsgn=isAssignedImmediately(p.config, n[^1])) + var field = initLoc(locExpr, vn, tup.storage) + if t.kind == tyTuple: + field.snippet = "$1.Field$2" % [rdLoc(tup), rope(i)] + else: + 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 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) else: + # this is a hacky way to fix #1181 (tmissingderef):: + # + # var arr1 = cast[ptr array[4, int8]](addr foo)[] + # + # 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. + a.flags.incl(lfEnforceDeref) expr(p, ri, a) -proc startBlock(p: BProc, start: TFormatStr = "{$n", - args: varargs[PRope]): 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 - -proc assignLabel(b: var TBlock): PRope {.inline.} = - b.label = con("LA", b.id.toRope) - result = b.label +proc assignLabel(b: var TBlock; result: var Rope) {.inline.} = + b.label = "LA" & b.id.rope + result.add b.label -proc blockBody(b: var TBlock): PRope = - result = b.sections[cpsLocals] +proc blockBody(b: var TBlock; result: var Rope) = + result.add b.sections[cpsLocals] if b.frameLen > 0: - result.appf("F.len+=$1;$n", b.frameLen.toRope) - result.app(b.sections[cpsInit]) - result.app(b.sections[cpsStmts]) + result.addf("FR_.len+=$1;$n", [b.frameLen.rope]) + result.add(b.sections[cpsInit]) + result.add(b.sections[cpsStmts]) -proc endBlock(p: BProc, blockEnd: PRope) = +proc endBlock(p: BProc, blockEnd: Rope) = let topBlock = p.blocks.len-1 # the block is merged into the parent block - app(p.blocks[topBlock-1].sections[cpsStmts], p.blocks[topBlock].blockBody) - setlen(p.blocks, topBlock) + 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 line(p, cpsStmts, blockEnd) proc endBlock(p: BProc) = - let topBlock = p.blocks.len - 1 - var blockEnd = if p.blocks[topBlock].label != nil: - rfmt(nil, "} $1: ;$n", p.blocks[topBlock].label) - else: - ~"}$n" + let topBlock = p.blocks.len - 1 let frameLen = p.blocks[topBlock].frameLen + var blockEnd: Rope = "" if frameLen > 0: - blockEnd.appf("F.len-=$1;$n", frameLen.toRope) + 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.} = @@ -107,15 +188,55 @@ proc exprBlock(p: BProc, n: PNode, d: var TLoc) = expr(p, n, d) endBlock(p) -template preserveBreakIdx(body: stmt): stmt {.immediate.} = +template preserveBreakIdx(body: untyped): untyped = var oldBreakIdx = p.breakIdx body p.breakIdx = oldBreakIdx proc genState(p: BProc, n: PNode) = - internalAssert n.len == 1 and n.sons[0].kind == nkIntLit - let idx = n.sons[0].intVal - linefmt(p, cpsStmts, "STATE$1: ;$n", idx.toRope) + internalAssert p.config, n.len == 1 + let n0 = n[0] + if n0.kind == nkIntLit: + let idx = n[0].intVal + linefmt(p, cpsStmts, "STATE$1: ;$n", [idx]) + elif n0.kind == nkStrLit: + 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. + + var stack = newSeq[tuple[fin: PNode, inExcept: bool, label: Natural]](0) + + inc p.withinBlockLeaveActions + for i in 1..howManyTrys: + let tryStmt = p.nestedTryStmts.pop + if p.config.exc == excSetjmp: + # Pop safe points generated by try + if not tryStmt.inExcept: + 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. + stack.add(tryStmt) + + # Find finally-stmt for this try-stmt + # and generate a copy of its sons + 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]) + + # 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", []) proc genGotoState(p: BProc, n: PNode) = # we resist the temptation to translate it into duff's device as it later @@ -123,100 +244,217 @@ 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 - lineF(p, cpsStmts, "case -1: goto BeforeRet;$n", []) - for i in 0 .. lastOrd(n.sons[0].typ): - lineF(p, cpsStmts, "case $1: goto STATE$1;$n", [toRope(i)]) + 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[0].typ) + if n.len >= 2 and n[1].kind == nkIntLit: + 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..toInt64(statesCounter): + lineF(p, cpsStmts, "case $2: goto $1$2;$n", [prefix, rope(i)]) lineF(p, cpsStmts, "}$n", []) -proc genBreakState(p: BProc, n: PNode) = +proc genBreakState(p: BProc, n: PNode, d: var TLoc) = var a: TLoc - if n.sons[0].kind == nkClosure: - # XXX this produces quite inefficient code! - initLocExpr(p, n.sons[0].sons[1], a) - lineF(p, cpsStmts, "if (($1->Field0) < 0) break;$n", [rdLoc(a)]) + d = initLoc(locExpr, n, OnUnknown) + + 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) - # the environment is guaranteed to contain the 'state' field at offset 0: - lineF(p, cpsStmts, "if ((((NI*) $1.ClEnv)[0]) < 0) break;$n", [rdLoc(a)]) - # lineF(p, cpsStmts, "if (($1) < 0) break;$n", [rdLoc(a)]) + a = initLocExpr(p, n[0]) + # the environment is guaranteed to contain the 'state' field at offset 1: + d.snippet = "((((NI*) $1.ClE_0)[1]) < 0)" % [rdLoc(a)] -proc genVarPrototypeAux(m: BModule, sym: PSym) -proc genSingleVar(p: BProc, a: PNode) = - var v = a.sons[0].sym - if sfCompileTime in v.flags: return +proc genGotoVar(p: BProc; value: PNode) = + if value.kind notin {nkCharLit..nkUInt64Lit}: + localError(p.config, value.info, "'goto' target must be a literal value") + else: + lineF(p, cpsStmts, "goto NIMSTATE_$#;$n", [value.intVal.rope]) + +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, 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 immediateAsgn = a.sons[2].kind != nkEmpty + var valueAsRope = "" + potentialValueInit(p, v, value, valueAsRope) if sfGlobal in v.flags: - if v.owner.kind != skModule: + if v.flags * {sfImportc, sfExportc} == {sfImportc} 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, v) + 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 + # 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 + # 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 generatedHeader != nil: - genVarPrototypeAux(generatedHeader, v) - registerGcRoot(p, v) + if sfExportc in v.flags and p.module.g.generatedHeader != nil: + genVarPrototype(p.module.g.generatedHeader, vn) + registerTraverseProc(p, v) else: - assignLocalVar(p, v) - initLocalVar(p, v, immediateAsgn) + if imm and p.module.compileToCpp and p.splitDecls == 0 and + not containsHiddenPointer(v.typ) and + nimErrorFlagAccessed notin p.flags: + # C++ really doesn't like things like 'Foo f; f = x' as that invokes a + # parameterless constructor followed by an assignment operator. So we + # generate better code here: 'Foo f = x;' + genLineDir(p, vn) + var decl = localVarDecl(p, vn) + var tmp: TLoc + if isCppCtorCall: + var didGenTemp = false + genCppVarForCtor(p, value, decl, didGenTemp) + line(p, cpsStmts, decl) + else: + 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 immediateAsgn: - 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) - -proc genVarStmt(p: BProc, n: PNode) = - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if a.kind == nkIdentDefs: + 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 a.sons[0].kind == nkSym: - genSingleVar(p, a) + if it[0].kind == nkSym: + genSingleVar(p, it) else: - genClosureVar(p, a) + genClosureVar(p, it) else: - genVarTuple(p, a) - -proc genConstStmt(p: BProc, t: PNode) = - for i in countup(0, sonsLen(t) - 1): - var it = t.sons[i] - if it.kind == nkCommentStmt: continue - if it.kind != nkConstDef: InternalError(t.info, "genConstStmt") - var c = it.sons[0].sym - if c.typ.containsCompileTimeOnly: continue - if sfFakeConst in c.flags: - genSingleVar(p, it) - elif c.typ.kind in ConstantDataTypes and lfNoDecl notin c.loc.flags and - c.ast.len != 0: - if not emitLazily(c): requestConstImpl(p, c) - when false: - # generate the data: - fillLoc(c.loc, locData, c.typ, mangleName(c), OnUnknown) - if sfImportc in c.flags: - appf(p.module.s[cfsData], "extern NIM_CONST $1 $2;$n", - [getTypeDesc(p.module, c.typ), c.loc.r]) - else: - appf(p.module.s[cfsData], "NIM_CONST $1 $2 = $3;$n", - [getTypeDesc(p.module, c.typ), c.loc.r, genConstExpr(p, c.ast)]) - + genVarTuple(p, it) + proc genIf(p: BProc, n: PNode, d: var TLoc) = # # { if (!expr1) goto L1; @@ -231,446 +469,928 @@ proc genIf(p: BProc, n: PNode, d: var TLoc) = # Lend: var a: TLoc - Lelse: TLabel + 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 i in countup(0, sonsLen(n) - 1): - let it = n.sons[i] - if it.len == 2: - when newScopeForIf: startBlock(p) - initLocExpr(p, it.sons[0], a) - Lelse = getLabel(p) + 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: + startBlock(p) + a = initLocExprSingleUse(p, it[0]) + lelse = getLabel(p) inc(p.labels) - lineFF(p, cpsStmts, "if (!$1) goto $2;$n", - "br i1 $1, label %LOC$3, label %$2$nLOC$3: $n", - [rdLoc(a), Lelse, toRope(p.labels)]) - when not newScopeForIf: startBlock(p) - expr(p, it.sons[1], d) + lineF(p, cpsStmts, "if (!$1) goto $2;$n", + [rdLoc(a), lelse]) + if p.module.compileToCpp: + # avoid "jump to label crosses initialization" error: + p.s(cpsStmts).add "{" + expr(p, it[1], d) + p.s(cpsStmts).add "}" + else: + expr(p, it[1], d) endBlock(p) - if sonsLen(n) > 1: - lineFF(p, cpsStmts, "goto $1;$n", "br label %$1$n", [Lend]) - fixLabel(p, Lelse) + 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(n.info, "genIf()") - if sonsLen(n) > 1: fixLabel(p, Lend) - -proc blockLeaveActions(p: BProc, howMany: int) = - var L = p.nestedTryStmts.len - # danger of endless recursion! we workaround this here by a temp stack - var stack: seq[PNode] - newSeq(stack, howMany) - for i in countup(1, howMany): - stack[i-1] = p.nestedTryStmts[L-i] - setLen(p.nestedTryStmts, L-howMany) - - var alreadyPoppedCnt = p.inExceptBlock - for tryStmt in items(stack): - if gCmd != cmdCompileToCpp: - if alreadyPoppedCnt > 0: - dec alreadyPoppedCnt - else: - linefmt(p, cpsStmts, "#popSafePoint();$n") - var finallyStmt = lastSon(tryStmt) - if finallyStmt.kind == nkFinally: - genStmts(p, finallyStmt.sons[0]) - # push old elements again: - for i in countdown(howMany-1, 0): - p.nestedTryStmts.add(stack[i]) - if gCmd != cmdCompileToCpp: - for i in countdown(p.inExceptBlock-1, 0): - linefmt(p, cpsStmts, "#popCurrentException();$n") + else: internalError(p.config, n.info, "genIf()") + if n.len > 1: fixLabel(p, lend) proc genReturnStmt(p: BProc, t: PNode) = - p.beforeRetNeeded = true + if nfPreventCg in t.flags: return + p.flags.incl beforeRetNeeded genLineDir(p, t) - if (t.sons[0].kind != nkEmpty): genStmts(p, t.sons[0]) - blockLeaveActions(p, min(1, p.nestedTryStmts.len)) - lineFF(p, cpsStmts, "goto BeforeRet;$n", "br label %BeforeRet$n", []) + if (t[0].kind != nkEmpty): genStmts(p, t[0]) + blockLeaveActions(p, + howManyTrys = p.nestedTryStmts.len, + howManyExcepts = p.inExceptBlockLen) + 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[^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: + startBlock(p) + 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[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 = 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 + 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 = 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: + localError(p.config, n.info, "no case statement found for computed goto"); return + var id = p.labels+1 + inc p.labels, arraySize+1 + let tmp = "TMP$1_" % [id.rope] + var gotoArray = "static void* $#[$#] = {" % [tmp, arraySize.rope] + for i in 1..arraySize-1: + gotoArray.addf("&&TMP$#_, ", [rope(id+i)]) + gotoArray.addf("&&TMP$#_};$n", [rope(id+arraySize)]) + line(p, cpsLocals, gotoArray) + + for j in 0..<casePos: + genStmts(p, n[j]) + + 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: + startBlock(p) + 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[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[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 + var a: TLoc - Labl: TLabel - 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]) - genStmts(p, t.sons[1]) - - if optProfiler in p.options: - # invoke at loop body exit: - linefmt(p, cpsStmts, "#nimProfile();$n") - endBlock(p) + 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[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) dec(p.withinLoop) -proc genBlock(p: BProc, t: PNode, d: var TLoc) = +proc genBlock(p: BProc, n: PNode, d: var TLoc) = + 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 t.sons[0].kind != nkEmpty: + if n[0].kind != nkEmpty: # named block? - assert(t.sons[0].kind == nkSym) - var sym = t.sons[0].sym + assert(n[0].kind == nkSym) + var sym = n[0].sym sym.loc.k = locOther - sym.loc.a = p.breakIdx - expr(p, t.sons[1], d) + sym.position = p.breakIdx+1 + 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, forLoopVar) + 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.toRope) - + 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) = + +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(sym.loc.k == locOther) - idx = sym.loc.a + assert(t[0].kind == nkSym) + var sym = t[0].sym + doAssert(sym.loc.k == locOther) + idx = sym.position-1 else: # an unnamed 'break' can only break a loop after 'transf' pass: while idx >= 0 and not p.blocks[idx].isLoop: dec idx if idx < 0 or not p.blocks[idx].isLoop: - InternalError(t.info, "no loop to break") - let label = assignLabel(p.blocks[idx]) - blockLeaveActions(p, p.nestedTryStmts.len - p.blocks[idx].nestedTryStmts) + internalError(p.config, t.info, "no loop to break") + 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 getRaiseFrmt(p: BProc): string = - if gCmd == cmdCompileToCpp: - result = "throw NimException($1, $2);$n" - else: - result = "#raiseException((#E_Base*)$1, $2);$n" +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 genRaiseStmt(p: BProc, t: PNode) = - if p.inExceptBlock > 0: +proc raiseExitCleanup(p: BProc, destroy: string) = + assert p.config.exc == excGoto + if nimErrorFlagDisabled notin p.flags: + p.flags.incl nimErrorFlagAccessed + if p.nestedTryStmts.len == 0: + p.flags.incl beforeRetNeeded + # easy case, simply goto 'ret': + lineCg(p, cpsStmts, "if (NIM_UNLIKELY(*nimErr_)) {$1; goto BeforeRet_;}$n", [destroy]) + else: + lineCg(p, cpsStmts, "if (NIM_UNLIKELY(*nimErr_)) {$2; goto LA$1_;}$n", + [p.nestedTryStmts[^1].label, destroy]) + +proc finallyActions(p: BProc) = + if p.config.exc != excGoto and p.nestedTryStmts.len > 0 and p.nestedTryStmts[^1].inExcept: # if the current try stmt have a finally block, # we must execute it before reraising - var finallyBlock = p.nestedTryStmts[p.nestedTryStmts.len - 1].lastSon - if finallyBlock.kind == nkFinally: - genSimpleBlock(p, finallyBlock.sons[0]) - if t.sons[0].kind != nkEmpty: - var a: TLoc - InitLocExpr(p, t.sons[0], a) + 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]) + finallyActions(p) var e = rdLoc(a) - var typ = skipTypes(t.sons[0].typ, abstractPtrs) - genLineDir(p, t) - lineCg(p, cpsStmts, getRaiseFrmt(p), [e, makeCString(typ.sym.name.s)]) - else: + 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) - # reraise the last exception: - if gCmd == cmdCompileToCpp: - line(p, cpsStmts, ~"throw;$n") + if isImportedException(typ, p.config): + lineF(p, cpsStmts, "throw $1;$n", [e]) else: - linefmt(p, cpsStmts, "#reraiseException();$n") - -proc genCaseGenericBranch(p: BProc, b: PNode, e: TLoc, - rangeFormat, eqFormat: TFormatStr, 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) - lineCg(p, cpsStmts, rangeFormat, + 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) + linefmt(p, cpsStmts, "#reraiseException();$n", []) + raiseInstr(p, p.s(cpsStmts)) + +template genCaseGenericBranch(p: BProc, b: PNode, e: TLoc, + rangeFormat, eqFormat: FormatStr, labl: TLabel) = + var x, y: TLoc + for i in 0..<b.len - 1: + if b[i].kind == nkRange: + 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) + else: + x = initLocExpr(p, b[i]) lineCg(p, cpsStmts, eqFormat, [rdCharLoc(e), rdCharLoc(x), labl]) -proc genCaseSecondPass(p: BProc, t: PNode, d: var TLoc, - labId, until: int): TLabel = - var Lend = getLabel(p) +proc genCaseSecondPass(p: BProc, t: PNode, d: var TLoc, + labId, until: int): TLabel = + var lend = getLabel(p) for i in 1..until: - lineF(p, cpsStmts, "LA$1: ;$n", [toRope(labId + i)]) - if t.sons[i].kind == nkOfBranch: - var length = sonsLen(t.sons[i]) - exprBlock(p, t.sons[i].sons[length - 1], d) - lineF(p, cpsStmts, "goto $1;$n", [Lend]) + # 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[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) - result = Lend + exprBlock(p, t[i][0], d) + result = lend -proc genIfForCaseUntil(p: BProc, t: PNode, d: var TLoc, - rangeFormat, eqFormat: TFormatStr, +template genIfForCaseUntil(p: BProc, t: PNode, d: var TLoc, + rangeFormat, eqFormat: FormatStr, until: int, a: TLoc): TLabel = - # generate a C-if statement for a Nimrod case statement + # 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, - con("LA", toRope(p.labels))) + 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", [toRope(p.labels)]) + lineF(p, cpsStmts, "goto LA$1_;$n", [rope(p.labels)]) if until < t.len-1: inc(p.labels) var gotoTarget = p.labels - lineF(p, cpsStmts, "goto LA$1;$n", [toRope(gotoTarget)]) - result = genCaseSecondPass(p, t, d, labId, until) - lineF(p, cpsStmts, "LA$1: ;$n", [toRope(gotoTarget)]) + lineF(p, cpsStmts, "goto LA$1_;$n", [rope(gotoTarget)]) + 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, - rangeFormat, eqFormat: TFormatStr) = - var a: TLoc - initLocExpr(p, t.sons[0], a) - var Lend = genIfForCaseUntil(p, t, d, rangeFormat, eqFormat, sonsLen(t)-1, a) - fixLabel(p, Lend) +template genCaseGeneric(p: BProc, t: PNode, d: var TLoc, + rangeFormat, eqFormat: FormatStr) = + 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, - branches: var openArray[PRope]) = +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(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[PRope] + 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, con("LA", toRope(p.labels)), - branches) - else: + 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 - linefmt(p, cpsStmts, "switch (#hashString($1) & $2) {$n", - rdLoc(a), toRope(bitMask)) - for j in countup(0, high(branches)): - if branches[j] != nil: - lineF(p, cpsStmts, "case $1: $n$2break;$n", - [intLiteral(j), branches[j]]) - lineF(p, cpsStmts, "}$n") # else statement: - if t.sons[sonsLen(t)-1].kind != nkOfBranch: - lineF(p, cpsStmts, "goto LA$1;$n", [toRope(p.labels)]) + discard + 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", + [lit, branches[j]]) + lineF(p, cpsStmts, "}$n", []) # else statement: + 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) - fixLabel(p, Lend) + 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") - -proc branchHasTooBigRange(b: PNode): bool = - for i in countup(0, sonsLen(b)-2): + if stringKind == tyCstring: + genCaseGeneric(p, t, d, "", "if (#eqCstrings($1, $2)) goto $3;$n") + else: + genCaseGeneric(p, t, d, "", "if (#eqStrings($1, $2)) goto $3;$n") + +proc branchHasTooBigRange(b: PNode): bool = + result = false + for it in b: # last son is block - if (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: +proc ifSwitchSplitPoint(p: BProc, n: PNode): int = + result = 0 + for i in 1..<n.len: var branch = n[i] var stmtBlock = lastSon(branch) if stmtBlock.stmtsContainPragma(wLinearScanEnd): result = i - elif hasSwitchRange notin CC[ccompiler].props: - if branch.kind == nkOfBranch and branchHasTooBigRange(branch): + elif hasSwitchRange notin CC[p.config.cCompiler].props: + if branch.kind == nkOfBranch and branchHasTooBigRange(branch): result = i proc genCaseRange(p: BProc, branch: PNode) = - var length = branch.len - for j in 0 .. length-2: - if branch[j].kind == nkRange: - if hasSwitchRange in CC[ccompiler].props: - lineF(p, cpsStmts, "case $1 ... $2:$n", [ - genLiteral(p, branch[j][0]), - genLiteral(p, branch[j][1])]) - else: + for j in 0..<branch.len-1: + if branch[j].kind == nkRange: + if hasSwitchRange in CC[p.config.cCompiler].props: + 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)]) - Inc(v.intVal) + while v.intVal <= branch[j][1].intVal: + 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) - + var splitPoint = ifSwitchSplitPoint(p, n) + # generate if part (might be empty): - var a: TLoc - initLocExpr(p, n.sons[0], a) - var Lend = if splitPoint > 0: genIfForCaseUntil(p, n, d, + 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 - + eqFormat = "if ($1 == $2) goto $3;$n", + 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] - if branch.kind == nkOfBranch: + if branch.kind == nkOfBranch: genCaseRange(p, branch) - else: + else: # else part of case statement: - lineF(p, cpsStmts, "default:$n") + lineF(p, cpsStmts, "default:$n", []) hasDefault = true exprBlock(p, branch.lastSon, d) - lineF(p, cpsStmts, "break;$n") - if (hasAssume in CC[ccompiler].props) and not hasDefault: - lineF(p, cpsStmts, "default: __assume(0);$n") - lineF(p, cpsStmts, "}$n") - if Lend != nil: fixLabel(p, Lend) - -proc genCase(p: BProc, t: PNode, d: var TLoc) = + lineF(p, cpsStmts, "break;$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 != "": 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) - of tyFloat..tyFloat128: - genCaseGeneric(p, t, d, "if ($1 >= $2 && $1 <= $3) goto $4;$n", + 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: - genOrdinalCase(p, t, d) - -proc hasGeneralExceptSection(t: PNode): bool = - var length = sonsLen(t) + 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 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", []) + +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 - while (i < length) and (t.sons[i].kind == nkExceptBranch): - var blen = sonsLen(t.sons[i]) - if blen == 1: - return true + 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) - result = false + 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. -proc genTryCpp(p: BProc, t: PNode, d: var TLoc) = # code to generate: # - # XXX: There should be a standard dispatch algorithm - # that's used both here and with multi-methods - # # try # { # myDiv(4, 9); - # } catch (NimException& exp) { - # if (isObj(exp, EIO) { - # ... - # } else if (isObj(exp, ESystem) { - # ... - # finallyPart() - # raise; - # } else { - # // general handler - # } - # } - # finallyPart(); + # } catch (NimExceptionType1&) { + # body + # } catch (NimExceptionType2&) { + # finallyPart() + # raise; + # } + # catch(...) { + # general_handler_body + # } + # finallyPart(); + + template genExceptBranchBody(body: PNode) {.dirty.} = + genRestoreFrameAfterException(p) + expr(p, body, d) + if not isEmptyType(t.typ) and d.k == locNone: - getTemp(p, t.typ, d) - var - exc: PRope - i, length, blen: int + d = getTemp(p, t.typ) genLineDir(p, t) - exc = getTempName() - discard cgsym(p.module, "E_Base") - add(p.nestedTryStmts, t) + 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.sons[0], d) - length = sonsLen(t) - endBlock(p, ropecg(p.module, "} catch (NimException& $1) {$n", [exc])) - if optStackTrace in p.Options: - linefmt(p, cpsStmts, "#setFrame((TFrame*)&F);$n") - inc p.inExceptBlock - i = 1 + expr(p, t[0], d) + endBlock(p) + var catchAllPresent = false - while (i < length) and (t.sons[i].kind == nkExceptBranch): - blen = sonsLen(t.sons[i]) - if i > 1: appf(p.s(cpsStmts), "else ") - if blen == 1: + + p.nestedTryStmts[^1].inExcept = true + 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: catchAllPresent = true - exprBlock(p, t.sons[i].sons[0], d) + startBlock(p, "catch (...) {$n") + genExceptBranchBody(t[i][0]) + endBlock(p) else: - var orExpr: PRope = nil - for j in countup(0, blen - 2): - assert(t.sons[i].sons[j].kind == nkType) - if orExpr != nil: app(orExpr, "||") - appcg(p.module, orExpr, - "#isObj($1.exp->m_type, $2)", - [exc, genTypeInfo(p.module, t.sons[i].sons[j].typ)]) - lineF(p, cpsStmts, "if ($1) ", [orExpr]) - exprBlock(p, t.sons[i].sons[blen-1], d) - inc(i) - - # reraise the exception if there was no catch all - # and none of the handlers matched - if not catchAllPresent: - if i > 1: lineF(p, cpsStmts, "else ") + 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:` + 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)) + genExceptBranchBody(t[i][^1]) # exception handler body will duplicated for every type + endBlock(p) + + discard pop(p.nestedTryStmts) + + 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]) + +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) - var finallyBlock = t.lastSon - if finallyBlock.kind == nkFinally: - expr(p, finallyBlock.sons[0], d) - line(p, cpsStmts, ~"throw;$n") + 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) - - lineF(p, cpsStmts, "}$n") # end of catch block - dec p.inExceptBlock - + + inc(i) discard pop(p.nestedTryStmts) - if (i < length) and (t.sons[i].kind == nkFinally): - exprBlock(p, t.sons[i].sons[0], d) - -proc genTry(p: BProc, t: PNode, d: var TLoc) = + endBlock(p) + + 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 @@ -692,7 +1412,7 @@ proc genTry(p: BProc, t: PNode, d: var TLoc) = # clearException(); # } # } - # { + # { # /* finally: */ # printf('fin!\n'); # } @@ -700,177 +1420,291 @@ proc genTry(p: BProc, t: PNode, d: var TLoc) = # propagateCurrentException(); # if not isEmptyType(t.typ) and d.k == locNone: - getTemp(p, t.typ, d) + d = getTemp(p, t.typ) + let quirkyExceptions = p.config.exc == excQuirky or + (t.kind == nkHiddenTryStmt and sfSystemModule in p.module.module.flags) + if not quirkyExceptions: + p.module.includeHeader("<setjmp.h>") + else: + p.flags.incl noSafePoints genLineDir(p, t) - var safePoint = getTempName() - discard cgsym(p.module, "E_Base") - linefmt(p, cpsLocals, "#TSafePoint $1;$n", safePoint) - linefmt(p, cpsStmts, "#pushSafePoint(&$1);$n", safePoint) - 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) - expr(p, t.sons[0], d) - linefmt(p, cpsStmts, "#popSafePoint();$n") - endBlock(p) - startBlock(p, "else {$n") - linefmt(p, cpsStmts, "#popSafePoint();$n") - if optStackTrace in p.Options: - linefmt(p, cpsStmts, "#setFrame((TFrame*)&F);$n") - inc p.inExceptBlock + 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: + startBlock(p) + p.nestedTryStmts[^1].inExcept = true var i = 1 - while (i < length) and (t.sons[i].kind == nkExceptBranch): - var blen = sonsLen(t.sons[i]) - if blen == 1: + 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: # general except section: - if i > 1: lineF(p, cpsStmts, "else") + 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: PRope = nil - for j in countup(0, blen - 2): - assert(t.sons[i].sons[j].kind == nkType) - if orExpr != nil: app(orExpr, "||") - appcg(p.module, orExpr, - "#isObj(#getCurrentException()->Sup.m_type, $1)", - [genTypeInfo(p.module, t.sons[i].sons[j].typ)]) + 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) - dec p.inExceptBlock discard pop(p.nestedTryStmts) endBlock(p) # end of else block - if i < length and t.sons[i].kind == nkFinally: - exprBlock(p, t.sons[i].sons[0], d) - linefmt(p, cpsStmts, "if ($1.status != 0) #reraiseException();$n", safePoint) - -proc genAsmOrEmitStmt(p: BProc, t: PNode): PRope = - for i in countup(0, sonsLen(t) - 1): - case t.sons[i].Kind - of nkStrLit..nkTripleStrLit: - app(result, t.sons[i].strVal) - of nkSym: - var sym = t.sons[i].sym - if sym.kind in {skProc, skIterator, skMethod}: - var a: TLoc - initLocExpr(p, t.sons[i], a) - app(result, rdLoc(a)) - else: - var r = sym.loc.r - if r == nil: - # if no name has already been given, - # it doesn't matter much: - r = mangleName(sym) - sym.loc.r = r # but be consequent! - app(result, r) - else: InternalError(t.sons[i].info, "genAsmOrEmitStmt()") - -proc genAsmStmt(p: BProc, t: PNode) = + if i < t.len and t[i].kind == nkFinally: + p.finallySafePoints.add(safePoint) + 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) + if not quirkyExceptions: + linefmt(p, cpsStmts, "if ($1.status != 0) #reraiseException();$n", [safePoint]) + +proc genAsmOrEmitStmt(p: BProc, t: PNode, isAsmStmt=false; result: var Rope) = + var res = "" + 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) + res.add($rdLoc(a)) + elif sym.kind == skType: + res.add($getTypeDesc(p.module, sym.typ)) + else: + discard getTypeDesc(p.module, skipTypes(sym.typ, abstractPtrs)) + 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) + res.add($a.rdLoc) + + if isAsmStmt and hasGnuAsm in CC[p.config.cCompiler].props: + for x in splitLines(res): + var j = 0 + while j < x.len and x[j] in {' ', '\t'}: inc(j) + if j < x.len: + if x[j] in {'"', ':'}: + # don't modify the line if already in quotes or + # some clobber register list: + result.add(x); result.add("\L") + else: + # ignore empty lines + result.add("\"") + result.add(x.replace("\"", "\\\"")) + result.add("\\n\"\n") + else: + res.add("\L") + result.add res.rope + +proc genAsmStmt(p: BProc, t: PNode) = assert(t.kind == nkAsmStmt) genLineDir(p, t) - var s = genAsmOrEmitStmt(p, t) - lineF(p, cpsStmts, CC[ccompiler].asmStmtFrmt, [s]) + var s = newRopeAppender() -proc genEmit(p: BProc, t: PNode) = - genLineDir(p, t) - var s = genAsmOrEmitStmt(p, t.sons[1]) - if p.prc == nil: + 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? + p.module.s[cfsProcHeaders].add runtimeFormat(CC[p.config.cCompiler].asmStmtFrmt, [s]) + else: + addIndent p, p.s(cpsStmts) + p.s(cpsStmts).add runtimeFormat(CC[p.config.cCompiler].asmStmtFrmt, [s]) + +proc determineSection(n: PNode): TCFileSection = + result = cfsProcHeaders + if n.len >= 1 and n[0].kind in {nkStrLit..nkTripleStrLit}: + let sec = n[0].strVal + if sec.startsWith("/*TYPESECTION*/"): result = cfsForwardTypes # TODO WORKAROUND + elif sec.startsWith("/*VARSECTION*/"): result = cfsVars + elif sec.startsWith("/*INCLUDESECTION*/"): result = cfsHeaders + +proc genEmit(p: BProc, t: PNode) = + var s = newRopeAppender() + genAsmOrEmitStmt(p, t[1], false, s) + if p.prc == nil: # top level emit pragma? - app(p.module.s[cfsProcHeaders], s) + let section = determineSection(t[1]) + genCLineDir(p.module.s[section], t.info, p.config) + p.module.s[section].add(s) else: + genLineDir(p, t) line(p, cpsStmts, s) -var - breakPointId: int = 0 - gBreakpoints: PRope # later the breakpoints are inserted into the main proc - -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(breakPointId) - name = "bp" & $breakPointId - genLineDir(p, t) # BUGFIX - appcg(p.module, gBreakpoints, - "#dbgRegisterBreakpoint($1, (NCSTRING)$2, (NCSTRING)$3);$n", [ - toRope(toLinenumber(t.info)), makeCString(toFilename(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", - [a.addrLoc, makeCString(renderTree(n.sons[1])), - genTypeInfo(p.module, typ)]) - proc genPragma(p: BProc, n: PNode) = - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] + 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) - else: nil - -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) = + of wPush: + processPushBackendOption(p.config, p.optionsStack, p.options, n, i+1) + of wPop: + processPopBackendOption(p.config, p.optionsStack, p.options) + else: discard + + +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) - var L = lengthOrd(field.typ) - if not ContainsOrIncl(p.module.declaredThings, field.id): - appcg(p.module, cfsVars, "extern $1", - discriminatorTableDecl(p.module, t, field)) + 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)]) + 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)]) - -proc asgnFieldDiscriminant(p: BProc, e: PNode) = - var a, tmp: TLoc - var dotExpr = e.sons[0] - var d: PSym - 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) + 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 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 genAsgn(p: BProc, e: PNode, fastAsgn: bool) = - genLineDir(p, e) - if not FieldDiscriminantCheckNeeded(p, e): - var a: TLoc - InitLocExpr(p, e.sons[0], a) + +proc genAsgn(p: BProc, e: PNode, fastAsgn: bool) = + 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) + asgnFieldDiscriminant(p, e) + else: + let le = e[0] + let ri = e[1] + 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) - loadInto(p, e.sons[0], e.sons[1], a) - else: - asgnFieldDiscriminant(p, e) + genLineDir(p, ri) + loadInto(p, le, ri, a) -proc genStmts(p: BProc, t: PNode) = - var a: TLoc +proc genStmts(p: BProc, t: PNode) = + var a: TLoc = default(TLoc) + + let isPush = p.config.hasHint(hintExtendedContext) + if isPush: pushInfoContext(p.config, t.info) expr(p, t, a) - InternalAssert 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 4785402e7..1f551f022 100644 --- a/compiler/ccgthreadvars.nim +++ b/compiler/ccgthreadvars.nim @@ -1,62 +1,59 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this # 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 -proc emulatedThreadVars(): bool {.inline.} = - result = {optThreads, optTlsEmulation} <= gGlobalOptions +proc emulatedThreadVars(conf: ConfigRef): bool = + result = {optThreads, optTlsEmulation} <= conf.globalOptions -proc AccessThreadLocalVar(p: BProc, s: PSym) = - if emulatedThreadVars() and not p.ThreadVarAccessed: - p.ThreadVarAccessed = true - p.module.usesThreadVars = true - appf(p.procSec(cpsLocals), "\tNimThreadVars* NimTV;$n") - app(p.procSec(cpsInit), - ropecg(p.module, "\tNimTV = (NimThreadVars*) #GetThreadLocalVars();$n")) - -var - nimtv: PRope # nimrod thread vars; the struct body - nimtvDeps: seq[PType] = @[] # type deps: every module needs whole struct - nimtvDeclared = initIntSet() # so that every var/field exists only once - # in the struct - -# 'nimtv' is incredibly hard to modularize! Best effort is to store all thread -# vars in a ROD section and with their type deps and load them -# unconditionally... - -# nimtvDeps is VERY hard to cache because it's not a list of IDs nor can it be -# made to be one. +proc accessThreadLocalVar(p: BProc, s: PSym) = + if emulatedThreadVars(p.config) and threadVarAccessed notin p.flags: + p.flags.incl threadVarAccessed + incl p.module.flags, usesThreadVars + 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(): + if emulatedThreadVars(m.config): # we gather all thread locals var into a struct; we need to allocate # storage for that somehow, can't use the thread local storage # allocator for it :-( - if not containsOrIncl(nimtvDeclared, s.id): - nimtvDeps.add(s.loc.t) - appf(nimtv, "$1 $2;$n", [getTypeDesc(m, s.loc.t), s.loc.r]) + if not containsOrIncl(m.g.nimtvDeclared, s.id): + m.g.nimtvDeps.add(s.loc.t) + m.g.nimtv.addf("$1 $2;$n", [getTypeDesc(m, s.loc.t), s.loc.snippet]) else: - if isExtern: app(m.s[cfsVars], "extern ") - if optThreads in gGlobalOptions: app(m.s[cfsVars], "NIM_THREADVAR ") - app(m.s[cfsVars], getTypeDesc(m, s.loc.t)) - appf(m.s[cfsVars], " $1;$n", [s.loc.r]) - -proc generateThreadLocalStorage(m: BModule) = - if nimtv != nil and (m.usesThreadVars or sfMainModule in m.module.flags): - for t in items(nimtvDeps): discard getTypeDesc(m, t) - appf(m.s[cfsSeqTypes], "typedef struct {$1} NimThreadVars;$n", [nimtv]) - -proc GenerateThreadVarsSize(m: BModule) = - if nimtv != nil: - app(m.s[cfsProcs], - "NI NimThreadVarsSize(){return (NI)sizeof(NimThreadVars);}" & tnl) + 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 != "" and (usesThreadVars in m.flags or sfMainModule in m.module.flags): + for t in items(m.g.nimtvDeps): discard getTypeDesc(m, t) + finishTypeDescriptions(m) + m.s[cfsSeqTypes].addf("typedef struct {$1} NimThreadVars;$n", [m.g.nimtv]) + +proc generateThreadVarsSize(m: BModule) = + if m.g.nimtv != "": + let externc = if m.config.backend == backendCpp or + sfCompileToCpp in m.module.flags: "extern \"C\" " + else: "" + m.s[cfsProcs].addf( + "$#NI NimThreadVarsSize(){return (NI)sizeof(NimThreadVars);}$n", + [externc.rope]) diff --git a/compiler/ccgtrav.nim b/compiler/ccgtrav.nim index aa8b85600..ed4c79d9a 100644 --- a/compiler/ccgtrav.nim +++ b/compiler/ccgtrav.nim @@ -1,14 +1,13 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2013 Andreas Rumpf # # See the file "copying.txt", included in this # 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,131 +16,180 @@ type p: BProc visitorFrmt: string -proc genTraverseProc(c: var TTraversalClosure, accessor: PRope, typ: PType) +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) +proc getTemp(p: BProc, t: PType, needsInit=false): TLoc -proc genTraverseProc(c: var TTraversalClosure, accessor: PRope, n: PNode) = +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]) + for i in 0..<n.len: + genTraverseProc(c, accessor, n[i], typ) of nkRecCase: - if (n.sons[0].kind != nkSym): InternalError(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 - lineF(p, cpsStmts, "switch ($1.$2) {$n", accessor, disc.loc.r) - for i in countup(1, sonsLen(n) - 1): - let branch = n.sons[i] + 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.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) else: - lineF(p, cpsStmts, "default:$n") - genTraverseProc(c, accessor, lastSon(branch)) - lineF(p, cpsStmts, "break;$n") - lineF(p, cpsStmts, "} $n") + lineF(p, cpsStmts, "default:$n", []) + genTraverseProc(c, accessor, lastSon(branch), typ) + lineF(p, cpsStmts, "break;$n", []) + lineF(p, cpsStmts, "} $n", []) of nkSym: let field = n.sym + if field.typ.kind == tyVoid: return + if field.loc.snippet == "": fillObjectFields(c.p.module, typ) if field.loc.t == nil: - internalError(n.info, "genTraverseProc()") - genTraverseProc(c, ropef("$1.$2", accessor, field.loc.r), field.loc.t) - else: internalError(n.info, "genTraverseProc()") + internalError(c.p.config, n.info, "genTraverseProc()") + genTraverseProc(c, "$1.$2" % [accessor, field.loc.snippet], field.loc.t) + else: internalError(c.p.config, n.info, "genTraverseProc()") -proc parentObj(accessor: PRope): PRope {.inline.} = - if gCmd != cmdCompileToCpp: - result = ropef("$1.Sup", accessor) +proc parentObj(accessor: Rope; m: BModule): Rope {.inline.} = + if not m.compileToCpp: + result = "$1.Sup" % [accessor] else: result = accessor -proc genTraverseProc(c: var TTraversalClosure, accessor: PRope, typ: PType) = +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: - genTraverseProc(c, accessor, lastSon(typ)) - of tyArrayConstr, tyArray: - let arraySize = lengthOrd(typ.sons[0]) - var i: TLoc - getTemp(p, getSysType(tyInt), i) + of tyGenericInst, tyGenericBody, tyTypeDesc, tyAlias, tyDistinct, tyInferred, + tySink, tyOwned: + genTraverseProc(c, accessor, skipModifier(typ)) + of tyArray: + 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.toRope) - genTraverseProc(c, rfmt(nil, "$1[$2]", accessor, i.r), typ.sons[1]) - lineF(p, cpsStmts, "}$n") + [i.snippet, arraySize]) + let oldLen = p.s(cpsStmts).len + 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): - genTraverseProc(c, accessor.parentObj, typ.sons[i]) - if typ.n != nil: genTraverseProc(c, accessor, typ.n) + 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, rfmt(nil, "$1.Field$2", accessor, i.toRope), typ.sons[i]) - of tyRef, tyString, tySequence: - lineCg(p, cpsStmts, c.visitorFrmt, accessor) + let typ = getUniqueType(typ) + 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, rfmt(nil, "$1.ClEnv", accessor)) + lineCg(p, cpsStmts, visitorFrmt, [ropecg(c.p.module, "$1.ClE_0", [accessor]), c.visitorFrmt]) else: - nil + discard -proc genTraverseProcSeq(c: var TTraversalClosure, accessor: PRope, typ: PType) = +proc genTraverseProcSeq(c: TTraversalClosure, accessor: Rope, typ: PType) = var p = c.p - assert typ.kind == tySequence - var i: TLoc - getTemp(p, getSysType(tyInt), i) - lineF(p, cpsStmts, "for ($1 = 0; $1 < $2->$3; $1++) {$n", - i.r, accessor, toRope(if gCmd != cmdCompileToCpp: "Sup.len" else: "len")) - genTraverseProc(c, ropef("$1->data[$2]", accessor, i.r), typ.sons[0]) - lineF(p, cpsStmts, "}$n") - -proc genTraverseProc(m: BModule, typ: PType, reason: TTypeInfoReason): PRope = - var c: TTraversalClosure + assert typ.kind == tySequence + 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$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 + else: + lineF(p, cpsStmts, "}$n", []) + +proc genTraverseProc(m: BModule, origTyp: PType; sig: SigHash): Rope = var p = newProc(nil, m) - result = getGlobalTempName() - - case reason - of tiNew: c.visitorFrmt = "#nimGCvisit((void*)$1, op);$n" - else: assert false - - let header = ropef("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 - assert typ.kind != tyTypedesc + result = "Marker_" & getTypeName(m, origTyp, sig) + 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) + + lineF(p, cpsLocals, "$1 a;$n", [t]) + lineF(p, cpsInit, "a = ($1)p;$n", [t]) + + var c = TTraversalClosure(p: p, + visitorFrmt: "op" # "#nimGCvisit((void*)$1, op);$n" + ) + + assert typ.kind != tyTypeDesc if typ.kind == tySequence: - genTraverseProcSeq(c, "a".toRope, typ) + genTraverseProcSeq(c, "a".rope, typ) else: - if skipTypes(typ.sons[0], typedescInst).kind in {tyArrayConstr, tyArray}: + if skipTypes(typ.elementType, typedescInst+{tyOwned}).kind == tyArray: # C's arrays are broken beyond repair: - genTraverseProc(c, "a".toRope, typ.sons[0]) + genTraverseProc(c, "a".rope, typ.elementType) else: - genTraverseProc(c, "(*a)".toRope, typ.sons[0]) - - let generatedProc = ropef("$1 {$n$2$3$4}$n", - [header, p.s(cpsLocals), p.s(cpsInit), p.s(cpsStmts)]) - - m.s[cfsProcHeaders].appf("$1;$n", header) - m.s[cfsProcs].app(generatedProc) - - -proc genTraverseProcForGlobal(m: BModule, s: PSym): PRope = - discard genTypeInfo(m, s.loc.t) - - var c: TTraversalClosure + genTraverseProc(c, "(*a)".rope, typ.elementType) + + 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[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 genTypeInfoV1(m, s.loc.t, info) + var p = newProc(nil, m) - result = getGlobalTempName() - - c.visitorFrmt = "#nimGCvisit((void*)$1, 0);$n" - c.p = p - let header = ropef("N_NIMCALL(void, $1)()", result) - genTraverseProc(c, s.loc.r, s.loc.t) - - let generatedProc = ropef("$1 {$n$2$3$4}$n", - [header, p.s(cpsLocals), p.s(cpsInit), p.s(cpsStmts)]) - - m.s[cfsProcHeaders].appf("$1;$n", header) - m.s[cfsProcs].app(generatedProc) + var sLoc = rdLoc(s.loc) + result = getTempName(m) + + if sfThread in s.flags and emulatedThreadVars(m.config): + accessThreadLocalVar(p, s) + sLoc = "NimTV_->" & sLoc + + 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) + + 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[cfsProcs].add(generatedProc) diff --git a/compiler/ccgtypes.nim b/compiler/ccgtypes.nim index 4d0fae451..2c2556336 100644 --- a/compiler/ccgtypes.nim +++ b/compiler/ccgtypes.nim @@ -1,7 +1,7 @@ # # -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2017 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -11,944 +11,1921 @@ # ------------------------- Name Mangling -------------------------------- -proc mangleField(name: string): string = - case name[0] - of 'a'..'z': - result = "" - add(result, chr(ord(name[0]) - ord('a') + ord('A'))) - of '0'..'9', 'A'..'Z': - result = "" - add(result, name[0]) - else: result = "HEX" & toHex(ord(name[0]), 2) - for i in countup(1, len(name) - 1): - case name[i] - of 'A'..'Z': - add(result, chr(ord(name[i]) - ord('A') + ord('a'))) - of '_': - nil - of 'a'..'z', '0'..'9': - add(result, name[i]) - else: - add(result, "HEX") - add(result, toHex(ord(name[i]), 2)) - -proc mangle(name: string): string = - when false: - case name[0] - of 'a'..'z': - result = "" - add(result, chr(ord(name[0]) - ord('a') + ord('A'))) - of '0'..'9', 'A'..'Z': - result = "" - add(result, name[0]) - else: result = "HEX" & toHex(ord(name[0]), 2) - result = "" - for i in countup(0, len(name) - 1): - case name[i] - of 'A'..'Z': - add(result, chr(ord(name[i]) - ord('A') + ord('a'))) - of '_': - nil - of 'a'..'z', '0'..'9': - add(result, name[i]) - else: - add(result, "HEX") - add(result, toHex(ord(name[i]), 2)) +import sighashes, modulegraphs, std/strscans +import ../dist/checksums/src/checksums/md5 +import std/sequtils + +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 = - # nimrod and C++ share some keywords - # it's more efficient to test the whole nimrod keywords range + # Nim and C++ share some keywords + # it's more efficient to test the whole Nim keywords range case w.id of ccgKeywordsLow..ccgKeywordsHigh, nimKeywordsLow..nimKeywordsHigh, ord(wInline): return true else: return false -proc mangleName(s: PSym): PRope = - result = s.loc.r - if result == nil: - if gCmd == cmdCompileToLLVM: - case s.kind - of skProc, skMethod, skConverter, skConst, skIterator: - result = ~"@" - of skVar, skForVar, skResult, skLet: - if sfGlobal in s.flags: result = ~"@" - else: result = ~"%" - of skTemp, skParam, skType, skEnumField, skModule: - result = ~"%" - else: InternalError(s.info, "mangleName") - when oKeepVariableNames: - let keepOrigName = s.kind in skLocalVars - {skForVar} and - {sfFromGeneric, sfGlobal, sfShadowed} * s.flags == {} and - not isKeyword(s.name) - # XXX: This is still very experimental - # - # Even with all these inefficient checks, the bootstrap - # time is actually improved. This is probably because so many - # rope concatenations are now eliminated. - # - # Future notes: - # sfFromGeneric seems to be needed in order to avoid multiple - # definitions of certain variables generated in transf with - # names such as: - # `r`, `res` - # I need to study where these come from. - # - # about sfShadowed: - # consider the following nimrod code: - # var x = 10 - # block: - # var x = something(x) - # The generated C code will be: - # NI x; - # x = 10; - # { - # NI x; - # x = something(x); // Oops, x is already shadowed here - # } - # Right now, we work-around by not keeping the original name - # of the shadowed variable, but we can do better - we can - # create an alternative reference to it in the outer scope and - # use that in the inner scope. - # - # about isCKeyword: - # nimrod variable names can be C keywords. - # We need to avoid such names in the generated code. - # XXX: Study whether mangleName is called just once per variable. - # Otherwise, there might be better place to do this. - # - # about sfGlobal: - # This seems to be harder - a top level extern variable from - # another modules can have the same name as a local one. - # Maybe we should just implement sfShadowed for them too. - # - # about skForVar: - # These are not properly scoped now - we need to add blocks - # around for loops in transf - if keepOrigName: - result = s.name.s.mangle.newRope - else: - app(result, newRope(mangle(s.name.s))) - app(result, ~"_") - app(result, toRope(s.id)) - else: - app(result, newRope(mangle(s.name.s))) - app(result, ~"_") - app(result, toRope(s.id)) - s.loc.r = result - -proc typeName(typ: PType): PRope = - result = if typ.sym != nil: typ.sym.name.s.mangle.toRope - else: ~"TY" - -proc getTypeName(typ: PType): PRope = - if (typ.sym != nil) and ({sfImportc, sfExportc} * typ.sym.flags != {}) and - (gCmd != cmdCompileToLLVM): - result = typ.sym.loc.r - else: - if typ.loc.r == nil: - typ.loc.r = if gCmd != cmdCompileToLLVM: con(typ.typeName, typ.id.toRope) - else: con([~"%", typ.typeName, typ.id.toRope]) - result = typ.loc.r - if result == nil: InternalError("getTypeName: " & $typ.kind) - -proc mapSetType(typ: PType): TCTypeKind = - case int(getSize(typ)) +proc mangleField(m: BModule; name: PIdent): string = + result = mangle(name.s) + # fields are tricky to get right and thanks to generic types producing + # duplicates we can end up mangling the same field multiple times. However + # if we do so, the 'cppDefines' table might be modified in the meantime + # meaning we produce inconsistent field names (see bug #5404). + # Hence we do not check for ``m.g.config.cppDefines.contains(result)`` here + # anymore: + if isKeyword(name): + result.add "_0" + +proc mangleProc(m: BModule; s: PSym; makeUnique: bool): string = + result = "_Z" # Common prefix in Itanium ABI + result.add encodeSym(m, s, makeUnique) + if s.typ.len > 1: #we dont care about the return param + for i in 1..<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 fillParamName(m: BModule; s: PSym) = + if s.loc.snippet == "": + var res = s.name.s.mangle + res.add mangleParamExt(s) + #res.add idOrSig(s, res, m.sigConflicts, m.config) + # Take into account if HCR is on because of the following scenario: + # if a module gets imported and it has some more importc symbols in it, + # some param names might receive the "_0" suffix to distinguish from what + # 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 fillLocalName(p: BProc; s: PSym) = + assert s.kind in skLocalVars+{skTemp} + #assert sfGlobal notin s.flags + if s.loc.snippet == "": + var key = s.name.s.mangle + let counter = p.sigConflicts.getOrDefault(key) + 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.snippet = result + if s.kind != skTemp: writeMangledName(p.module.ndi, s, p.config) + +proc scopeMangledParam(p: BProc; param: PSym) = + ## parameter generation only takes BModule, not a BProc, so we have to + ## remember these parameter names are already in scope to be able to + ## generate unique identifiers reliably (consider that ``var a = a`` is + ## even an idiom in Nim). + var key = param.name.s.mangle + p.sigConflicts.inc(key) + +const + irrelevantForBackend = {tyGenericBody, tyGenericInst, tyGenericInvocation, + tyDistinct, tyRange, tyStatic, tyAlias, tySink, + tyInferred, tyOwned} + +proc typeName(typ: PType; result: var Rope) = + let typ = typ.skipTypes(irrelevantForBackend) + 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.snippet + + if t.kind in irrelevantForBackend: + t = t.skipModifier + else: + break + let typ = if typ.kind in {tyAlias, tySink, tyOwned}: typ.elementType else: typ + if typ.loc.snippet == "": + typ.typeName(typ.loc.snippet) + typ.loc.snippet.add $sig + else: + when defined(debugSigHashes): + # check consistency: + 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)) of 1: result = ctInt8 of 2: result = ctInt16 of 4: result = ctInt32 of 8: result = ctInt64 else: result = ctArray -proc mapType(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 tySet: result = mapSetType(typ) - of tyOpenArray, tyArrayConstr, tyArray, tyVarargs: result = ctArray + of tyNil: result = ctPtr + of tySet: result = mapSetType(conf, typ) + 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 + result = mapType(conf, typ.skipModifier, isParam) of tyGenericBody, tyGenericInst, tyGenericParam, tyDistinct, tyOrdinal, - tyConst, tyMutable, tyIter, tyTypeDesc: - result = mapType(lastSon(typ)) - of tyEnum: - if firstOrd(typ) < 0: + tyTypeDesc, tyAlias, tySink, tyInferred, tyOwned: + result = mapType(conf, skipModifier(typ), isParam) + of tyEnum: + if firstOrd(conf, typ) < 0: result = ctInt32 - else: - case int(getSize(typ)) + else: + case int(getSize(conf, typ)) of 1: result = ctUInt8 of 2: result = ctUInt16 of 4: result = ctInt32 of 8: result = ctInt64 - else: internalError("mapType") - of tyRange: result = mapType(typ.sons[0]) - of tyPtr, tyVar, tyRef: - var base = skipTypes(typ.sons[0], typedescInst) + else: result = ctInt32 + of tyRange: result = mapType(conf, typ.elementType, isParam) + of tyPtr, tyVar, tyLent, tyRef: + var base = skipTypes(typ.elementType, typedescInst) case base.kind - of tyOpenArray, tyArrayConstr, tyArray, tyVarargs: result = ctArray + 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)) - else: InternalError("mapType") - -proc mapReturnType(typ: PType): TCTypeKind = - if skipTypes(typ, typedescInst).kind == tyArray: result = ctPtr - else: result = mapType(typ) - -proc getTypeDescAux(m: BModule, typ: PType, check: var TIntSet): PRope -proc needsComplexAssignment(typ: PType): bool = - result = containsGarbageCollectedRef(typ) - -proc isInvalidReturnType(rettype: PType): bool = + of tyStatic: + 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, false) + +proc isImportedType(t: PType): bool = + result = t.sym != nil and sfImportc in t.sym.flags + +proc isImportedCppType(t: PType): bool = + let x = t.skipTypes(irrelevantForBackend) + result = (t.sym != nil and sfInfixCall in t.sym.flags) or + (x.sym != nil and sfInfixCall in x.sym.flags) + +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.baseClass == nil) or isPureObject(typ)) + +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 - else: - case mapType(rettype) - of ctArray: + 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, false) + of ctArray: result = not (skipTypes(rettype, typedescInst).kind in - {tyVar, tyRef, tyPtr}) - of ctStruct: - result = needsComplexAssignment(skipTypes(rettype, typedescInst)) + {tyVar, tyLent, tyRef, tyPtr}) + of ctStruct: + let t = skipTypes(rettype, typedescInst) + 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 - CallingConvToStr: array[TCallingConvention, string] = ["N_NIMCALL", - "N_STDCALL", "N_CDECL", "N_SAFECALL", + +const + CallingConvToStr: array[TCallingConvention, string] = ["N_NIMCALL", + "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"] - CallingConvToStrLLVM: array[TCallingConvention, string] = ["fastcc $1", - "stdcall $1", "ccc $1", "safecall $1", "syscall $1", "$1 alwaysinline", - "$1 noinline", "fastcc $1", "ccc $1", "$1"] + # but one can #define it to what one wants + "N_INLINE", "N_NOINLINE", "N_FASTCALL", "N_THISCALL", "N_CLOSURE", "N_NOCONV", + "N_NOCONV" #ccMember is N_NOCONV + ] -proc CacheGetType(tab: TIdTable, key: PType): PRope = +proc cacheGetType(tab: TypeCache; sig: SigHash): Rope = # returns nil if we need to declare this type - # since types are now unique via the ``GetUniqueType`` mechanism, this slow + # since types are now unique via the ``getUniqueType`` mechanism, this slow # linear search is not necessary anymore: - result = PRope(IdTableGet(tab, key)) + result = tab.getOrDefault(sig) -proc getTempName(): PRope = - result = rfmt(nil, "TMP$1", toRope(backendId())) +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 getGlobalTempName(): PRope = - result = rfmt(nil, "TMP$1", toRope(backendId())) -proc ccgIntroducedPtr(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 (optByRef in s.options) or (getSize(pt) > platform.floatSize * 2): - 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(pt) > platform.floatSize*2) or (optByRef in s.options) - else: result = false - -proc fillResult(param: PSym) = - fillLoc(param.loc, locParam, param.typ, ~"Result", +proc fillResult(conf: ConfigRef; param: PNode, proctype: PType) = + fillLoc(param.sym.loc, locParam, param, "Result", OnStack) - if (mapReturnType(param.typ) != ctArray) and IsInvalidReturnType(param.typ): - incl(param.loc.flags, lfIndirect) - param.loc.s = OnUnknown - -proc getParamTypeDesc(m: BModule, t: PType, check: var TIntSet): PRope = - when false: - if t.Kind in {tyRef, tyPtr, tyVar}: - var b = skipTypes(t.sons[0], typedescInst) - if b.kind == tySet and mapSetType(b) == ctArray: - return getTypeDescAux(m, b, check) - result = getTypeDescAux(m, t, check) + let t = param.sym.typ + if mapReturnType(conf, t) != ctArray and isInvalidReturnType(conf, proctype): + incl(param.sym.loc.flags, lfIndirect) + param.sym.loc.storage = OnUnknown + +proc typeNameOrLiteral(m: BModule; t: PType, literal: string): Rope = + if t.sym != nil and sfImportc in t.sym.flags and t.sym.magic == mNone: + useHeader(m, t.sym) + result = t.sym.loc.snippet + else: + result = rope(literal) + +proc getSimpleTypeDesc(m: BModule; typ: PType): Rope = + const + NumericalTypeToStr: array[tyInt..tyUInt64, string] = [ + "NI", "NI8", "NI16", "NI32", "NI64", + "NF", "NF32", "NF64", "NF128", + "NU", "NU8", "NU16", "NU32", "NU64"] + case typ.kind + of tyPointer: + result = typeNameOrLiteral(m, typ, "void*") + of tyString: + case detectStrVersion(m) + of 2: + cgsym(m, "NimStrPayload") + cgsym(m, "NimStringV2") + result = typeNameOrLiteral(m, typ, "NimStringV2") + else: + cgsym(m, "NimStringDesc") + result = typeNameOrLiteral(m, typ, "NimStringDesc*") + of tyCstring: result = typeNameOrLiteral(m, typ, "NCSTRING") + of tyBool: result = typeNameOrLiteral(m, typ, "NIM_BOOL") + of tyChar: result = typeNameOrLiteral(m, typ, "NIM_CHAR") + of tyNil: result = typeNameOrLiteral(m, typ, "void*") + of tyInt..tyUInt64: + result = typeNameOrLiteral(m, typ, NumericalTypeToStr[typ.kind]) + of tyDistinct, tyRange, tyOrdinal: result = getSimpleTypeDesc(m, typ.skipModifier) + of tyStatic: + 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 + +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 = + if typ == nil: result = rope("void") + else: + result = getSimpleTypeDesc(m, typ) + if result == "": result = cacheGetType(m.typeCache, sig) + +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 seqStar(m: BModule): string = + if optSeqDestructors in m.config.globalOptions: result = "" + else: result = "*" + +proc getTypeForward(m: BModule; typ: PType; sig: SigHash): Rope = + result = cacheGetType(m.forwTypeCache, sig) + if result != "": return + result = getTypePre(m, typ, sig) + 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): + 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; 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: + let etB = t.skipTypes(abstractInst) + case etB.kind + of tyObject, tyTuple: + if isImportedCppType(etB) and t.kind == tyGenericInst: + result = getTypeDescAux(m, t, check, kind) + else: + result = getTypeForward(m, t, hashType(t, m.config)) + pushType(m, t) + of tySequence: + 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, 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, tyTypeDesc}).kind notin {tyArray, tyOpenArray}: + if param.typ.skipTypes({tyVar, tyLent, tyTypeDesc}).kind notin { + tyArray, tyOpenArray, tyVarargs}: result = OnStack else: result = OnUnknown -proc genProcParams(m: BModule, t: PType, rettype, params: var PRope, - check: var TIntSet, declareEnvironment=true) = - params = nil - if (t.sons[0] == nil) or isInvalidReturnType(t.sons[0]): - 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(t.n.info, "genProcParams") - var param = t.n.sons[i].sym +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 = "(" + if t.returnType == nil or isInvalidReturnType(m.config, t): + rettype = "void" + else: + rettype = getTypeDescAux(m, t.returnType, check, dkResult) + for i in 1..<t.n.len: + if t.n[i].kind != nkSym: internalError(m.config, t.n.info, "genProcParams") + var param = t.n[i].sym + var descKind = dkParam + if m.config.backend == backendCpp and optByRef in param.options: + if param.typ.kind == tyGenericInst: + descKind = dkRefGenericParam + else: + descKind = dkRefParam if isCompileTimeOnly(param.typ): continue - if params != nil: app(params, ~", ") - fillLoc(param.loc, locParam, param.typ, mangleName(param), + if params != "(": params.add(", ") + fillParamName(m, param) + fillLoc(param.loc, locParam, t.n[i], param.paramStorageLoc) - app(params, getParamTypeDesc(m, param.typ, check)) - if ccgIntroducedPtr(param): - app(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.s = OnUnknown - app(params, ~" ") - app(params, param.loc.r) + param.loc.storage = OnUnknown + elif weakDep: + 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: + params.add runtimeFormat(param.cgDeclFrmt, [typ, param.loc.snippet]) # declare the len field for open arrays: - var arr = param.typ - if arr.kind == tyVar: arr = arr.sons[0] + 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}: + while arr.kind in {tyOpenArray, tyVarargs}: # this fixes the 'sort' bug: - if param.typ.kind == tyVar: param.loc.s = OnUnknown + if param.typ.kind in {tyVar, tyLent}: param.loc.storage = OnUnknown # need to pass hidden parameter: - appff(params, ", NI $1Len$2", ", @NI $1Len$2", [param.loc.r, j.toRope]) + params.addf(", NI $1Len_$2", [param.loc.snippet, j.rope]) inc(j) - arr = arr.sons[0] - if (t.sons[0] != nil) and isInvalidReturnType(t.sons[0]): - var arr = t.sons[0] - if params != nil: app(params, ", ") - app(params, getTypeDescAux(m, arr, check)) - if (mapReturnType(t.sons[0]) != ctArray) or (gCmd == cmdCompileToLLVM): - app(params, "*") - appff(params, " Result", " @Result", []) - if t.callConv == ccClosure and declareEnvironment: - if params != nil: app(params, ", ") - app(params, "void* ClEnv") - if tfVarargs in t.flags: - if params != nil: app(params, ", ") - app(params, "...") - if params == nil and gCmd != cmdCompileToLLVM: app(params, "void)") - else: app(params, ")") - params = con("(", params) - -proc isImportedType(t: PType): bool = - result = (t.sym != nil) and (sfImportc in t.sym.flags) - -proc typeNameOrLiteral(t: PType, literal: string): PRope = - if (t.sym != nil) and (sfImportc in t.sym.flags) and (t.sym.magic == mNone): - result = getTypeName(t) - else: - result = toRope(literal) - -proc getSimpleTypeDesc(m: BModule, typ: PType): PRope = - const - NumericalTypeToStr: array[tyInt..tyUInt64, string] = [ - "NI", "NI8", "NI16", "NI32", "NI64", - "NF", "NF32", "NF64", "NF128", - "NU", "NU8", "NU16", "NU32", "NU64",] - case typ.Kind - of tyPointer: - result = typeNameOrLiteral(typ, "void*") - of tyEnum: - if firstOrd(typ) < 0: - result = typeNameOrLiteral(typ, "NI32") - else: - case int(getSize(typ)) - of 1: result = typeNameOrLiteral(typ, "NU8") - of 2: result = typeNameOrLiteral(typ, "NU16") - of 4: result = typeNameOrLiteral(typ, "NI32") - of 8: result = typeNameOrLiteral(typ, "NI64") - else: - internalError(typ.sym.info, "getSimpleTypeDesc: " & $(getSize(typ))) - result = nil - of tyString: - discard cgsym(m, "NimStringDesc") - result = typeNameOrLiteral(typ, "NimStringDesc*") - of tyCstring: result = typeNameOrLiteral(typ, "NCSTRING") - of tyBool: result = typeNameOrLiteral(typ, "NIM_BOOL") - of tyChar: result = typeNameOrLiteral(typ, "NIM_CHAR") - of tyNil: result = typeNameOrLiteral(typ, "0") - of tyInt..tyUInt64: - result = typeNameOrLiteral(typ, NumericalTypeToStr[typ.Kind]) - of tyRange: result = getSimpleTypeDesc(m, typ.sons[0]) - else: result = nil - -proc getTypePre(m: BModule, typ: PType): PRope = - if typ == nil: result = toRope("void") - else: - result = getSimpleTypeDesc(m, typ) - if result == nil: result = CacheGetType(m.typeCache, typ) - -proc getForwardStructFormat(): string = - if gCmd == cmdCompileToCpp: result = "struct $1;$n" - else: result = "typedef struct $1 $1;$n" - -proc getTypeForward(m: BModule, typ: PType): PRope = - result = CacheGetType(m.forwTypeCache, typ) - if result != nil: return - result = getTypePre(m, typ) - if result != nil: return - case typ.kind - of tySequence, tyTuple, tyObject: - result = getTypeName(typ) - if not isImportedType(typ): - appf(m.s[cfsForwardTypes], getForwardStructFormat(), [result]) - IdTablePut(m.forwTypeCache, typ, result) - else: InternalError("getTypeForward(" & $typ.kind & ')') - -proc mangleRecFieldName(field: PSym, rectype: PType): PRope = - if (rectype.sym != nil) and - ({sfImportc, sfExportc} * rectype.sym.flags != {}): - result = field.loc.r - else: - result = toRope(mangleField(field.name.s)) - if result == nil: InternalError(field.info, "mangleRecFieldName") - -proc genRecordFieldsAux(m: BModule, n: PNode, - accessExpr: PRope, rectype: PType, - check: var TIntSet): PRope = - var - ae, uname, sname, a: PRope - k: PNode - field: PSym - result = nil + 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: + params.add(getTypeDescAux(m, arr, check, dkResult)) + params.addf(" Result", []) + if t.callConv == ccClosure and declareEnvironment: + if params != "(": params.add(", ") + params.add("void* ClE_0") + if tfVarargs in t.flags: + 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 == "": 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): - app(result, genRecordFieldsAux(m, n.sons[i], accessExpr, rectype, check)) - of nkRecCase: - if (n.sons[0].kind != nkSym): InternalError(n.info, "genRecordFieldsAux") - app(result, genRecordFieldsAux(m, n.sons[0], accessExpr, rectype, check)) - uname = toRope(mangle(n.sons[0].sym.name.s) & 'U') - if accessExpr != nil: ae = ropef("$1.$2", [accessExpr, uname]) - else: ae = uname - app(result, "union {" & tnl) - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind - of nkOfBranch, nkElse: - k = lastSon(n.sons[i]) - if k.kind != nkSym: - sname = con("S", toRope(i)) - a = genRecordFieldsAux(m, k, ropef("$1.$2", [ae, sname]), rectype, - check) - if a != nil: - app(result, "struct {") - app(result, a) - appf(result, "} $1;$n", [sname]) - else: - app(result, genRecordFieldsAux(m, k, ae, rectype, check)) - else: internalError("genRecordFieldsAux(record case branch)") - appf(result, "} $1;$n", [uname]) - of nkSym: - field = n.sym + of nkRecList: + for i in 0..<n.len: + genRecordFieldsAux(m, n[i], rectype, check, result, unionPrefix) + of nkRecCase: + 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[i]) + if k.kind != nkSym: + 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: + genRecordFieldsAux(m, k, rectype, check, unionBody, unionPrefix) + else: internalError(m.config, "genRecordFieldsAux(record case branch)") + 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) - sname = mangleRecFieldName(field, rectype) - if accessExpr != nil: ae = ropef("$1.$2", [accessExpr, sname]) - else: ae = sname - fillLoc(field.loc, locField, field.typ, ae, OnUnknown) - appf(result, "$1 $2;$n", [getTypeDescAux(m, field.loc.t, check), sname]) - else: internalError(n.info, "genRecordFieldsAux()") - -proc getRecordFields(m: BModule, typ: PType, check: var TIntSet): PRope = - result = genRecordFieldsAux(m, typ.n, nil, typ, check) - -proc getRecordDesc(m: BModule, typ: PType, name: PRope, - check: var TIntSet): PRope = + 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) + 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. + 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 + 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 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() + var ignored = newBuilder("") + addRecordFields(ignored, m, typ, check) + +proc mangleDynLibProc(sym: PSym): Rope + +proc getRecordDesc(m: BModule; typ: PType, name: Rope, + check: var IntSet): Rope = # declare the record: - var hasField = false - if typ.kind == tyObject: - if typ.sons[0] == nil: - if (typ.sym != nil and sfPure in typ.sym.flags) or tfFinal in typ.flags: - result = ropecg(m, "struct $1 {$n", [name]) - else: - result = ropecg(m, "struct $1 {$n#TNimType* m_type;$n", [name]) - hasField = true - elif gCmd == cmdCompileToCpp: - result = ropecg(m, "struct $1 : public $2 {$n", - [name, getTypeDescAux(m, typ.sons[0], check)]) - hasField = true - else: - result = ropecg(m, "struct $1 {$n $2 Sup;$n", - [name, getTypeDescAux(m, typ.sons[0], check)]) - hasField = true - else: - result = ropef("struct $1 {$n", [name]) - var desc = getRecordFields(m, typ, check) - if (desc == nil) and not hasField: - appf(result, "char dummy;$n", []) - else: - app(result, desc) - app(result, "};" & tnl) - -proc getTupleDesc(m: BModule, typ: PType, name: PRope, - check: var TIntSet): PRope = - result = ropef("struct $1 {$n", [name]) - var desc: PRope = nil - for i in countup(0, sonsLen(typ) - 1): - appf(desc, "$1 Field$2;$n", - [getTypeDescAux(m, typ.sons[i], check), toRope(i)]) - if (desc == nil): app(result, "char dummy;" & tnl) - else: app(result, desc) - app(result, "};" & tnl) - -proc pushType(m: BModule, typ: PType) = - add(m.typeStack, typ) - -proc getTypeDescAux(m: BModule, typ: PType, check: var TIntSet): PRope = + 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: + var desc = newBuilder("") + desc.addRecordFields(m, typ, check) + result = runtimeFormat(typ.sym.cgDeclFrmt, [name, desc, baseType]) + +proc getTupleDesc(m: BModule; typ: PType, name: Rope, + check: var IntSet): Rope = + 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 + # placeholders for generic types (e.g. '0, '**2, etc). + # pre: the cursor must be placed at the ' symbol + # post: the cursor will be placed after the final digit + # false will returned if the input is not recognized as a placeholder + inc cursor + let begin = cursor + while pat[cursor] == '*': inc cursor + if pat[cursor] in Digits: + outIdx = pat[cursor].ord - '0'.ord + outStars = cursor - begin + inc cursor + return true + else: + return false + +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.kidsLen: + raiseAssert "invalid apostrophe type parameter index" + + result = typ[idx] + for i in 1..stars: + if result != nil and result.kidsLen > 0: + result = if result.kind == tyGenericInst: result[FirstGenericParamAt] + else: result.elemType + +proc getOpenArrayDesc(m: BModule; t: PType, check: var IntSet; kind: 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 - name, rettype, desc, recdesc: PRope - n: biggestInt - t, et: PType - t = getUniqueType(typ) - if t == nil: InternalError("getTypeDescAux: t == nil") - if t.sym != nil: useHeader(m, t.sym) - result = getTypePre(m, t) - if result != nil: return - if ContainsOrIncl(check, t.id): - InternalError("cannot generate C type for: " & typeToString(typ)) + 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)) # XXX: this BUG is hard to fix -> we need to introduce helper structs, # but determining when this needs to be done is hard. We should split # C type generation into an analysis and a code generation phase somehow. - case t.Kind - of tyRef, tyPtr, tyVar: - et = getUniqueType(t.sons[0]) - if et.kind in {tyArrayConstr, tyArray, tyOpenArray, tyVarargs}: - # this is correct! sets have no proper base type, so we treat - # ``var set[char]`` in `getParamTypeDesc` - et = getUniqueType(elemType(et)) - case et.Kind - of tyObject, tyTuple: - # no restriction! We have a forward declaration for structs - name = getTypeForward(m, et) - result = con(name, "*") - IdTablePut(m.typeCache, t, result) - pushType(m, et) - of tySequence: - # no restriction! We have a forward declaration for structs - name = getTypeForward(m, et) - result = con(name, "**") - IdTablePut(m.typeCache, t, result) - pushType(m, et) - else: + if t.sym != nil: useHeader(m, t.sym) + if t != origTyp and origTyp.sym != nil: useHeader(m, origTyp.sym) + let sig = hashType(origTyp, m.config) + + result = getTypePre(m, t, sig) + defer: # defer is the simplest in this case + if isImportedType(t) and not m.typeABICache.containsOrIncl(sig): + addAbiCheck(m, t, result) + + if result != "" and t.kind != tyOpenArray: + excl(check, t.id) + if kind == dkRefParam or kind == dkRefGenericParam and origTyp.kind == tyGenericInst: + result.add("&") + return + case t.kind + of tyRef, tyPtr, tyVar, tyLent: + var star = if t.kind in {tyVar} and tfVarIsPtr notin origTyp.flags and + compileToCpp(m): "&" else: "*" + var et = origTyp.skipTypes(abstractInst).elementType + var etB = et.skipTypes(abstractInst) + 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, kind) & star + else: + # no restriction! We have a forward declaration for structs + let name = getTypeForward(m, et, hashType(et, m.config)) + result = name & star + m.typeCache[sig] = result + of tySequence: + 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 = con(getTypeDescAux(m, et, check), "*") - IdTablePut(m.typeCache, t, result) - of tyOpenArray, tyVarargs: - et = getUniqueType(t.sons[0]) - result = con(getTypeDescAux(m, et, check), "*") - IdTablePut(m.typeCache, t, result) - of tyProc: - result = getTypeName(t) - IdTablePut(m.typeCache, t, result) - genProcParams(m, t, rettype, desc, check) - if not isImportedType(t): + result = getTypeDescAux(m, et, check, kind) & star + m.typeCache[sig] = result + of tyOpenArray, tyVarargs: + result = getOpenArrayDesc(m, t, check, kind) + of tyEnum: + result = cacheGetType(m.typeCache, sig) + 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: + m.s[cfsTypes].addf("typedef NI32 $1;$n", [result]) + size = 4 + else: + size = int(getSize(m.config, t)) + case size + 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 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 = "" + genProcParams(m, t, rettype, desc, check, true, true) + if not isImportedType(t): if t.callConv != ccClosure: # procedure vars may need a closure! - appf(m.s[cfsTypes], "typedef $1_PTR($2, $3) $4;$n", - [toRope(CallingConvToStr[t.callConv]), rettype, result, desc]) + m.s[cfsTypes].addf("typedef $1_PTR($2, $3) $4;$n", + [rope(CallingConvToStr[t.callConv]), rettype, result, desc]) else: - appf(m.s[cfsTypes], "typedef struct {$n" & - "N_NIMCALL_PTR($2, ClPrc) $3;$n" & - "void* ClEnv;$n} $1;$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, t) - if result == nil: - result = getTypeName(t) - if not isImportedType(t): - appf(m.s[cfsForwardTypes], getForwardStructFormat(), [result]) - IdTablePut(m.forwTypeCache, t, result) - assert(CacheGetType(m.typeCache, t) == nil) - IdTablePut(m.typeCache, t, con(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 gCmd == cmdCompileToCpp: cppSeq else: cSeq) & - " $1 data[SEQ_DECL_SIZE];$n" & - "};$n", [getTypeDescAux(m, t.sons[0], check), result]) - else: - result = toRope("TGenericSeq") - app(result, "*") - of tyArrayConstr, tyArray: - n = lengthOrd(t) - if n <= 0: - n = 1 # make an array of at least one element - result = getTypeName(t) - IdTablePut(m.typeCache, t, result) - if not isImportedType(t): - appf(m.s[cfsTypes], "typedef $1 $2[$3];$n", - [getTypeDescAux(m, t.sons[1], check), result, ToRope(n)]) - of tyObject, tyTuple: - result = CacheGetType(m.forwTypeCache, t) - if result == nil: - result = getTypeName(t) - if not isImportedType(t): - appf(m.s[cfsForwardTypes], getForwardStructFormat(), [result]) - IdTablePut(m.forwTypeCache, t, result) - IdTablePut(m.typeCache, t, result) # always call for sideeffects: - if t.kind != tyTuple: recdesc = getRecordDesc(m, t, result, check) - else: recdesc = getTupleDesc(m, t, result, check) - if not isImportedType(t): app(m.s[cfsTypes], recdesc) - of tySet: - case int(getSize(t)) - of 1: result = toRope("NU8") - of 2: result = toRope("NU16") - of 4: result = toRope("NU32") - of 8: result = toRope("NU64") - else: - result = getTypeName(t) - IdTablePut(m.typeCache, t, result) - if not isImportedType(t): - appf(m.s[cfsTypes], "typedef NU8 $1[$2];$n", - [result, toRope(getSize(t))]) - of tyGenericInst, tyDistinct, tyOrdinal, tyConst, tyMutable, - tyIter, tyTypeDesc: - result = getTypeDescAux(m, lastSon(t), check) - else: - InternalError("getTypeDescAux(" & $t.kind & ')') - result = nil + of tySequence: + 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): + 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): + let foo = getTypeDescAux(m, t.elementType, check, kind) + m.s[cfsTypes].addf("typedef $1 $2[1];$n", [foo, result]) + of tyArray: + var n: BiggestInt = toInt64(lengthOrd(m.config, t)) + 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 e = getTypeDescAux(m, t.elementType, check, kind) + m.s[cfsTypes].addf("typedef $1 $2[$3];$n", + [e, result, rope(n)]) + of tyObject, tyTuple: + let tt = origTyp.skipTypes({tyDistinct}) + if isImportedCppType(t) and tt.kind == tyGenericInst: + let cppNameAsRope = getTypeName(m, t, sig) + let cppName = $cppNameAsRope + var i = 0 + var chunkStart = 0 + + template addResultType(ty: untyped) = + if ty == nil or ty.kind == tyVoid: + result.add("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 = 0 + if scanCppGenericSlot(cppName, i, idx, stars): + result.add cppName.substr(chunkStart, chunkEnd) + chunkStart = i + + let typeInSlot = resolveStarsInCppType(tt, idx + 1, stars) + addResultType(typeInSlot) + else: + inc i + + if chunkStart != 0: + result.add cppName.substr(chunkStart) + else: + result = cppNameAsRope & "<" + for needsComma, a in tt.genericInstParams: + if needsComma: result.add(" COMMA ") + addResultType(a) + result.add("> ") + # always call for sideeffects: + assert t.kind != tyTuple + discard getRecordDesc(m, t, result, check) + # The resulting type will include commas and these won't play well + # with the C macros for defining procs such as N_NIMCALL. We must + # create a typedef for the type and use it in the proc signature: + let typedefName = "TY" & $sig + m.s[cfsTypes].addf("typedef $1 $2;$n", [result, typedefName]) + m.typeCache[sig] = typedefName + result = typedefName + else: + result = cacheGetType(m.forwTypeCache, sig) + if result == "": + result = getTypeName(m, origTyp, sig) + m.forwTypeCache[sig] = result + if not isImportedType(t): + 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): + m.s[cfsTypes].add(recdesc) + elif tfIncompleteStruct notin t.flags: + discard # addAbiCheck(m, t, result) # already handled elsewhere + of tySet: + # 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: 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, tyOwned, + tyUserTypeClass, tyUserTypeClassInst, tyInferred: + result = getTypeDescAux(m, skipModifier(t), check, kind) + else: + internalError(m.config, "getTypeDescAux(" & $t.kind & ')') + result = "" # fixes bug #145: excl(check, t.id) -proc getTypeDesc(m: BModule, typ: PType): PRope = + +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): PRope = +proc getClosureType(m: BModule; t: PType, kind: TClosureTypeKind): Rope = assert t.kind == tyProc var check = initIntSet() - result = getTempName() - var rettype, desc: PRope + result = getTempName(m) + var rettype, desc: Rope = "" genProcParams(m, t, rettype, desc, check, declareEnvironment=kind != clHalf) if not isImportedType(t): if t.callConv != ccClosure or kind != clFull: - appf(m.s[cfsTypes], "typedef $1_PTR($2, $3) $4;$n", - [toRope(CallingConvToStr[t.callConv]), rettype, result, desc]) + m.s[cfsTypes].addf("typedef $1_PTR($2, $3) $4;$n", + [rope(CallingConvToStr[t.callConv]), rettype, result, desc]) else: - appf(m.s[cfsTypes], "typedef struct {$n" & - "N_NIMCALL_PTR($2, ClPrc) $3;$n" & - "void* ClEnv;$n} $1;$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 getTypeDesc(m: BModule, magic: string): PRope = - var sym = magicsys.getCompilerProc(magic) - if sym != nil: - result = getTypeDesc(m, sym.typ) - else: - rawMessage(errSystemNeeds, magic) - result = nil - -proc finishTypeDescriptions(m: BModule) = +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 -template cgDeclFrmt*(s: PSym): string = s.constraint.strVal +proc isReloadable(m: BModule; prc: PSym): bool = + return m.hcrOn and sfNonReloadable notin prc.flags -proc genProcHeader(m: BModule, prc: PSym): PRope = - var - rettype, params: PRope - genCLineDir(result, prc.info) - # using static is needed for inline procs - if gCmd != cmdCompileToLLVM and lfExportLib in prc.loc.flags: - if m.isHeaderFile: - result.app "N_LIB_IMPORT " +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: - result.app "N_LIB_EXPORT " - elif prc.typ.callConv == ccInline: - result.app "static " + discard scanf(afterParams, "->$s$* ", retType) + + params = "(" & params & ")" + +proc genMemberProcHeader(m: BModule; prc: PSym; result: var Rope; asPtr: bool = false, isFwdDecl: bool = false) = + assert sfCppMember * prc.flags != {} + let isCtor = sfConstructor in prc.flags + var check = initIntSet() + fillBackendName(m, prc) + fillLoc(prc.loc, locProc, prc.ast[namePos], OnUnknown) + var memberOp = "#." #only virtual + var typ: PType + if isCtor: + typ = prc.typ.returnType + else: + typ = prc.typ.firstParamType + if typ.kind == tyPtr: + typ = typ.elementType + memberOp = "#->" + var typDesc = getTypeDescWeak(m, typ, check, dkParam) + let asPtrStr = rope(if asPtr: "_PTR" else: "") + var name, params, rettype, superCall: string = "" + var isFnConst, isOverride, isMemberVirtual, isStatic: bool = false + parseVFunctionDecl(prc.constraint.strVal, name, params, rettype, superCall, isFnConst, isOverride, isMemberVirtual, isStatic, isCtor) + genMemberProcParams(m, prc, superCall, rettype, name, params, check, true, false) + let isVirtual = sfVirtual in prc.flags or isMemberVirtual + var fnConst, override: string = "" + if isCtor: + name = typDesc + if isFnConst: + fnConst = " const" + if isFwdDecl: + if isStatic: + result.add "static " + if isVirtual: + rettype = "virtual " & rettype + if isOverride: + override = " override" + superCall = "" + else: + if not isCtor: + prc.loc.snippet = "$1$2(@)" % [memberOp, name] + elif superCall != "": + superCall = " : " & superCall + + name = "$1::$2" % [typDesc, name] + + result.add "N_LIB_PRIVATE " + result.addf("$1$2($3, $4)$5$6$7$8", + [rope(CallingConvToStr[prc.typ.callConv]), asPtrStr, rettype, name, + params, fnConst, override, superCall]) + +proc genProcHeader(m: BModule; prc: PSym; result: var Rope; asPtr: bool = false) = + # using static is needed for inline procs var check = initIntSet() - fillLoc(prc.loc, locProc, prc.typ, mangleName(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: - appf(result, "$1($2, $3)$4", - [toRope(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 = ropef(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): PRope -proc getNimNode(m: BModule): PRope = - result = ropef("$1[$2]", [m.typeNodesName, toRope(m.typeNodes)]) +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) -when false: - proc getNimType(m: BModule): PRope = - result = ropef("$1[$2]", [m.nimTypesName, toRope(m.nimTypes)]) - inc(m.nimTypes) - - proc allocMemTI(m: BModule, typ: PType, name: PRope) = - var tmp = getNimType(m) - appf(m.s[cfsTypeInit2], "$2 = &$1;$n", [tmp, name]) +proc tiNameForHcr(m: BModule; name: Rope): Rope = + return if m.hcrOn: "(*".rope & name & ")" else: name -proc isObjLackingTypeField(typ: PType): bool {.inline.} = - result = (typ.kind == tyObject) and ((tfFinal in typ.flags) and - (typ.sons[0] == nil) or isPureObject(typ)) - -proc genTypeInfoAuxBase(m: BModule, typ: PType, name, base: PRope) = +proc genTypeInfoAuxBase(m: BModule; typ, origType: PType; + name, base: Rope; info: TLineInfo) = var nimtypeKind: int #allocMemTI(m, typ, name) if isObjLackingTypeField(typ): nimtypeKind = ord(tyPureObject) else: nimtypeKind = ord(typ.kind) - - var size: PRope - if tfIncompleteStruct in typ.flags: size = toRope"void*" - else: size = getTypeDesc(m, typ) - appf(m.s[cfsTypeInit3], - "$1.size = sizeof($2);$n" & "$1.kind = $3;$n" & "$1.base = $4;$n", - [name, size, toRope(nimtypeKind), base]) + + let nameHcr = tiNameForHcr(m, name) + + var size: Rope + 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 flags != 0: - appf(m.s[cfsTypeInit3], "$1.flags = $2;$n", [name, toRope(flags)]) - discard cgsym(m, "TNimType") - appf(m.s[cfsVars], "TNimType $1; /* $2 */$n", - [name, toRope(typeToString(typ))]) - -proc genTypeInfoAux(m: BModule, typ: PType, name: PRope) = - var base: PRope - if (sonsLen(typ) > 0) and (typ.sons[0] != nil): - base = genTypeInfo(m, typ.sons[0]) - else: - base = toRope("0") - genTypeInfoAuxBase(m, typ, name, base) - -proc discriminatorTableName(m: BModule, objtype: PType, d: PSym): PRope = + if not canFormAcycle(m.g.graph, typ): flags = flags or 2 + #else echo("can contain a cycle: " & typeToString(typ)) + if flags != 0: + m.s[cfsTypeInit3].addf("$1.flags = $2;$n", [nameHcr, rope(flags)]) + 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 + 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 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 = genTypeInfoV1(m, x, info) + else: + base = rope("0") + genTypeInfoAuxBase(m, typ, origType, name, base, info) + +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] - if objType.sym == nil: - InternalError(d.info, "anonymous obj with discriminator") - result = ropef("NimDT_$1_$2", [ - toRope(objType.sym.name.s.mangle), toRope(d.name.s.mangle)]) - -proc discriminatorTableDecl(m: BModule, objtype: PType, d: PSym): PRope = - discard cgsym(m, "TNimNode") + 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, m.config)), rope(d.name.s.mangle)] + +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 = ropef("TNimNode* $1[$2];$n", [tmp, toRope(lengthOrd(d.typ)+1)]) + result = "TNimNode* $1[$2];$n" % [tmp, rope(lengthOrd(m.config, d.typ)+1)] + +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: PType, n: PNode, expr: PRope) = +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, n.sons[0], expr) - elif L > 0: - var tmp = getTempName() - appf(m.s[cfsTypeInit1], "static TNimNode* $1[$2];$n", [tmp, toRope(L)]) - for i in countup(0, L-1): + of nkRecList: + 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) - appf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", [tmp, toRope(i), tmp2]) - genObjectFields(m, typ, n.sons[i], tmp2) - appf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n", - [expr, toRope(L), tmp]) - else: - appf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2;$n", [expr, toRope(L)]) - of nkRecCase: - assert(n.sons[0].kind == nkSym) - var field = n.sons[0].sym + 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: + m.s[cfsTypeInit3].addf("$1.len = $2; $1.kind = 2;$n", [expr, rope(n.len)]) + of nkRecCase: + assert(n[0].kind == nkSym) + var field = n[0].sym var tmp = discriminatorTableName(m, typ, field) - var L = lengthOrd(field.typ) + var L = lengthOrd(m.config, field.typ) assert L > 0 - appf(m.s[cfsTypeInit3], "$1.kind = 3;$n" & + if field.loc.snippet == "": fillObjectFields(m, typ) + if field.loc.t == nil: + internalError(m.config, n.info, "genObjectFields") + m.s[cfsTypeInit3].addf("$1.kind = 3;$n" & "$1.offset = offsetof($2, $3);$n" & "$1.typ = $4;$n" & "$1.name = $5;$n" & "$1.sons = &$6[0];$n" & - "$1.len = $7;$n", [expr, getTypeDesc(m, typ), field.loc.r, - genTypeInfo(m, field.typ), - makeCString(field.name.s), - tmp, toRope(L)]) - appf(m.s[cfsData], "TNimNode* $1[$2];$n", [tmp, toRope(L+1)]) - for i in countup(1, sonsLen(n)-1): - var b = n.sons[i] # branch + "$1.len = $7;$n", [expr, getTypeDesc(m, origType, dkVar), field.loc.snippet, + genTypeInfoV1(m, field.typ, info), + makeCString(field.name.s), + tmp, rope(L)]) + 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, lastSon(b), tmp2) + genObjectFields(m, typ, origType, lastSon(b), tmp2, info) case b.kind - of nkOfBranch: - if sonsLen(b) < 2: - internalError(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])) - while x <= y: - appf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", [tmp, toRope(x), tmp2]) + of nkOfBranch: + if b.len < 2: + internalError(m.config, b.info, "genObjectFields; nkOfBranch broken") + 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: + m.s[cfsTypeInit3].addf("$1[$2] = &$3;$n", [tmp, rope(x), tmp2]) inc(x) - else: - appf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", - [tmp, toRope(getOrdValue(b.sons[j])), tmp2]) - of nkElse: - appf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", - [tmp, toRope(L), tmp2]) - else: internalError(n.info, "genObjectFields(nkRecCase)") - of nkSym: + else: + m.s[cfsTypeInit3].addf("$1[$2] = &$3;$n", + [tmp, rope(getOrdValue(b[j])), tmp2]) + of nkElse: + 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 - appf(m.s[cfsTypeInit3], "$1.kind = 1;$n" & - "$1.offset = offsetof($2, $3);$n" & "$1.typ = $4;$n" & - "$1.name = $5;$n", [expr, getTypeDesc(m, typ), - field.loc.r, genTypeInfo(m, field.typ), makeCString(field.name.s)]) - else: internalError(n.info, "genObjectFields") - -proc genObjectInfo(m: BModule, typ: PType, name: PRope) = - if typ.kind == tyObject: genTypeInfoAux(m, typ, name) - else: genTypeInfoAuxBase(m, typ, name, toRope("0")) + # Do not produce code for void types + if isEmptyType(field.typ): return + if field.bitsize == 0: + if field.loc.snippet == "": fillObjectFields(m, typ) + if field.loc.t == nil: + internalError(m.config, n.info, "genObjectFields") + m.s[cfsTypeInit3].addf("$1.kind = 1;$n" & + "$1.offset = offsetof($2, $3);$n" & "$1.typ = $4;$n" & + "$1.name = $5;$n", [expr, getTypeDesc(m, origType, 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) = + 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) - genObjectFields(m, typ, typ.n, tmp) - appf(m.s[cfsTypeInit3], "$1.node = &$2;$n", [name, tmp]) + if (not isImportedType(typ)) or tfCompleteStruct in typ.flags: + genObjectFields(m, typ, origType, typ.n, tmp, info) + m.s[cfsTypeInit3].addf("$1.node = &$2;$n", [tiNameForHcr(m, name), tmp]) + var t = typ.baseClass + while t != nil: + t = t.skipTypes(skipPtrs) + t.flags.incl tfObjHasKids + t = t.baseClass -proc genTupleInfo(m: BModule, typ: PType, name: PRope) = - genTypeInfoAuxBase(m, typ, name, toRope("0")) +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() - appf(m.s[cfsTypeInit1], "static TNimNode* $1[$2];$n", [tmp, toRope(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) - appf(m.s[cfsTypeInit3], "$1[$2] = &$3;$n", [tmp, toRope(i), tmp2]) - appf(m.s[cfsTypeInit3], "$1.kind = 1;$n" & - "$1.offset = offsetof($2, Field$3);$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, typ), toRope(i), genTypeInfo(m, a)]) - appf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n", - [expr, toRope(length), tmp]) - else: - appf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 2;$n", - [expr, toRope(length)]) - appf(m.s[cfsTypeInit3], "$1.node = &$2;$n", [name, expr]) - -proc genEnumInfo(m: BModule, typ: PType, name: PRope) = + "$1.name = \"Field$3\";$n", + [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: + 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) = # 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, name) - var nodePtrs = getTempName() - var length = sonsLen(typ.n) - appf(m.s[cfsTypeInit1], "static TNimNode* $1[$2];$n", - [nodePtrs, toRope(length)]) - var enumNames, specialCases: PRope + genTypeInfoAux(m, typ, typ, name, info) + var nodePtrs = getTempName(m) & "_" & $typ.n.len + genTNimNodeArray(m, nodePtrs, rope(typ.n.len)) + var enumNames, specialCases: Rope = "" var 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: - app(enumNames, makeCString(field.name.s)) + enumNames.add(makeCString(field.name.s)) else: - app(enumNames, makeCString(field.ast.strVal)) - if i < length - 1: app(enumNames, ", " & tnl) + enumNames.add(makeCString(field.ast.strVal)) + if i < typ.n.len - 1: enumNames.add(", \L") if field.position != i or tfEnumHasHoles in typ.flags: - appf(specialCases, "$1.offset = $2;$n", [elemNode, toRope(field.position)]) + specialCases.addf("$1.offset = $2;$n", [elemNode, rope(field.position)]) hasHoles = true - var enumArray = getTempName() - var counter = getTempName() - appf(m.s[cfsTypeInit1], "NI $1;$n", [counter]) - appf(m.s[cfsTypeInit1], "static char* NIM_CONST $1[$2] = {$n$3};$n", - [enumArray, toRope(length), enumNames]) - appf(m.s[cfsTypeInit3], "for ($1 = 0; $1 < $2; $1++) {$n" & + var enumArray = getTempName(m) + var counter = getTempName(m) + 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, - toRope(length), m.typeNodesName, toRope(firstNimNode), enumArray, nodePtrs]) - app(m.s[cfsTypeInit3], specialCases) - appf(m.s[cfsTypeInit3], - "$1.len = $2; $1.kind = 2; $1.sons = &$3[0];$n$4.node = &$1;$n", - [getNimNode(m), toRope(length), nodePtrs, name]) + "$3[$1+$4].name = $5[$1];$n" & "$6[$1] = &$3[$1+$4];$n" & "}$n", [counter, + 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(typ.n.len), nodePtrs, tiNameForHcr(m, name)]) if hasHoles: # 1 << 2 is {ntfEnumHole} - appf(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: PRope) = - assert(typ.sons[0] != nil) - genTypeInfoAux(m, typ, name) +proc genSetInfo(m: BModule; typ: PType, name: Rope; info: TLineInfo) = + assert(typ.elementType != nil) + genTypeInfoAux(m, typ, typ, name, info) var tmp = getNimNode(m) - appf(m.s[cfsTypeInit3], "$1.len = $2; $1.kind = 0;$n" & "$3.node = &$1;$n", - [tmp, toRope(firstOrd(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: PRope) = - genTypeInfoAuxBase(m, typ, name, genTypeInfo(m, typ.sons[1])) +proc genArrayInfo(m: BModule; typ: PType, name: Rope; info: TLineInfo) = + genTypeInfoAuxBase(m, typ, typ, name, genTypeInfoV1(m, typ.elementType, info), info) -proc fakeClosureType(owner: PSym): PType = +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) - r.rawAddSon(newType(tyTuple, owner)) + result = newType(tyTuple, m.idgen, owner) + result.rawAddSon(newType(tyPointer, m.idgen, owner)) + var r = newType(tyRef, m.idgen, owner) + let obj = createObj(m.g.graph, m.idgen, owner, owner.info, final=false) + r.rawAddSon(obj) result.rawAddSon(r) -type - TTypeInfoReason = enum ## for what do we need the type info? - tiNew, ## for 'new' - tiNewSeq, ## for 'newSeq' - tiNonVariantAsgn, ## for generic assignment without variants - tiVariantAsgn ## for generic assignment with variants - include ccgtrav -proc genTypeInfo(m: BModule, t: PType): PRope = - var t = getUniqueType(t) - result = ropef("NTI$1", [toRope(t.id)]) - if ContainsOrIncl(m.typeInfoMarker, t.id): - return con("(&".toRope, result, ")".toRope) - let owner = t.skipTypes(typedescPtrs).owner.getModule - if owner != m.module: +proc genDeepCopyProc(m: BModule; s: PSym; result: Rope) = + genProc(m, s) + m.s[cfsTypeInit3].addf("$1.deepcopy =(void* (N_RAW_NIMCALL*)(void*))$2;$n", + [result, s.loc.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) + + 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 prefixTI = if m.hcrOn: "(" else: "(&" + + let sig = hashType(origType, m.config) + result = m.typeInfoMarker.getOrDefault(sig) + 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] = marker.str + return prefixTI.rope & marker.str & ")".rope + + result = "NTI$1$2_" % [rope(typeToC(t)), rope($sig)] + m.typeInfoMarker[sig] = result + + 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(owner.bmod, t) + discard genTypeInfoV1(m.g.modules[owner], origType, info) # reference the type info as extern here - discard cgsym(m, "TNimType") - discard cgsym(m, "TNimNode") - appf(m.s[cfsVars], "extern TNimType $1; /* $2 */$n", - [result, toRope(typeToString(t))]) - return con("(&".toRope, result, ")".toRope) + 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) + case t.kind - of tyEmpty: result = toRope"0" - of tyPointer, tyBool, tyChar, tyCString, tyString, tyInt..tyUInt64, tyVar: - genTypeInfoAuxBase(m, t, result, toRope"0") + of tyEmpty, tyVoid: result = rope"0" + of tyPointer, tyBool, tyChar, tyCstring, tyString, tyInt..tyUInt64, tyVar, tyLent: + genTypeInfoAuxBase(m, t, t, result, rope"0", info) + of tyStatic: + if t.n != nil: result = genTypeInfoV1(m, skipModifier t, info) + else: internalError(m.config, "genTypeInfoV1(" & $t.kind & ')') + of tyUserTypeClasses: + internalAssert m.config, t.isResolvedUserTypeClass + return genTypeInfoV1(m, t.skipModifier, info) of tyProc: if t.callConv != ccClosure: - genTypeInfoAuxBase(m, t, result, toRope"0") - else: - genTupleInfo(m, fakeClosureType(t.owner), result) - of tySequence, tyRef: - genTypeInfoAux(m, t, result) - if gSelectedGC >= gcMarkAndSweep: - let markerProc = genTraverseProc(m, t, tiNew) - appf(m.s[cfsTypeInit3], "$1.marker = $2;$n", [result, markerProc]) - of tyPtr, tyRange: genTypeInfoAux(m, t, result) - of tyArrayConstr, tyArray: genArrayInfo(m, t, result) - of tySet: genSetInfo(m, t, result) - of tyEnum: genEnumInfo(m, t, result) - of tyObject: genObjectInfo(m, t, result) - of tyTuple: + genTypeInfoAuxBase(m, t, t, result, rope"0", info) + else: + let x = fakeClosureType(m, t.owner) + genTupleInfo(m, x, x, result, info) + of tySequence: + 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 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 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, result) - else: InternalError("genTypeInfo(" & $t.kind & ')') - result = con("(&".toRope, result, ")".toRope) + genTupleInfo(m, t, origType, result, info) + 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) = - nil +proc genTypeSection(m: BModule, n: PNode) = + 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 c37754511..c0e574186 100644 --- a/compiler/ccgutils.nim +++ b/compiler/ccgutils.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -9,173 +9,162 @@ # This module declares some helpers for the C code generator. -import - ast, astalgo, ropes, lists, hashes, strutils, types, msgs, wordrecg, - platform, trees +import + 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: + of nkStmtList: + 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: nil + else: + result = nil proc stmtsContainPragma*(n: PNode, w: TSpecialWord): bool = result = getPragmaStmt(n, w) != nil -proc hashString*(s: string): biggestInt = - # has to be the same algorithm as system.hashString! - if CPU[targetCPU].bit == 64: +proc hashString*(conf: ConfigRef; s: string): BiggestInt = + # 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 - 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 - gTypeTable: array[TTypeKind, TIdTable] - gCanonicalTypes: array[TTypeKind, PType] - -proc initTypeTables() = - for i in countup(low(TTypeKind), high(TTypeKind)): InitIdTable(gTypeTable[i]) - -proc resetCaches* = - ## XXX: fix that more properly - initTypeTables() - for i in low(gCanonicalTypes)..high(gCanonicalTypes): - gCanonicalTypes[i] = nil - -when false: - proc echoStats*() = - for i in countup(low(TTypeKind), high(TTypeKind)): - echo i, " ", gTypeTable[i].counter - -proc GetUniqueType*(key: PType): PType = - # this is a hotspot in the compiler! - if key == nil: return - var k = key.kind - case k - of tyBool, tyChar, - tyInt..tyUInt64: - # no canonicalization for integral types, so that e.g. ``pid_t`` is - # produced instead of ``NI``. - result = key - of tyEmpty, tyNil, tyExpr, tyStmt, tyPointer, tyString, - tyCString, tyNone, tyBigNum: - result = gCanonicalTypes[k] - if result == nil: - gCanonicalTypes[k] = key - result = key - of tyTypeDesc, tyTypeClass: - InternalError("value expected, but got a type") - of tyGenericParam: - InternalError("GetUniqueType") - of tyGenericInst, tyDistinct, tyOrdinal, tyMutable, tyConst, tyIter: - result = GetUniqueType(lastSon(key)) - of tyArrayConstr, tyGenericInvokation, tyGenericBody, - tyOpenArray, tyArray, tySet, tyRange, tyTuple, - tyPtr, tyRef, tySequence, tyForward, tyVarargs, tyProxy, tyVar: - # tuples are quite horrible as C does not support them directly and - # tuple[string, string] is a (strange) subtype of - # tuple[nameA, nameB: string]. This bites us here, so we - # use 'sameBackendType' instead of 'sameType'. - - # we have to do a slow linear search because types may need - # to be compared by their structure: - if IdTableHasObjectAsKey(gTypeTable[k], key): return key - for h in countup(0, high(gTypeTable[k].data)): - var t = PType(gTypeTable[k].data[h].key) - if t != nil and sameBackendType(t, key): - return t - IdTablePut(gTypeTable[k], key, key) - result = key - of tyObject: - if tfFromGeneric notin key.flags: - # fast case; lookup per id suffices: - result = PType(IdTableGet(gTypeTable[k], key)) - if result == nil: - IdTablePut(gTypeTable[k], key, key) - result = key - else: - # ugly slow case: need to compare by structure - if IdTableHasObjectAsKey(gTypeTable[k], key): return key - for h in countup(0, high(gTypeTable[k].data)): - var t = PType(gTypeTable[k].data[h].key) - if t != nil and sameType(t, key): - return t - IdTablePut(gTypeTable[k], key, key) - result = key - of tyEnum: - result = PType(IdTableGet(gTypeTable[k], key)) - if result == nil: - IdTablePut(gTypeTable[k], key, key) - result = key - of tyProc: - # tyVar is not 100% correct, but would speeds things up a little: - if key.callConv != ccClosure: - result = key - else: - # ugh, we need the canon here: - if IdTableHasObjectAsKey(gTypeTable[k], key): return key - for h in countup(0, high(gTypeTable[k].data)): - var t = PType(gTypeTable[k].data[h].key) - if t != nil and sameBackendType(t, key): - return t - IdTablePut(gTypeTable[k], key, key) - result = key - -proc TableGetType*(tab: TIdTable, key: PType): PObject = - # returns nil if we need to declare this type - result = IdTableGet(tab, key) - if (result == nil) and (tab.counter > 0): - # we have to do a slow linear search because types may need - # to be compared by their structure: - for h in countup(0, high(tab.data)): - var t = PType(tab.data[h].key) - if t != nil: - if sameType(t, key): - return tab.data[h].val + 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'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 proc makeSingleLineCString*(s: string): string = result = "\"" for c in items(s): - result.add(c.toCChar) + c.toCChar(result) result.add('\"') -proc makeLLVMString*(s: string): PRope = - const MaxLineLength = 64 - result = nil - var res = "c\"" - for i in countup(0, len(s) - 1): - if (i + 1) mod MaxLineLength == 0: - app(result, toRope(res)) - setlen(res, 0) - case s[i] - of '\0'..'\x1F', '\x80'..'\xFF', '\"', '\\': - add(res, '\\') - add(res, toHex(ord(s[i]), 2)) - else: add(res, s[i]) - add(res, "\\00\"") - app(result, toRope(res)) - -InitTypeTables() +proc mapSetType(conf: ConfigRef; typ: PType): TCTypeKind = + case int(getSize(conf, typ)) + of 1: result = ctInt8 + of 2: result = ctInt16 + of 4: result = ctInt32 + of 8: result = ctInt64 + else: result = ctArray + +proc ccgIntroducedPtr*(conf: ConfigRef; s: PSym, retType: PType): bool = + var pt = skipTypes(s.typ, typedescInst) + assert skResult != s.kind + + #note precedence: params override types + if optByRef in s.options: return true + elif sfByCopy in s.flags: return false + elif tfByRef in pt.flags: return true + elif tfByCopy in pt.flags: return false + case pt.kind + of tyObject: + if s.typ.sym != nil and sfForward in s.typ.sym.flags: + # forwarded objects are *always* passed by pointers for consistency! + result = true + elif s.typ.kind == tySink and conf.selectedGC notin {gcArc, gcAtomicArc, gcOrc, gcHooks}: + # bug #23354: + result = false + elif (optByRef in s.options) or (getSize(conf, pt) > conf.target.floatSize * 3): + result = true # requested anyway + elif (tfFinal in pt.flags) and (pt[0] == nil): + result = false # no need, because no subtyping possible + else: + result = 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 18f33f32a..091f5c842 100644 --- a/compiler/cgen.nim +++ b/compiler/cgen.nim @@ -1,7 +1,7 @@ # # -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -9,1237 +9,2206 @@ ## This module implements the C code generator. -import - ast, astalgo, strutils, hashes, trees, platform, magicsys, extccomp, - options, intsets, - nversion, nimsets, msgs, crc, bitsets, idents, lists, types, ccgutils, os, - times, ropes, math, passes, rodread, wordrecg, treetab, cgmeth, - rodutils, renderer, idgen, cgendata, ccgmerge, semfold, aliases +import + 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 + +from expanddefaults import caseObjDefaultBranch + +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]) = + ## given a library name pattern `s` write possible library names to `dest`. + var le = strutils.find(s, '(') + var ri = strutils.find(s, ')', le+1) + if le >= 0 and ri > le: + var prefix = substr(s, 0, le - 1) + var suffix = substr(s, ri + 1) + for middle in split(substr(s, le + 1, ri - 1), '|'): + libCandidates(prefix & middle & suffix, dest) + else: + dest.add(s) when options.hasTinyCBackend: import tccgen -# implementation - -var - generatedHeader: BModule - -proc ropeff(cformat, llvmformat: string, args: varargs[PRope]): PRope = - if gCmd == cmdCompileToLLVM: result = ropef(llvmformat, args) - else: result = ropef(cformat, args) - -proc appff(dest: var PRope, cformat, llvmformat: string, - args: varargs[PRope]) = - if gCmd == cmdCompileToLLVM: appf(dest, llvmformat, args) - else: appf(dest, cformat, args) - -proc addForwardedProc(m: BModule, prc: PSym) = - m.forwardedProcs.add(prc) - inc(gForwardedProcsCounter) - -proc getCgenModule(s: PSym): BModule = - result = if s.position >= 0 and s.position < gModules.len: gModules[s.position] - else: nil - -proc findPendingModule(m: BModule, s: PSym): BModule = - var ms = getModule(s) - result = gModules[ms.position] - -proc emitLazily(s: PSym): bool {.inline.} = - result = optDeadCodeElim in gGlobalOptions or - sfDeadCodeElim in getModule(s).flags - -proc initLoc(result: var TLoc, k: TLocKind, typ: PType, s: TStorageLoc) = - result.k = k - result.s = s - result.t = GetUniqueType(typ) - result.r = nil - result.a = - 1 - result.flags = {} - -proc fillLoc(a: var TLoc, k: TLocKind, typ: PType, r: PRope, s: TStorageLoc) = +proc hcrOn(m: BModule): bool = m.config.hcrOn +proc hcrOn(p: BProc): bool = p.module.config.hcrOn + +proc addForwardedProc(m: BModule, prc: PSym) = + m.g.forwardedProcs.add(prc) + +proc findPendingModule(m: BModule, s: PSym): BModule = + # 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 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: + if a.k == locNone: a.k = k - a.t = getUniqueType(typ) - a.a = - 1 - a.s = s - if a.r == nil: a.r = r - + a.lode = lode + a.storage = s + if a.snippet == "": a.snippet = r + +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 + +proc t(a: TLoc): PType {.inline.} = + if a.lode.kind == nkSym: + result = a.lode.sym.typ + else: + result = a.lode.typ + +proc lodeTyp(t: PType): PNode = + result = newNode(nkEmpty) + result.typ = t + proc isSimpleConst(typ: PType): bool = let t = skipTypes(typ, abstractVar) result = t.kind notin - {tyTuple, tyObject, tyArray, tyArrayConstr, tySet, tySequence} and not + {tyTuple, tyObject, tyArray, tySet, tySequence} and not (t.kind == tyProc and t.callConv == ccClosure) -proc useHeader(m: BModule, sym: PSym) = - if lfHeader in sym.loc.Flags: +proc useHeader(m: BModule, sym: PSym) = + if lfHeader in sym.loc.flags: assert(sym.annex != nil) - discard lists.IncludeStr(m.headerFiles, getStr(sym.annex.path)) + let str = getStr(sym.annex.path) + m.includeHeader(str) + +proc cgsym(m: BModule, name: string) +proc cgsymValue(m: BModule, name: string): Rope + +proc getCFile(m: BModule): AbsoluteFile -proc cgsym(m: BModule, name: string): PRope +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 ropecg(m: BModule, frmt: TFormatStr, args: varargs[PRope]): PRope = +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 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: - if frmt[i] == '$': + 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 '$': - app(result, "$") + of '$': + strLit.add '$' + inc(i) + of '#': + flushStrLit() inc(i) - of '#': + result.add newCall(formatValue, resVar, args[num]) + inc(num) + of '^': + flushStrLit() inc(i) - app(result, args[num]) + result.add newCall(formatValue, resVar, args[^1]) inc(num) - of '0'..'9': + of '0'..'9': var j = 0 - while true: - j = (j * 10) + Ord(frmt[i]) - ord('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("ropes: invalid format string $" & $j) - app(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 gOptions: app(result, rnl) + flushStrLit() + result.add quote do: + if optLineDir notin `m`.config.options: + `resVar`.add("\L") inc(i) - of 'N': - app(result, rnl) + of 'N': + strLit.add "\L" inc(i) - else: InternalError("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 - app(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') + while frmt[i] in Digits: + j = (j * 10) + ord(frmt[i]) - ord('0') inc(i) - app(result, cgsym(m, args[j-1].ropeToStr)) - var start = i - while i < length: - if frmt[i] != '$' and frmt[i] != '#': inc(i) - else: break - if i - 1 >= start: - app(result, substr(frmt, start, i - 1)) - -const compileTimeRopeFmt = not defined(booting) - -when compileTimeRopeFmt: - import macros - - type TFmtFragmentKind = enum - ffSym, - ffLit, - ffParam - - type TFragment = object - case kind: TFmtFragmentKind - of ffSym, ffLit: - value: string - of ffParam: - intValue: int - - iterator fmtStringFragments(s: string): tuple[kind: TFmtFragmentKind, - value: string, - intValue: int] = - # This is a bit less featured version of the ropecg's algorithm - # (be careful when replacing ropecg calls) - var - i = 0 - length = s.len + 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) - while i < length: - var start = i - case s[i] - of '$': - let n = s[i+1] - case n - of '$': - inc i, 2 - of '0'..'9': - # XXX: use the new case object construction syntax when it's ready - yield (kind: ffParam, value: "", intValue: n.ord - ord('1')) - inc i, 2 - start = i - else: - inc i - of '#': - inc i - var j = i - while s[i] in IdentChars: inc i - yield (kind: ffSym, value: substr(s, j, i-1), intValue: 0) - start = i - else: nil - - while i < length: - if s[i] != '$' and s[i] != '#': inc i - else: break - - if i - 1 >= start: - yield (kind: ffLit, value: substr(s, start, i-1), intValue: 0) - - macro rfmt(m: BModule, fmt: expr[string], args: varargs[PRope]): expr = - ## Experimental optimized rope-formatting operator - ## The run-time code it produces will be very fast, but will it speed up - ## the compilation of nimrod itself or will the macro execution time - ## offset the gains? - result = newCall(bindSym"ropeConcat") - for frag in fmtStringFragments(fmt.strVal): - case frag.kind - of ffSym: - result.add(newCall(bindSym"cgsym", m, newStrLitNode(frag.value))) - of ffLit: - result.add(newCall(bindSym"~", newStrLitNode(frag.value))) - of ffParam: - result.add(args[frag.intValue]) -else: - template rfmt(m: BModule, fmt: expr[string], args: varargs[PRope]): expr = - ropecg(m, fmt, args) - -proc appcg(m: BModule, c: var PRope, frmt: TFormatStr, - args: varargs[PRope]) = - app(c, ropecg(m, frmt, args)) - -proc appcg(m: BModule, s: TCFileSection, frmt: TFormatStr, - args: varargs[PRope]) = - app(m.s[s], ropecg(m, frmt, args)) - -proc appcg(p: BProc, s: TCProcSection, frmt: TFormatStr, - args: varargs[PRope]) = - app(p.s(s), ropecg(p.module, frmt, args)) - -var indent = "\t".toRope -proc indentLine(p: BProc, r: PRope): PRope = - result = r - for i in countup(0, p.blocks.len-1): prepend(result, indent) - -proc line(p: BProc, s: TCProcSection, r: PRope) = - app(p.s(s), indentLine(p, r)) - -proc line(p: BProc, s: TCProcSection, r: string) = - app(p.s(s), indentLine(p, r.toRope)) - -proc lineF(p: BProc, s: TCProcSection, frmt: TFormatStr, - args: varargs[PRope]) = - app(p.s(s), indentLine(p, ropef(frmt, args))) - -proc lineCg(p: BProc, s: TCProcSection, frmt: TFormatStr, - args: varargs[PRope]) = - app(p.s(s), indentLine(p, ropecg(p.module, frmt, args))) - -when compileTimeRopeFmt: - template linefmt(p: BProc, s: TCProcSection, frmt: TFormatStr, - args: varargs[PRope]) = - line(p, s, rfmt(p.module, frmt, args)) -else: - proc linefmt(p: BProc, s: TCProcSection, frmt: TFormatStr, - args: varargs[PRope]) = - app(p.s(s), indentLine(p, ropecg(p.module, frmt, args))) - -proc appLineCg(p: BProc, r: var PRope, frmt: TFormatStr, - args: varargs[PRope]) = - app(r, indentLine(p, ropecg(p.module, frmt, args))) - -proc lineFF(p: BProc, s: TCProcSection, cformat, llvmformat: string, - args: varargs[PRope]) = - if gCmd == cmdCompileToLLVM: lineF(p, s, llvmformat, args) - else: lineF(p, s, cformat, args) + flushStrLit() + result.add newCall(ident"rope", resVar) + +proc addIndent(p: BProc; result: var Rope) = + var i = result.len + let newLen = i + p.blocks.len + result.setLen newLen + while i < newLen: + result[i] = '\t' + inc i + +template appcg(m: BModule, c: var Rope, frmt: FormatStr, + args: untyped) = + c.add(ropecg(m, frmt, args)) + +template appcg(m: BModule, sec: TCFileSection, frmt: FormatStr, + args: untyped) = + m.s[sec].add(ropecg(m, frmt, args)) + +template appcg(p: BProc, sec: TCProcSection, frmt: FormatStr, + args: untyped) = + p.s(sec).add(ropecg(p.module, frmt, args)) + +template line(p: BProc, sec: TCProcSection, r: string) = + addIndent p, p.s(sec) + p.s(sec).add(r) + +template lineF(p: BProc, sec: TCProcSection, frmt: FormatStr, + args: untyped) = + addIndent p, p.s(sec) + p.s(sec).add(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)) + +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 PRope, filename: string, line: int) = +proc genPostprocessDir(field1, field2, field3: string): string = + result = postprocessDirStart & field1 & postprocessDirSep & field2 & postprocessDirSep & field3 & postprocessDirEnd + +proc genCLineDir(r: var Rope, fileIdx: FileIndex, line: int; conf: ConfigRef) = + assert line >= 0 + if optLineDir in conf.options and line > 0: + 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 gOptions: - appff(r, "$N#line $2 $1$N", "; line $2 \"$1\"$n", - [toRope(makeSingleLineCString(filename)), toRope(line)]) + 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) = + 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 + p.lastLineInfo.fileIndex != info.fileIndex: + p.lastLineInfo.line = info.line + p.lastLineInfo.fileIndex = info.fileIndex + result = true + else: + result = false -proc genCLineDir(r: var PRope, info: TLineInfo) = - genCLineDir(r, info.toFullPath, info.safeLineNm) +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) = - var line = t.info.safeLineNm - if optEmbedOrigSrc in gGlobalOptions: - app(p.s(cpsStmts), con(~"//", t.info.sourceLine, rnl)) - genCLineDir(p.s(cpsStmts), t.info.toFullPath, line) - if ({optStackTrace, optEndb} * p.Options == {optStackTrace, optEndb}) and - (p.prc == nil or sfPure notin p.prc.flags): - linefmt(p, cpsStmts, "#endb($1, $2);$n", - line.toRope, makeCString(toFilename(t.info))) - elif ({optLineTrace, optStackTrace} * p.Options == - {optLineTrace, optStackTrace}) and - (p.prc == nil or sfPure notin p.prc.flags): - linefmt(p, cpsStmts, "nimln($1, $2);$n", - line.toRope, t.info.quotedFilename) - -include "ccgtypes.nim" + if p == p.module.preInitProc: return + let line = t.info.safeLineNm + + if optEmbedOrigSrc in p.config.globalOptions: + p.s(cpsStmts).add("//" & sourceLine(p.config, t.info) & "\L") + 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) -# ------------------------------ Manager of temporaries ------------------ +template compileToCpp(m: BModule): untyped = + m.config.backend == backendCpp or sfCompileToCpp in m.module.flags -proc rdLoc(a: TLoc): PRope = +proc getTempName(m: BModule): Rope = + result = m.tmpBase & rope(m.labels) + inc m.labels + +proc rdLoc(a: TLoc): Rope = # 'read' location (deref if indirect) - result = a.r - if lfIndirect in a.flags: result = ropef("(*$1)", [result]) + 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 addrLoc(a: TLoc): PRope = - result = a.r - if lfIndirect notin a.flags and mapType(a.t) != ctArray: - result = con("&", result) +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 ------------------ + +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 = + 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): PRope = +proc rdCharLoc(a: TLoc): Rope = # read a location that may need a char-cast: result = rdLoc(a) if skipTypes(a.t, abstractRange).kind == tyChar: - result = ropef("((NU8)($1))", [result]) + result = "((NU8)($1))" % [result] + +type + TAssignmentFlag = enum + needToCopy + needToCopySinkParam + needTempForOpenArray + needAssignCall + TAssignmentFlags = set[TAssignmentFlag] -proc genObjectInit(p: BProc, section: TCProcSection, t: PType, a: TLoc, - takeAddr: bool) = +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: - nil + discard of frHeader: var r = rdLoc(a) - if not takeAddr: r = ropef("(*$1)", [r]) + if mode == constructRefObj: r = "(*$1)" % [r] var s = skipTypes(t, abstractInst) - if gCmd != cmdCompileToCpp: - while (s.kind == tyObject) and (s.sons[0] != nil): - app(r, ".Sup") - s = skipTypes(s.sons[0], abstractInst) - linefmt(p, section, "$1.m_type = $2;$n", r, genTypeInfo(p.module, t)) + if not p.module.compileToCpp: + 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(a) else: rdLoc(a) - linefmt(p, section, "#objectInit($1, $2);$n", r, genTypeInfo(p.module, t)) + 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, needForSubtypeCheck, afDestIsNil, afDestIsNotNil, afSrcIsNil, - afSrcIsNotNil, needToKeepAlive - 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.} = - result = t.kind in {tyArray, tyArrayConstr, 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) - if not isComplexValueType(skipTypes(loc.t, abstractVarRange)): + let containsGcRef = optSeqDestructors notin p.config.globalOptions and containsGarbageCollectedRef(loc.t) + let typ = skipTypes(loc.t, abstractVarRange) + 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.t, onStack) - nilLoc.r = toRope("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(loc)) - if loc.s != OnStack: - linefmt(p, cpsStmts, "#genericReset((void*)$1, $2);$n", - addrLoc(loc), genTypeInfo(p.module, loc.t)) + 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: - linefmt(p, cpsStmts, "memset((void*)$1, 0, sizeof($2));$n", - addrLoc(loc), rdLoc(loc)) - # XXX: We can be extra clever here and call memset only + # array passed as argument decayed into pointer, bug #7332 + # so we use getTypeDesc here rather than rdLoc(loc) + let tyDesc = getTypeDesc(p.module, loc.t, descKindFromSymKind mapTypeChooser(loc)) + if p.module.compileToCpp and isOrHasImportedCppType(typ): + if lfIndirect in loc.flags: + #C++ cant be just zeroed. We need to call the ctors + var tmp = getTemp(p, loc.t) + linefmt(p, cpsStmts,"#nimCopyMem((void*)$1, (NIM_CONST void*)$2, sizeof($3));$n", + [addrLoc(p.config, loc), addrLoc(p.config, tmp), tyDesc]) + else: + linefmt(p, cpsStmts, "#nimZeroMem((void*)$1, sizeof($2));$n", + [addrLoc(p.config, loc), tyDesc]) + + # XXX: We can be extra clever here and call memset only # on the bytes following the m_type field? - genObjectInit(p, cpsStmts, loc.t, loc, true) - -proc constructLoc(p: BProc, loc: TLoc, section = cpsStmts) = - if not isComplexValueType(skipTypes(loc.t, abstractRange)): - linefmt(p, section, "$1 = 0;$n", rdLoc(loc)) + genObjectInit(p, cpsStmts, loc.t, loc, constructObj) + +proc constructLoc(p: BProc, loc: var TLoc, isTemp = false) = + let typ = loc.t + 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: - linefmt(p, section, "memset((void*)$1, 0, sizeof($2));$n", - addrLoc(loc), rdLoc(loc)) - genObjectInit(p, section, loc.t, loc, true) + if (not isTemp or containsGarbageCollectedRef(loc.t)) and not hasNoInit(loc.t): + # don't use nimZeroMem for temporary values for performance if we can + # avoid it: + if not isOrHasImportedCppType(typ): + 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: # we know it is a local variable and thus on the stack! # If ``not immediateAsgn`` it is not initialized in a binding like - # ``var v = X`` and thus we need to init it. + # ``var v = X`` and thus we need to init it. # If ``v`` contains a GC-ref we may pass it to ``unsureAsgnRef`` somehow # which requires initialization. However this can really only happen if - # ``var v = X()`` gets transformed into ``X(&v)``. + # ``var v = X()`` gets transformed into ``X(&v)``. # Nowadays the logic in ccgcalls deals with this case however. if not immediateAsgn: constructLoc(p, v.loc) -proc initTemp(p: BProc, tmp: var TLoc) = - # XXX: This is still suspicious. - # Objects should always be constructed? - if containsGarbageCollectedRef(tmp.t) or isInvalidReturnType(tmp.t): - constructLoc(p, tmp) - -proc getTemp(p: BProc, t: PType, result: var TLoc) = +proc getTemp(p: BProc, t: PType, needsInit=false): TLoc = inc(p.labels) - if gCmd == cmdCompileToLLVM: - result.r = con("%LOC", toRope(p.labels)) - else: - result.r = con("LOC", toRope(p.labels)) - linefmt(p, cpsLocals, "$1 $2;$n", getTypeDesc(p.module, t), result.r) - result.k = locTemp - result.a = - 1 - result.t = getUniqueType(t) - result.s = OnStack - result.flags = {} - initTemp(p, result) - -proc keepAlive(p: BProc, toKeepAlive: TLoc) = + 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: - # deactivated because of the huge slowdown this causes; GC will take care - # of interior pointers instead - if optRefcGC notin gGlobalOptions: return - var result: TLoc - var fid = toRope(p.gcFrameId) - result.r = con("GCFRAME.F", fid) - appf(p.gcFrameType, " $1 F$2;$n", - [getTypeDesc(p.module, toKeepAlive.t), fid]) - inc(p.gcFrameId) - result.k = locTemp - result.a = -1 - result.t = toKeepAlive.t - result.s = OnStack - result.flags = {} - - if not isComplexValueType(skipTypes(toKeepAlive.t, abstractVarRange)): - linefmt(p, cpsStmts, "$1 = $2;$n", rdLoc(result), rdLoc(toKeepAlive)) - else: - linefmt(p, cpsStmts, - "memcpy((void*)$1, (NIM_CONST void*)$2, sizeof($3));$n", - addrLoc(result), addrLoc(toKeepAlive), rdLoc(result)) - -proc initGCFrame(p: BProc): PRope = - if p.gcFrameId > 0: result = ropef("struct {$1} GCFRAME;$n", p.gcFrameType) - -proc deinitGCFrame(p: BProc): PRope = - if p.gcFrameId > 0: - result = ropecg(p.module, - "if (((NU)&GCFRAME) < 4096) #nimGCFrame(&GCFRAME);$n") - -proc cstringLit(p: BProc, r: var PRope, s: string): PRope = - if gCmd == cmdCompileToLLVM: - inc(p.module.labels) - inc(p.labels) - result = ropef("%LOC$1", [toRope(p.labels)]) - appf(p.module.s[cfsData], "@C$1 = private constant [$2 x i8] $3$n", - [toRope(p.module.labels), toRope(len(s)), makeLLVMString(s)]) - appf(r, "$1 = getelementptr [$2 x i8]* @C$3, %NI 0, %NI 0$n", - [result, toRope(len(s)), toRope(p.module.labels)]) - else: - result = makeCString(s) - -proc cstringLit(m: BModule, r: var PRope, s: string): PRope = - if gCmd == cmdCompileToLLVM: - inc(m.labels, 2) - result = ropef("%MOC$1", [toRope(m.labels - 1)]) - appf(m.s[cfsData], "@MOC$1 = private constant [$2 x i8] $3$n", - [toRope(m.labels), toRope(len(s)), makeLLVMString(s)]) - appf(r, "$1 = getelementptr [$2 x i8]* @MOC$3, %NI 0, %NI 0$n", - [result, toRope(len(s)), toRope(m.labels)]) - else: - result = makeCString(s) - -proc allocParam(p: BProc, s: PSym) = - assert(s.kind == skParam) - if lfParamCopy notin s.loc.flags: - inc(p.labels) - var tmp = con("%LOC", toRope(p.labels)) - incl(s.loc.flags, lfParamCopy) - incl(s.loc.flags, lfIndirect) - lineF(p, cpsInit, "$1 = alloca $3$n" & "store $3 $2, $3* $1$n", - [tmp, s.loc.r, getTypeDesc(p.module, s.loc.t)]) - s.loc.r = tmp - -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 = con("&", s.loc.r) - if s.kind == skParam and ccgIntroducedPtr(s): a = s.loc.r - lineF(p, cpsInit, - "F.s[$1].address = (void*)$3; F.s[$1].typ = $4; F.s[$1].name = $2;$n", - [p.maxFrameLen.toRope, makeCString(normalize(s.name.s)), a, - genTypeInfo(p.module, s.loc.t)]) - inc(p.maxFrameLen) - inc p.blocks[p.blocks.len-1].frameLen - -proc assignLocalVar(p: BProc, s: PSym) = - #assert(s.loc.k == locNone) // not yet assigned - # this need not be fullfilled for inline procs; they are regenerated - # for each module that uses them! - if s.loc.k == locNone: - fillLoc(s.loc, locLocalVar, s.typ, mangleName(s), OnStack) + # 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): TLoc = + inc(p.labels) + 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: + fillLocalName(p, s) + fillLoc(s.loc, locLocalVar, n, OnStack) if s.kind == skLet: incl(s.loc.flags, lfNoDeepCopy) - var decl = getTypeDesc(p.module, s.loc.t) - if s.constraint.isNil: - if sfRegister in s.flags: app(decl, " 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: - # app(decl, " GC_GUARD") - if sfVolatile in s.flags or p.nestedTryStmts.len > 0: - app(decl, " volatile") - appf(decl, " $1;$n", [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: - decl = ropef(s.cgDeclFrmt & ";$n", decl, 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: "\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, s) include ccgthreadvars -proc VarInDynamicLib(m: BModule, sym: PSym) -proc mangleDynLibProc(sym: PSym): PRope +proc varInDynamicLib(m: BModule, sym: PSym) + +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: + fillBackendName(p.module, s) + fillLoc(s.loc, locGlobalVar, n, OnHeap) + if treatGlobalDifferentlyForHCR(p.module, s): incl(s.loc.flags, lfIndirect) -proc assignGlobalVar(p: BProc, s: PSym) = - if s.loc.k == locNone: - fillLoc(s.loc, locGlobalVar, s.typ, mangleName(s), OnHeap) - 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) + 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: PRope = nil - var td = getTypeDesc(p.module, s.loc.t) - if s.constraint.isNil: - if sfImportc in s.flags: app(decl, "extern ") - app(decl, td) - if sfRegister in s.flags: app(decl, " register") - if sfVolatile in s.flags: app(decl, " volatile") - appf(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 = ropef(s.cgDeclFrmt & ";$n", td, s.loc.r) - app(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", - [cstringLit(p, p.module.s[cfsDebugInit], - normalize(s.owner.name.s & '.' & s.name.s)), - s.loc.r, genTypeInfo(p.module, s.typ)]) - -proc assignParam(p: BProc, s: PSym) = - assert(s.loc.r != nil) - if sfAddrTaken in s.flags and gCmd == cmdCompileToLLVM: allocParam(p, s) - localDebugInfo(p, s) - -proc fillProcLoc(sym: PSym) = - if sym.loc.k == locNone: - fillLoc(sym.loc, locProc, sym.typ, mangleName(sym), OnStack) - -proc getLabel(p: BProc): TLabel = + +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) + +proc fillProcLoc(m: BModule; n: PNode) = + let sym = n.sym + if sym.loc.k == locNone: + fillBackendName(m, sym) + fillLoc(sym.loc, locProc, n, OnStack) + +proc getLabel(p: BProc): TLabel = inc(p.labels) - result = con("LA", toRope(p.labels)) + result = "LA" & rope(p.labels) & "_" -proc fixLabel(p: BProc, labl: TLabel) = - lineF(p, cpsStmts, "$1: ;$n", [labl]) +proc fixLabel(p: BProc, labl: TLabel) = + p.s(cpsStmts).add("$1: ;$n" % [labl]) -proc genVarPrototype(m: BModule, sym: PSym) +proc genVarPrototype(m: BModule, n: PNode) proc requestConstImpl(p: BProc, sym: PSym) -proc genProc(m: BModule, prc: 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): PRope -proc genLiteral(p: BProc, n: PNode): PRope +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 initLocExpr(p: BProc, e: PNode, result: var TLoc) = - initLoc(result, locNone, e.typ, OnUnknown) +proc initLocExprSingleUse(p: BProc, e: PNode): TLoc = + result = initLoc(locNone, e, OnUnknown) + if e.kind in nkCallKinds and (e[0].kind != nkSym or e[0].sym.magic == mNone): + # We cannot check for tfNoSideEffect here because of mutable parameters. + discard "bug #8202; enforce evaluation order for nested calls for C++ too" + # 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: PRope {.inline.} = - result = toRope(if gCmd != cmdCompileToCpp: "Sup.len" else: "len") +include ccgcalls, "ccgstmts.nim" + +proc initFrame(p: BProc, procname, filename: Rope): Rope = + 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; -include ccgcalls, "ccgstmts.nim", "ccgexprs.nim" +""" + 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 = + 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, line]) + +proc deinitFrameNoDebug(p: BProc; frame: Rope): Rope = + result = ropecg(p.module, "\t#popFrameOfAddr(&$1);$n", [frame]) + +proc deinitFrame(p: BProc): Rope = + result = ropecg(p.module, "\t#popFrame();$n", []) + +include ccgexprs # ----------------------------- dynamic library handling ----------------- -# We don't finalize dynamic libs as this does the OS for us. +# We don't finalize dynamic libs as the OS does this for us. proc isGetProcAddr(lib: PLib): bool = let n = lib.path - result = n.kind in nkCallKinds and n.typ != nil and + result = n.kind in nkCallKinds and n.typ != nil and n.typ.kind in {tyPointer, tyProc} -proc loadDynamicLib(m: BModule, lib: PLib) = +proc loadDynamicLib(m: BModule, lib: PLib) = assert(lib != nil) - if not lib.generated: + if not lib.generated: lib.generated = true - var tmp = getGlobalTempName() - assert(lib.name == nil) + var tmp = getTempName(m) + assert(lib.name == "") lib.name = tmp # BUGFIX: cgsym has awful side-effects - appf(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) - if gVerbosity >= 2: - MsgWriteln("Dependency: " & lib.path.strVal) - var loadlib: PRope = nil - for i in countup(0, high(s)): + rawMessage(m.config, hintDependency, lib.path.strVal) + var loadlib: Rope = "" + for i in 0..high(s): inc(m.labels) - if i > 0: app(loadlib, "||") - appcg(m, loadlib, "($1 = #nimLoadLibrary((#NimStringDesc*) &$2))$n", - [tmp, getStrLit(m, s[i])]) - appcg(m, m.s[cfsDynLibInit], - "if (!($1)) #nimLoadLibraryError((#NimStringDesc*) &$2);$n", - [loadlib, getStrLit(m, lib.path.strVal)]) + if i > 0: loadlib.add("||") + let n = newStrNode(nkStrLit, s[i]) + n.info = lib.path.info + appcg(m, loadlib, "($1 = #nimLoadLibrary(", [tmp]) + genStringLiteral(m, n, loadlib) + loadlib.addf "))$n", [] + appcg(m, m.s[cfsDynLibInit], + "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) - app(m.s[cfsVars], p.s(cpsLocals)) - app(m.s[cfsDynLibInit], p.s(cpsInit)) - app(m.s[cfsDynLibInit], p.s(cpsStmts)) - appcg(m, m.s[cfsDynLibInit], - "if (!($1 = #nimLoadLibrary($2))) #nimLoadLibraryError($2);$n", + 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("loadDynamicLib") - -proc mangleDynLibProc(sym: PSym): PRope = - if sfCompilerProc in sym.flags: - # NOTE: sym.loc.r is the external name! - result = toRope(sym.name.s) + + 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.snippet is the external name! + result = rope(sym.name.s) else: - result = ropef("Dl_$1", [toRope(sym.id)]) - -proc SymInDynamicLib(m: BModule, sym: PSym) = + 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) - if gCmd == cmdCompileToLLVM: 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 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 params = con(rdLoc(a), "(") - for i in 1 .. n.len-2: - initLocExpr(m.initProc, n[i], a) - params.app(rdLoc(a)) - params.app(", ") - let load = ropef("\t$1 = ($2) ($3$4));$n", - [tmp, getTypeDesc(m, sym.typ), - params, cstringLit(m, m.s[cfsDynLibInit], ropeToStr(extname))]) + var a: TLoc = initLocExpr(m.initProc, n[0]) + var params = rdLoc(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, dkVar), params, makeCString($extname)] var last = lastSon(n) - if last.kind == nkHiddenStdConv: last = last.sons[1] - InternalAssert(last.kind == nkStrLit) + if last.kind == nkHiddenStdConv: last = last[1] + internalAssert(m.config, last.kind == nkStrLit) let idx = last.strVal if idx.len == 0: - app(m.initProc.s(cpsStmts), load) + m.initProc.s(cpsStmts).add(load) elif idx.len == 1 and idx[0] in {'0'..'9'}: - app(m.extensionLoaders[idx[0]], load) + m.extensionLoaders[idx[0]].add(load) else: - InternalError(sym.info, "wrong index: " & idx) + 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, cstringLit(m, m.s[cfsDynLibInit], ropeToStr(extname))]) - appff(m.s[cfsVars], "$2 $1;$n", - "$1 = linkonce global $2 zeroinitializer$n", - [sym.loc.r, getTypeDesc(m, sym.loc.t)]) - -proc VarInDynamicLib(m: BModule, sym: PSym) = + appcg(m, m.s[cfsDynLibInit], + "\t$1 = ($2) #nimGetProcAddr($3, $4);$n", + [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, cstringLit(m, m.s[cfsDynLibInit], ropeToStr(extname))]) - appf(m.s[cfsVars], "$2* $1;$n", - [sym.loc.r, getTypeDesc(m, sym.loc.t)]) - -proc SymInDynamicLibPartial(m: BModule, sym: PSym) = - sym.loc.r = mangleDynLibProc(sym) + appcg(m, m.s[cfsDynLibInit], + "$1 = ($2*) #nimGetProcAddr($3, $4);$n", + [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.snippet = mangleDynLibProc(sym) sym.typ.sym = nil # generate a new name -proc cgsym(m: BModule, name: string): PRope = - var sym = magicsys.getCompilerProc(name) - if sym != nil: - case sym.kind - of skProc, skMethod, skConverter, skIterator: genProc(m, sym) - of skVar, skResult, skLet: genVarPrototype(m, sym) - of skType: discard getTypeDesc(m, sym.typ) - else: InternalError("cgsym: " & name) - 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(errSystemNeeds, name) - result = sym.loc.r - -proc generateHeaders(m: BModule) = - app(m.s[cfsHeaders], tnl & "#include \"nimbase.h\"" & tnl) - var it = PStrEntry(m.headerFiles.head) - while it != nil: - if it.data[0] notin {'\"', '<'}: - appf(m.s[cfsHeaders], "$N#include \"$1\"$N", [toRope(it.data)]) - else: - appf(m.s[cfsHeaders], "$N#include $1$N", [toRope(it.data)]) - it = PStrEntry(it.Next) - -proc retIsNotVoid(s: PSym): bool = - result = (s.typ.sons[0] != nil) and not isInvalidReturnType(s.typ.sons[0]) - -proc initFrame(p: BProc, procname, filename: PRope): PRope = - discard cgsym(p.module, "pushFrame") - if p.maxFrameLen > 0: - discard cgsym(p.module, "TVarSlot") - result = rfmt(nil, "\tnimfrs($1, $2, $3, $4)$N", - procname, filename, p.maxFrameLen.toRope, - p.blocks[0].frameLen.toRope) +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: - result = rfmt(nil, "\tnimfr($1, $2)$N", procname, filename) + rawMessage(m.config, errGenerated, "system module needs: " & name) -proc deinitFrame(p: BProc): PRope = - result = rfmt(p.module, "\t#popFrame();$n") +proc cgsymValue(m: BModule, name: string): Rope = + let sym = magicsys.getCompilerProc(m.g.graph, name) + if sym != nil: + cgsymImpl m, sym + else: + rawMessage(m.config, errGenerated, "system module needs: " & name) + 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) = + 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] == '#': + m.s[cfsHeaders].add(rope(it.replace('`', '"') & "\L")) + elif it[0] notin {'"', '<'}: + m.s[cfsHeaders].addf("#include \"$1\"$N", [rope(it)]) + else: + 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) = if tfCapturesEnv notin prc.typ.flags: return # prc.ast[paramsPos].last contains the type we're after: var ls = lastSon(prc.ast[paramsPos]) if ls.kind != nkSym: - InternalError(prc.info, "closure generation failed") + internalError(p.config, prc.info, "closure generation failed") var env = ls.sym #echo "created environment: ", env.id, " for ", prc.name.s - assignLocalVar(p, env) + assignLocalVar(p, ls) # generate cast assignment: - linefmt(p, cpsStmts, "$1 = ($2) ClEnv;$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 = + 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.len: + if containsResult(n[i]): return true -proc genProcAux(m: BModule, prc: PSym) = +proc easyResultAsgn(n: PNode): PNode = + result = nil + case n.kind + of nkStmtList, nkStmtListExpr: + var i = 0 + while i < n.len and n[i].kind in harmless: inc i + if i < n.len: result = easyResultAsgn(n[i]) + of nkAsgn, nkFastAsgn, nkSinkAsgn: + if n[0].kind == nkSym and n[0].sym.kind == skResult and not containsResult(n[1]): + incl n.flags, nfPreventCg + return n[1] + of nkReturnStmt: + if n.len > 0: + result = easyResultAsgn(n[0]) + if result != nil: incl n.flags, nfPreventCg + else: discard + +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: PRope = 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 res = prc.ast.sons[resultPos].sym # get result symbol - if not isInvalidReturnType(prc.typ.sons[0]): + + 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[resultPos] + let res = resNode.sym # get result symbol + if not isInvalidReturnType(m.config, prc.typ) and sfConstructor notin prc.flags: if sfNoInit in prc.flags: incl(res.flags, sfNoInit) - # declare the result symbol: - assignLocalVar(p, res) - assert(res.loc.r != nil) - returnStmt = rfmt(nil, "\treturn $1;$n", rdLoc(res.loc)) - initLocalVar(p, res, immediateAsgn=false) + 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) + linefmt(p, cpsStmts, "$1 = $2;$n", [decl, rdLoc(a)]) + else: + # declare the result symbol: + assignLocalVar(p, resNode) + 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(res) - assignParam(p, res) - if skipTypes(res.typ, abstractInst).kind == tyArray: - incl(res.loc.flags, lfIndirect) - res.loc.s = OnUnknown - for i in countup(1, sonsLen(prc.typ.n) - 1): - var param = prc.typ.n.sons[i].sym + 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 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: PRope - if sfPure in prc.flags: - generatedProc = rfmt(nil, "$N$1 {$n$2$3$4}$N$N", - header, p.s(cpsLocals), p.s(cpsInit), p.s(cpsStmts)) + 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 and not isCppMember: + header = "__declspec(naked) " & header + generatedProc.add ropecg(p.module, "$1 {$n$2$3$4}$N$N", + [header, p.s(cpsLocals), p.s(cpsInit), p.s(cpsStmts)]) else: - generatedProc = rfmt(nil, "$N$1 {$N", header) - app(generatedProc, initGCFrame(p)) - if optStackTrace in prc.options: - app(generatedProc, p.s(cpsLocals)) - var procname = CStringLit(p, generatedProc, prc.name.s) - app(generatedProc, initFrame(p, procname, prc.info.quotedFilename)) - else: - app(generatedProc, p.s(cpsLocals)) - if (optProfiler in prc.options) and (gCmd != cmdCompileToLLVM): + 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: + generatedProc.add(p.s(cpsLocals)) + var procname = makeCString(prc.name.s) + generatedProc.add(initFrame(p, procname, quotedFilename(p.config, prc.info))) + else: + generatedProc.add(p.s(cpsLocals)) + if optProfiler in prc.options: # invoke at proc entry for recursion: appcg(p, cpsInit, "\t#nimProfile();$n", []) - app(generatedProc, p.s(cpsInit)) - app(generatedProc, p.s(cpsStmts)) - if p.beforeRetNeeded: app(generatedProc, ~"\tBeforeRet: ;$n") - app(generatedProc, deinitGCFrame(p)) - if optStackTrace in prc.options: app(generatedProc, deinitFrame(p)) - app(generatedProc, returnStmt) - app(generatedProc, ~"}$N") - app(m.s[cfsProcs], generatedProc) - -proc genProcPrototype(m: BModule, sym: PSym) = + # 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.backend != backendCpp) or ( + sym.flags * {sfInfixCall, sfCompilerProc, sfMangleCpp} == {} and + sym.flags * {sfImportc, sfExportc} != {} and + sym.magic == mNone and + m.config.backend == backendCpp) + +proc genProcPrototype(m: BModule, sym: PSym) = useHeader(m, sym) - if lfNoDecl in sym.loc.Flags: return - if lfDynamicLib in sym.loc.Flags: - if getModule(sym).id != m.module.id and - not ContainsOrIncl(m.declaredThings, sym.id): - app(m.s[cfsVars], rfmt(nil, "extern $1 $2;$n", - getTypeDesc(m, sym.loc.t), mangleDynLibProc(sym))) - if gCmd == cmdCompileToLLVM: incl(sym.loc.flags, lfIndirect) - elif not ContainsOrIncl(m.declaredProtos, sym.id): - app(m.s[cfsProcHeaders], rfmt(nil, "$1;$n", genProcHeader(m, sym))) - -proc genProcNoForward(m: BModule, prc: PSym) = - fillProcLoc(prc) - useHeader(m, prc) + if lfNoDecl in sym.loc.flags or sfCppMember * sym.flags != {}: return + if lfDynamicLib in sym.loc.flags: + if sym.itemId.module != m.module.position and + not containsOrIncl(m.declaredThings, sym.id): + 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): + 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) - return - genProcPrototype(m, prc) - if lfNoDecl in prc.loc.Flags: nil + cgsym(m, prc.name.s) + return + if lfNoDecl in prc.loc.flags: + fillProcLoc(m, prc.ast[namePos]) + genProcPrototype(m, prc) + elif lfDynamicLib in prc.loc.flags: + var q = findPendingModule(m, prc) + fillProcLoc(q, prc.ast[namePos]) + genProcPrototype(m, prc) + if q != nil and not containsOrIncl(q.declaredThings, prc.id): + symInDynamicLib(q, prc) + # register the procedure even though it is in a different dynamic library and will not be + # reloadable (and has no _actual suffix) - other modules will need to be able to get it through + # the hcr dynlib (also put it in the DynLibInit section - right after it gets loaded) + if isReloadable(q, prc): + q.s[cfsDynLibInit].addf("\t$1 = ($2) hcrRegisterProc($3, \"$1\", (void*)$1);$n", + [prc.loc.snippet, getTypeDesc(q, prc.loc.t), getModuleDllPath(m, q.module)]) + else: + symInDynamicLibPartial(m, prc) elif prc.typ.callConv == ccInline: # We add inline procs to the calling module to enable C based inlining. # This also means that a check with ``q.declaredThings`` is wrong, we need # a check for ``m.declaredThings``. - if not ContainsOrIncl(m.declaredThings, prc.id): genProcAux(m, prc) - elif lfDynamicLib in prc.loc.flags: - var q = findPendingModule(m, prc) - if q != nil and not ContainsOrIncl(q.declaredThings, prc.id): - SymInDynamicLib(q, prc) - else: - SymInDynamicLibPartial(m, prc) + if not containsOrIncl(m.declaredThings, prc.id): + #if prc.loc.k == locNone: + # 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.snippet = nil + # prc.loc.snippet = mangleName(m, prc) + genProcPrototype(m, prc) + genProcAux(m, prc) elif sfImportc notin prc.flags: var q = findPendingModule(m, prc) - if q != nil and not ContainsOrIncl(q.declaredThings, prc.id): + fillProcLoc(q, prc.ast[namePos]) + # 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]) + useHeader(m, prc) + 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.typ, mangleName(sym), OnUnknown) - 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 - appf(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 = ropef("extern NIM_CONST $1 $2;$n", - [getTypeDesc(m, sym.loc.t), sym.loc.r]) - app(m.s[cfsData], headerDecl) - if sfExportc in sym.flags and generatedHeader != nil: - app(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 -proc genProc(m: BModule, prc: PSym) = +proc genProc(m: BModule, prc: PSym) = if sfBorrow in prc.flags or not isActivated(prc): return - fillProcLoc(prc) - if {sfForward, sfFromGeneric} * prc.flags != {}: addForwardedProc(m, prc) - else: + if sfForward in prc.flags: + addForwardedProc(m, prc) + fillProcLoc(m, prc.ast[namePos]) + else: genProcNoForward(m, prc) if {sfExportc, sfCompilerProc} * prc.flags == {sfExportc} and - generatedHeader != nil and lfNoDecl notin prc.loc.Flags: - genProcPrototype(generatedHeader, prc) + m.g.generatedHeader != nil and lfNoDecl notin prc.loc.flags: + genProcPrototype(m.g.generatedHeader, prc) if prc.typ.callConv == ccInline: - if not ContainsOrIncl(generatedHeader.declaredThings, prc.id): - genProcAux(generatedHeader, prc) + if not containsOrIncl(m.g.generatedHeader.declaredThings, prc.id): + genProcAux(m.g.generatedHeader, prc) -proc genVarPrototypeAux(m: BModule, sym: PSym) = - assert(sfGlobal in sym.flags) +proc genVarPrototype(m: BModule, n: PNode) = + #assert(sfGlobal in sym.flags) + let sym = n.sym useHeader(m, sym) - fillLoc(sym.loc, locGlobalVar, sym.typ, mangleName(sym), OnHeap) - if (lfNoDecl in sym.loc.Flags) or ContainsOrIncl(m.declaredThings, sym.id): - return - if sym.owner.id != m.module.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) - if sfThread in sym.flags: + assert(sym.loc.snippet != "") + incl(m.declaredThings, sym.id) + if sfThread in sym.flags: declareThreadVar(m, sym, true) else: - app(m.s[cfsVars], "extern ") - app(m.s[cfsVars], getTypeDesc(m, sym.loc.t)) - if lfDynamicLib in sym.loc.flags: app(m.s[cfsVars], "*") - if sfRegister in sym.flags: app(m.s[cfsVars], " register") - if sfVolatile in sym.flags: app(m.s[cfsVars], " volatile") - appf(m.s[cfsVars], " $1;$n", [sym.loc.r]) - -proc genVarPrototype(m: BModule, sym: PSym) = - genVarPrototypeAux(m, sym) - -proc addIntTypes(result: var PRope) {.inline.} = - appf(result, "#define NIM_INTBITS $1", [ - platform.CPU[targetCPU].intSize.toRope]) - -proc getCopyright(cfilenoext: string): PRope = - if optCompileOnly in gGlobalOptions: - result = ropeff("/* Generated by Nimrod Compiler v$1 */$n" & - "/* (c) 2012 Andreas Rumpf */$n" & - "/* The generated code is subject to the original license. */$n", - "; Generated by Nimrod Compiler v$1$n" & - "; (c) 2012 Andreas Rumpf$n", [toRope(versionAsString)]) - else: - result = ropeff("/* Generated by Nimrod Compiler v$1 */$n" & - "/* (c) 2012 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", - "; Generated by Nimrod Compiler v$1$n" & - "; (c) 2012 Andreas Rumpf$n" & - "; Compiled for: $2, $3, $4$n" & - "; Command for LLVM compiler:$n $5$n", [toRope(versionAsString), - toRope(platform.OS[targetOS].name), - toRope(platform.CPU[targetCPU].name), - toRope(extccomp.CC[extccomp.ccompiler].name), - toRope(getCompileCFileCmd(cfilenoext))]) - -proc getFileHeader(cfilenoext: string): PRope = - result = getCopyright(cfilenoext) - addIntTypes(result) - -proc genFilenames(m: BModule): PRope = - discard cgsym(m, "dbgRegisterFilename") - result = nil - for i in 0.. <fileInfos.len: - result.appf("dbgRegisterFilename($1);$n", fileInfos[i].projPath.makeCString) + 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 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 = + 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) + 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 genMainProc(m: BModule) = - const - CommonMainBody = - "\tsystemDatInit();$n" & +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 = "$N" & + "N_LIB_PRIVATE void $3PreMainInner(void) {$N" & + "$2" & + "}$N$N" & + "$4" & + "N_LIB_PRIVATE void $3PreMain(void) {$N" & + "##if $5$N" & # 1 for volatile call, 0 for non-volatile + "\tvoid (*volatile inner)(void);$N" & + "\tinner = $3PreMainInner;$N" & + "$1" & + "\t(*inner)();$N" & + "##else$N" & + "$1" & + "\t$3PreMainInner();$N" & + "##endif$N" & + "}$N$N" + + MainProcs = + "\t$^NimMain();$N" + + MainProcsWithResult = + MainProcs & ("\treturn $1nim_program_result;$N") + + NimMainInner = "N_LIB_PRIVATE N_CDECL(void, $5NimMainInner)(void) {$N" & "$1" & - "$2" & - "\tsystemInit();$n" & - "$3" & - "$4" - PosixNimMain = - "int cmdCount;$n" & - "char** cmdLine;$n" & - "char** gEnv;$n" & - "N_CDECL(void, NimMain)(void) {$n" & - CommonMainBody & "}$n" - PosixCMain = "int main(int argc, char** args, char** env) {$n" & - "\tcmdLine = args;$n" & "\tcmdCount = argc;$n" & "\tgEnv = env;$n" & - "\tNimMain();$n" & "\treturn nim_program_result;$n" & "}$n" - StandaloneCMain = "int main(void) {$n" & - "\tNimMain();$n" & - "\treturn 0;$n" & "}$n" - WinNimMain = "N_CDECL(void, NimMain)(void) {$n" & - CommonMainBody & "}$n" - WinCMain = "N_STDCALL(int, WinMain)(HINSTANCE hCurInstance, $n" & - " HINSTANCE hPrevInstance, $n" & - " LPSTR lpCmdLine, int nCmdShow) {$n" & - "\tNimMain();$n" & "\treturn nim_program_result;$n" & "}$n" - WinNimDllMain = "N_LIB_EXPORT N_CDECL(void, NimMain)(void) {$n" & - CommonMainBody & "}$n" - WinCDllMain = - "BOOL WINAPI DllMain(HINSTANCE hinstDLL, DWORD fwdreason, $n" & - " LPVOID lpvReserved) {$n" & - "\tif(fwdreason == DLL_PROCESS_ATTACH) NimMain();$n" & - "\treturn 1;$n" & "}$n" + "}$N$N" + + NimMainProc = + "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 + + PosixCMain = + "int main(int argc, char** args, char** env) {$N" & + "\tcmdLine = args;$N" & + "\tcmdCount = argc;$N" & + "\tgEnv = env;$N" & + MainProcsWithResult & + "}$N$N" + + StandaloneCMain = + "int main(void) {$N" & + MainProcs & + "\treturn 0;$N" & + "}$N$N" + + WinNimMain = NimMainBody + + WinCMain = "N_STDCALL(int, WinMain)(HINSTANCE hCurInstance, $N" & + " HINSTANCE hPrevInstance, $N" & + " LPSTR lpCmdLine, int nCmdShow) {$N" & + MainProcsWithResult & "}$N$N" + + WinNimDllMain = NimMainInner & "N_LIB_EXPORT " & NimMainProc + + WinCDllMain = + "BOOL WINAPI DllMain(HINSTANCE hinstDLL, DWORD fwdreason, $N" & + " LPVOID lpvReserved) {$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" & - "\tNimMain();$n}$n" - var nimMain, otherMain: TFormatStr - if platform.targetOS == osWindows and - gGlobalOptions * {optGenGuiApp, optGenDynLib} != {}: - if optGenGuiApp in gGlobalOptions: - nimMain = WinNimMain - otherMain = WinCMain - else: - nimMain = WinNimDllMain - otherMain = WinCDllMain - discard lists.IncludeStr(m.headerFiles, "<windows.h>") - elif optGenDynLib in gGlobalOptions: - nimMain = posixNimDllMain - otherMain = posixCDllMain - elif platform.targetOS == osStandalone: - nimMain = PosixNimMain - otherMain = StandaloneCMain - else: - nimMain = PosixNimMain - otherMain = PosixCMain - if gBreakpoints != nil: discard cgsym(m, "dbgRegisterBreakpoint") - if optEndb in gOptions: - gBreakpoints.app(m.genFilenames) - - let initStackBottomCall = if emulatedThreadVars() or - platform.targetOS == osStandalone: "".toRope - else: ropecg(m, "\t#initStackBottom();$n") + + PosixCDllMain = + "N_LIB_PRIVATE void NIM_POSIX_INIT NimMainInit(void) {$N" & + MainProcs & + "}$N$N" + + GenodeNimMain = + "extern Genode::Env *nim_runtime_env;$N" & + "extern \"C\" void nim_component_construct(Genode::Env*);$N$N" & + NimMainBody + + ComponentConstruct = + "void Libc::Component::construct(Libc::Env &env) {$N" & + "\t// Set Env used during runtime initialization$N" & + "\tnim_runtime_env = &env;$N" & + "\tLibc::with_libc([&] () {$N\t" & + "\t// Initialize runtime and globals$N" & + MainProcs & + "\t// Call application construct$N" & + "\t\tnim_component_construct(&env);$N" & + "\t});$N" & + "}$N$N" + + if m.config.target.targetOS == osWindows and + m.config.globalOptions * {optGenGuiApp, optGenDynLib} != {}: + m.includeHeader("<windows.h>") + elif m.config.target.targetOS == osGenode: + m.includeHeader("<libc/component.h>") + + let initStackBottomCall = + 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], nimMain, [mainDatInit, initStackBottomCall, - gBreakpoints, mainModInit, toRope(m.labels)]) - if optNoMain notin gGlobalOptions: - appcg(m, m.s[cfsProcs], otherMain, []) - -proc getInitName(m: PSym): PRope = - result = ropeff("$1Init", "@$1Init", [toRope(m.name.s)]) - -proc getDatInitName(m: PSym): PRope = - result = ropeff("$1DatInit", "@$1DatInit", [toRope(m.name.s)]) - -proc registerModuleToMain(m: PSym) = - var + + 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: + 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 whichInitProcs*(m: BModule): set[ModuleBackendFlag] = + # called from IC. + result = {} + if m.hcrOn or m.preInitProc.s(cpsInit).len > 0 or m.preInitProc.s(cpsStmts).len > 0: + result.incl HasModuleInitProc + for i in cfsTypeInit1..cfsDynLibInit: + if m.s[i].len != 0: + result.incl HasDatInitProc + break + +proc registerModuleToMain(g: BModuleList; m: BModule) = + let init = m.getInitName datInit = m.getDatInitName - appff(mainModProcs, "N_NOINLINE(void, $1)(void);$N", - "declare void $1() noinline$N", [init]) - appff(mainModProcs, "N_NOINLINE(void, $1)(void);$N", - "declare void $1() noinline$N", [datInit]) - if not (sfSystemModule in m.flags): - appff(mainModInit, "\t$1();$n", "call void ()* $1$n", [init]) - appff(mainDatInit, "\t$1();$n", "call void ()* $1$n", [datInit]) - -proc genInitCode(m: BModule) = - var initname = getInitName(m.module) - var prc = ropeff("N_NOINLINE(void, $1)(void) {$n", - "define void $1() noinline {$n", [initname]) - if m.typeNodes > 0: - appcg(m, m.s[cfsTypeInit1], "static #TNimNode $1[$2];$n", - [m.typeNodesName, toRope(m.typeNodes)]) - if m.nimTypes > 0: - appcg(m, m.s[cfsTypeInit1], "static #TNimType $1[$2];$n", - [m.nimTypesName, toRope(m.nimTypes)]) - - app(prc, initGCFrame(m.initProc)) - - app(prc, genSectionStart(cpsLocals)) - app(prc, m.initProc.s(cpsLocals)) - app(prc, m.preInitProc.s(cpsLocals)) - app(prc, genSectionEnd(cpsLocals)) - - if optStackTrace in m.initProc.options and not m.FrameDeclared: - # BUT: the generated init code might depend on a current frame, so - # declare it nevertheless: - m.FrameDeclared = true - if not m.PreventStackTrace: - var procname = CStringLit(m.initProc, prc, m.module.name.s) - app(prc, initFrame(m.initProc, procname, m.module.info.quotedFilename)) + + 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: - app(prc, ~"\tTFrame F; F.len = 0;$N") - - app(prc, genSectionStart(cpsInit)) - app(prc, m.preInitProc.s(cpsInit)) - app(prc, m.initProc.s(cpsInit)) - app(prc, genSectionEnd(cpsInit)) - - app(prc, genSectionStart(cpsStmts)) - app(prc, m.preInitProc.s(cpsStmts)) - app(prc, m.initProc.s(cpsStmts)) - app(prc, genSectionEnd(cpsStmts)) - if optStackTrace in m.initProc.options and not m.PreventStackTrace: - app(prc, deinitFrame(m.initProc)) - app(prc, deinitGCFrame(m.initProc)) - appf(prc, "}$N$N") - - prc.appff("N_NOINLINE(void, $1)(void) {$n", - "define void $1() noinline {$n", [getDatInitName(m.module)]) + 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.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: + 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: - app(prc, genSectionStart(i)) - app(prc, m.s[i]) - app(prc, genSectionEnd(i)) - - appf(prc, "}$N$N") + 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) = + ## 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: + 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, 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") + + 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", []) + # 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`` - app(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: - let ex = ropef("N_NIMCALL(void, nimLoadProcs$1)(void) {$2}$N$N", - (i.ord - '0'.ord).toRope, el) - app(m.s[cfsInitProc], ex) - -proc genModule(m: BModule, cfilenoext: string): PRope = - result = getFileHeader(cfilenoext) - result.app(genMergeInfo(m)) - - generateHeaders(m) + if el != "": + let ex = "NIM_EXTERNC N_NIMCALL(void, nimLoadProcs$1)(void) {$2}$N$N" % + [(i.ord - '0'.ord).rope, el] + 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) generateThreadLocalStorage(m) - for i in countup(cfsHeaders, cfsProcs): - app(result, genSectionStart(i)) - app(result, m.s[i]) - app(result, genSectionEnd(i)) - app(result, m.s[cfsInitProc]) - -proc newPreInitProc(m: BModule): BProc = - result = newProc(nil, m) - # little hack so that unique temporaries are generated: - result.labels = 100_000 - -proc rawNewModule(module: PSym, filename: string): BModule = + generateHeaders(m) + 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: AbsoluteFile): BModule = new(result) - InitLinkedList(result.headerFiles) + result.g = g + result.tmpBase = rope("TM" & $hashOwner(module) & "_") + result.headerFiles = @[] result.declaredThings = initIntSet() result.declaredProtos = initIntSet() result.cfilename = filename result.filename = filename - initIdTable(result.typeCache) - initIdTable(result.forwTypeCache) + result.typeCache = initTable[SigHash, Rope]() + result.forwTypeCache = initTable[SigHash, Rope]() result.module = module - result.typeInfoMarker = initIntSet() + result.typeInfoMarker = initTable[SigHash, Rope]() + result.sigConflicts = initCountTable[SigHash]() result.initProc = newProc(nil, result) - result.initProc.options = gOptions - result.preInitProc = newPreInitProc(result) - initNodeTable(result.dataCache) + for i in low(result.s)..high(result.s): result.s[i] = newRopeAppender() + result.initProc.options = initProcOptions(result) + result.preInitProc = newProc(nil, result) + result.preInitProc.flags.incl nimErrorFlagDisabled + result.preInitProc.labels = 100_000 # little hack so that unique temporaries are generated + result.dataCache = initNodeTable() result.typeStack = @[] - result.forwardedProcs = @[] - result.typeNodesName = getTempName() - result.nimTypesName = getTempName() - result.PreventStackTrace = sfSystemModule in module.flags - -proc nullify[T](arr: var T) = - for i in low(arr)..high(arr): - arr[i] = nil - -proc resetModule*(m: var BModule) = - # between two compilations in CAAS mode, we can throw - # away all the data that was written to disk - InitLinkedList(m.headerFiles) - m.declaredProtos = initIntSet() - initIdTable(m.forwTypeCache) - m.initProc = newProc(nil, m) - m.initProc.options = gOptions - m.preInitProc = newPreInitProc(m) - initNodeTable(m.dataCache) - m.typeStack = @[] - m.forwardedProcs = @[] - m.typeNodesName = getTempName() - m.nimTypesName = getTempName() - m.PreventStackTrace = sfSystemModule in m.module.flags - nullify m.s - m.usesThreadVars = false - 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 - - # 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* = - for m in cgenModules(): resetModule(m) - -proc rawNewModule(module: PSym): BModule = - result = rawNewModule(module, module.filename) - -proc newModule(module: PSym): BModule = + 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 bottom initialization: + if sfSystemModule in module.flags: + incl result.flags, preventStackTrace + excl(result.preInitProc.options, optStackTrace) + let ndiName = if optCDebug in g.config.globalOptions: changeFileExt(completeCfilePath(g.config, filename), "ndi") + else: AbsoluteFile"" + open(result.ndi, ndiName, g.config) + +proc rawNewModule(g: BModuleList; module: PSym; conf: ConfigRef): BModule = + result = rawNewModule(g, module, AbsoluteFile toFullPath(conf, module.position.FileIndex)) + +proc newModule*(g: BModuleList; module: PSym; conf: ConfigRef): BModule = # we should create only one cgen module for each module sym - InternalAssert getCgenModule(module) == nil - - result = rawNewModule(module) - growCache gModules, module.position - gModules[module.position] = result - - if (optDeadCodeElim in gGlobalOptions): - if (sfDeadCodeElim in module.flags): - InternalError("added pending module twice: " & module.filename) - -proc myOpen(module: PSym): PPassContext = - result = newModule(module) - if optGenIndex in gGlobalOptions and generatedHeader == nil: - let f = if headerFile.len > 0: headerFile else: gProjectFull - generatedHeader = rawNewModule(module, - changeFileExt(completeCFilePath(f), hExt)) - generatedHeader.isHeaderFile = true + result = rawNewModule(g, module, conf) + if module.position >= g.modules.len: + setLen(g.modules, module.position + 1) + #growCache g.modules, module.position + g.modules[module.position] = result + +template injectG() {.dirty.} = + if graph.backend == nil: + graph.backend = newModuleList(graph) + let g = BModuleList(graph.backend) + +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: AbsoluteFile graph.config.headerFile + else: graph.config.projectFull + g.generatedHeader = rawNewModule(g, module, + changeFileExt(completeCfilePath(graph.config, f), hExt)) + incl g.generatedHeader.flags, isHeaderFile proc writeHeader(m: BModule) = - var result = getCopyright(m.filename) - var guard = ropef("__$1__", m.filename.splitFile.name.toRope) - result.appf("#ifndef $1$n#define $1$n", guard) - addIntTypes(result) + var result = headerTop() + var guard = "__$1__" % [m.filename.splitFile.name.rope] + result.addf("#ifndef $1$n#define $1$n", [guard]) + addNimDefines(result, m.config) generateHeaders(m) generateThreadLocalStorage(m) - for i in countup(cfsHeaders, cfsProcs): - app(result, genSectionStart(i)) - app(result, m.s[i]) - app(result, genSectionEnd(i)) - app(result, m.s[cfsInitProc]) - - if optGenDynLib in gGlobalOptions: - result.app("N_LIB_IMPORT ") - result.appf("N_CDECL(void, NimMain)(void);$n") - result.appf("#endif /* $1 */$n", guard) - writeRope(result, m.filename) - -proc getCFile(m: BModule): string = - result = changeFileExt(completeCFilePath(m.cfilename), cExt) - -proc myOpenCached(module: PSym, rd: PRodReader): PPassContext = - assert optSymbolFiles in gGlobalOptions - var m = newModule(module) - readMergeInfo(getCFile(m), m) - result = m - -proc myProcess(b: PPassContext, n: PNode): PNode = - result = n - if b == nil or passes.skipCodegen(n): return - var m = BModule(b) - m.initProc.options = gOptions - genStmts(m.initProc, n) - -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(prc.info, "still forwarded: " & prc.name.s) - genProcNoForward(m, prc) - inc(i) - assert(gForwardedProcsCounter >= i) - dec(gForwardedProcsCounter, i) - setlen(m.forwardedProcs, 0) - -proc shouldRecompile(code: PRope, cfile, cfilenoext: string): bool = - result = true - if optForceFullMake notin gGlobalOptions: - var objFile = toObjFile(cfilenoext) - if writeRopeIfNotEqual(code, cfile): return - if ExistsFile(objFile) and os.FileNewer(objFile, cfile): result = false - else: - writeRope(code, cfile) + 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, $1NimMain)(void);$n", [rope m.config.nimMainPrefix]) + if m.config.cppCustomNamespace.len > 0: closeNamespaceNim(result) + result.addf("#endif /* $1 */$n", [guard]) + if not writeRope(result, m.filename): + rawMessage(m.config, errCannotOpenFile, m.filename.string) + +proc getCFile(m: BModule): AbsoluteFile = + let 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 = + injectG() + var m = newModule(g, module, graph.config) + readMergeInfo(getCFile(m), m) + result = m + +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! + 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) + + if m.hcrOn: + addHcrInitGuards(m.initProc, transformedN, m.inHcrInitGuard) + else: + genProcBody(m.initProc, transformedN) + +proc shouldRecompile(m: BModule; code: Rope, cfile: Cfile): bool = + if optForceFullMake notin m.config.globalOptions: + 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.string, cfile.cname.string & ".backup") + echo "diff ", cfile.cname.string, ".backup ", cfile.cname.string + else: + echo "new file ", cfile.cname.string + if not writeRope(code, 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.string) + result = true # We need 2 different logics here: pending modules (including # 'nim__dat') may require file merging for the combination of dead code @@ -1248,86 +2217,144 @@ proc shouldRecompile(code: PRope, cfile, cfilenoext: string): bool = # it would generate multiple 'main' procs, for instance. proc writeModule(m: BModule, pending: bool) = - # generate code for the init statements of the module: - var cfile = getCFile(m) - var cfilenoext = changeFileExt(cfile, "") - - if not m.fromCache or optForceFullMake in gGlobalOptions: + template onExit() = close(m.ndi, m.config) + let cfile = getCFile(m) + if moduleHasChanged(m.g.graph, m.module): genInitCode(m) finishTypeDescriptions(m) - if sfMainModule in m.module.flags: + if sfMainModule in m.module.flags: # generate main file: - app(m.s[cfsProcHeaders], mainModProcs) - GenerateThreadVarsSize(m) - - var code = genModule(m, cfilenoext) + genMainProc(m) + m.s[cfsProcHeaders].add(m.g.mainModProcs) + generateThreadVarsSize(m) + + 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 gCmd == cmdRun: - tccgen.compileCCode(ropeToStr(code)) + if m.config.cmd == cmdTcc: + tccgen.compileCCode($code, m.config) + onExit() return - if shouldRecompile(code, cfile, cfilenoext): - addFileToCompile(cfilenoext) - elif pending and mergeRequired(m) and sfMainModule notin m.module.flags: - mergeFiles(cfile, m) - genInitCode(m) - finishTypeDescriptions(m) - var code = genModule(m, cfilenoext) - writeRope(code, cfile) - addFileToCompile(cfilenoext) - elif not ExistsFile(toObjFile(cfilenoext)): - # 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: - addFileToCompile(cfilenoext) - - addFileToLink(cfilenoext) + if not shouldRecompile(m, code, cf): cf.flags = {CfileFlag.Cached} + addFileToCompile(m.config, cf) + onExit() proc updateCachedModule(m: BModule) = let cfile = getCFile(m) - let cfilenoext = changeFileExt(cfile, "") - - if mergeRequired(m) and sfMainModule notin m.module.flags: - mergeFiles(cfile, m) - genInitCode(m) - finishTypeDescriptions(m) - var code = genModule(m, cfilenoext) - writeRope(code, cfile) - addFileToCompile(cfilenoext) - - addFileToLink(cfilenoext) - -proc myClose(b: PPassContext, n: PNode): PNode = - result = n - if b == nil or passes.skipCodegen(n): return - var m = BModule(b) - if n != nil: - m.initProc.options = gOptions - genStmts(m.initProc, n) - # cached modules need to registered too: - registerModuleToMain(m.module) - - if sfMainModule in m.module.flags: - var disp = generateMethodDispatchers() - for i in 0..sonsLen(disp)-1: genProcAux(m, disp.sons[i].sym) + 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 generateLibraryDestroyGlobals(graph: ModuleGraph; m: BModule; body: PNode; isDynlib: bool): PSym = + let procname = getIdent(graph.cache, "NimDestroyGlobals") + result = newSym(skProc, procname, m.idgen, m.module.owner, m.module.info) + result.typ = newProcType(m.module.info, m.idgen, m.module.owner) + result.typ.callConv = ccCDecl + incl result.flags, sfExportc + result.loc.snippet = "NimDestroyGlobals" + if isDynlib: + incl(result.loc.flags, lfExportLib) + + let theProc = newNodeI(nkProcDef, m.module.info, bodyPos+1) + for i in 0..<theProc.len: theProc[i] = newNodeI(nkEmpty, m.module.info) + theProc[namePos] = newSymNode(result) + theProc[bodyPos] = body + result.ast = theProc + +proc finalCodegenActions*(graph: ModuleGraph; m: BModule; n: PNode) = + ## Also called from IC. + if sfMainModule in m.module.flags: + # phase ordering problem here: We need to announce this + # dependency to 'nimTestErrorFlag' before system.c has been written to disk. + if m.config.exc == excGoto and getCompilerProc(graph, "nimTestErrorFlag") != nil: + 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 -proc cgenWriteModules* = # we need to process the transitive closure because recursive module # deps are allowed (and the system module is processed in the wrong # order anyway) - if generatedHeader != nil: finishModule(generatedHeader) - while gForwardedProcsCounter > 0: - for m in cgenModules(): - if not m.fromCache: - finishModule(m) - for m in cgenModules(): - if m.fromCache: - m.updateCachedModule - else: - m.writeModule(pending=true) - writeMapping(gMapping) - if generatedHeader != nil: writeHeader(generatedHeader) - -const cgenPass* = makePass(myOpen, myOpenCached, myProcess, myClose) + genForwardedProcs(g) + for m in cgenModules(g): + m.writeModule(pending=true) + writeMapping(config, g.mapping) + if g.generatedHeader != nil: writeHeader(g.generatedHeader) diff --git a/compiler/cgendata.nim b/compiler/cgendata.nim index ad17194df..5368e9dc7 100644 --- a/compiler/cgendata.nim +++ b/compiler/cgendata.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -9,65 +9,78 @@ ## This module contains the data structures for the C code generation phase. -import - ast, astalgo, ropes, passes, options, intsets, lists, platform +import + ast, ropes, options, + ndi, lineinfos, pathutils, modulegraphs + +import std/[intsets, tables, sets] type - TLabel* = PRope # for the C generator a label is just a rope + 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 + 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, ctFloat, ctFloat32, ctFloat64, ctFloat128, ctUInt, ctUInt8, ctUInt16, ctUInt32, ctUInt64, - ctArray, ctStruct, ctPtr, ctNimStr, ctNimSeq, ctProc, ctCString - TCFileSections* = array[TCFileSection, PRope] # represents a generated C file + ctArray, ctPtrToArray, ctStruct, ctPtr, ctNimStr, ctNimSeq, ctProc, + ctCString + TCFileSections* = array[TCFileSection, Rope] # represents a generated C file TCProcSection* = enum # the sections a generated C proc consists of cpsLocals, # section of local variables for C proc cpsInit, # section for init of variables for C proc cpsStmts # section of local statements for C proc - TCProcSections* = array[TCProcSection, PRope] # represents a generated C proc + TCProcSections* = array[TCProcSection, Rope] # represents a generated C proc BModule* = ref TCGen BProc* = ref TCProc - TBlock*{.final.} = object + TBlock* = object id*: int # the ID of the label; positive means that it - label*: PRope # generated text for the label + 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 - - TCProc{.final.} = object # represents C proc that is currently generated - prc*: PSym # the Nimrod 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 - nestedTryStmts*: seq[PNode] # in how many nested try statements we are - # (the vars must be volatile then) - inExceptBlock*: int # are we currently inside an except block? - # leaving such scopes by raise or by return must - # execute any applicable finally blocks + + 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 + flags*: set[TCProcFlag] + lastLineInfo*: TLineInfo # to avoid generating excessive 'nimln' statements + currLineInfo*: TLineInfo # AST codegen will make this superfluous + 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 + finallySafePoints*: seq[Rope] # For correctly cleaning up exceptions when + # using return in finally statements labels*: Natural # for generating unique labels in the C proc blocks*: seq[TBlock] # nested blocks breakIdx*: int # the block that will be exited @@ -75,75 +88,131 @@ 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 - gcFrameId*: natural # for the GC stack marking - gcFrameType*: PRope # the struct {} we put the GC markers into - + 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) + withinTryWithExcept*: int # required for goto based exception handling + withinBlockLeaveActions*: int # complex to explain + sigConflicts*: CountTable[string] + inUncheckedAssignSection*: int + TTypeSeq* = seq[PType] - TCGen = object of TPassContext # represents a C source file - module*: PSym - filename*: string + TypeCache* = Table[SigHash, Rope] + TypeCacheWithOwner* = Table[SigHash, tuple[str: Rope, owner: int32]] + + 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 + # a frame var twice in an init proc + 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 + 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 + typeInfoMarker*: TypeCacheWithOwner + typeInfoMarkerV2*: TypeCacheWithOwner + config*: ConfigRef + graph*: ModuleGraph + strVersion*, seqVersion*: int # version of the string/seq implementation to use + + nimtv*: Rope # Nim thread vars; the struct body + nimtvDeps*: seq[PType] # type deps: every module needs whole struct + nimtvDeclared*: IntSet # so that every var/field exists only once + # in the struct + # 'nimtv' is incredibly hard to modularize! Best + # effort is to store all thread vars in a ROD + # section and with their type deps and load them + # unconditionally... + # nimtvDeps is VERY hard to cache because it's + # not a list of IDs nor can it be made to be one. + mangledPrcs*: HashSet[string] + + TCGen = object of PPassContext # represents a C source file s*: TCFileSections # sections of the C file - PreventStackTrace*: bool # true if stack traces need to be prevented - usesThreadVars*: bool # true if the module uses a thread var - FrameDeclared*: bool # hack for ROD support so that we don't declare - # a frame var twice in an init proc - isHeaderFile*: bool # C source file is the header file - cfilename*: string # filename of the module (including path, + flags*: set[CodegenFlag] + module*: PSym + filename*: AbsoluteFile + cfilename*: AbsoluteFile # filename of the module (including path, # without extension) - typeCache*: TIdTable # cache the generated types - forwTypeCache*: TIdTable # cache for forward declarations of types - declaredThings*: TIntSet # things we have declared in this .c file - declaredProtos*: TIntSet # prototypes we have declared in this .c file - headerFiles*: TLinkedList # needed headers to include - typeInfoMarker*: TIntSet # needed for generating type information + 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 preInitProc*: BProc # code executed before the init proc - # used for initialization code for - # .global. variables - # (or instantiated generic variables) + 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*: PRope # used for type info generation - labels*: natural # for generating unique module-scope names - extensionLoaders*: array['0'..'9', PRope] # special procs for the - # OpenGL wrapper - -var - mainModProcs*, mainModInit*, mainDatInit*: PRope # parts of the main module - gMapping*: PRope # the generated mapping file (if requested) - gModules*: seq[BModule] = @[] # list of all compiled modules - gForwardedProcsCounter*: int = 0 - -proc s*(p: BProc, s: TCProcSection): var PRope {.inline.} = + 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 + 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: + this.headerFiles.add header + +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 PRope {.inline.} = +proc procSec*(p: BProc, s: TCProcSection): var Rope {.inline.} = # top level proc sections result = p.blocks[0].sections[s] -proc bmod*(module: PSym): BModule = - # obtains the BModule for a given module PSym - result = gModules[module.position] - -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 = gOptions - newSeq(result.blocks, 1) - result.nestedTryStmts = @[] - -iterator cgenModules*: var BModule = - for i in 0..high(gModules): - # 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 gModules[i] != nil: yield gModules[i] +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 = + result = BProc( + prc: prc, + module: module, + optionsStack: if module.initProc != nil: module.initProc.optionsStack + else: @[], + options: if prc != nil: prc.options + else: module.config.options, + blocks: @[initBlock()], + sigConflicts: initCountTable[string]()) + if optQuirky in result.options: + result.flags = {nimErrorFlagDisabled} + +proc newModuleList*(g: ModuleGraph): BModuleList = + BModuleList(typeInfoMarker: initTable[SigHash, tuple[str: Rope, owner: int32]](), + config: g.config, graph: g, nimtvDeclared: initIntSet()) +iterator cgenModules*(g: BModuleList): BModule = + 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 33bb94b38..ca97d0494 100644 --- a/compiler/cgmeth.nim +++ b/compiler/cgmeth.nim @@ -1,201 +1,308 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2013 Andreas Rumpf # # See the file "copying.txt", included in this # 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 +import + options, ast, msgs, idents, renderer, types, magicsys, + sempass2, modulegraphs, lineinfos, astalgo -proc genConv(n: PNode, d: PType, downcast: bool): PNode = +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) var source = skipTypes(n.typ, abstractPtrs) - if (source.kind == tyObject) and (dest.kind == tyObject): + if (source.kind == tyObject) and (dest.kind == tyObject): var diff = inheritanceDiff(dest, source) - if diff == high(int): InternalError(n.info, "cgmeth.genConv") - if diff < 0: + if diff == high(int): + # no subtype relation, nothing to do + result = n + elif diff < 0: result = newNodeIT(nkObjUpConv, n.info, d) - addSon(result, n) - if downCast: InternalError(n.info, "cgmeth.genConv: no upcast allowed") - elif diff > 0: + 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) - if not downCast: - InternalError(n.info, "cgmeth.genConv: no downcast allowed") - else: + result.add n + if not downcast: + internalError(conf, n.info, "cgmeth.genConv: no downcast allowed") + else: result = n - else: + else: result = n - -proc methodCall*(n: PNode): PNode = + +proc getDispatcher*(s: PSym): PSym = + ## can return nil if is has no dispatcher. + 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: - var disp = lastSon(result.sons[0].sym.ast).sym - assert sfDispatcher in disp.flags - result.sons[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) - -# save for incremental compilation: -var gMethods: seq[TSymSeq] = @[] - -proc sameMethodBucket(a, b: PSym): bool = - result = false - if a.name.id != b.name.id: return - if sonsLen(a.typ) != sonsLen(b.typ): - return # check for return type: - if not sameTypeOrNil(a.typ.sons[0], b.typ.sons[0]): return - for i in countup(1, sonsLen(a.typ) - 1): - var aa = a.typ.sons[i] - var bb = b.typ.sons[i] - while true: - aa = skipTypes(aa, {tyGenericInst}) - bb = skipTypes(bb, {tyGenericInst}) - if (aa.kind == bb.kind) and (aa.kind in {tyVar, tyPtr, tyRef}): - aa = aa.sons[0] - bb = bb.sons[0] - else: - break - if sameType(aa, bb) or - (aa.kind == tyObject) and (bb.kind == tyObject) and - (inheritanceDiff(bb, aa) < 0): - nil + # replace ordinary method by dispatcher method: + let disp = getDispatcher(result[0].sym) + if disp != nil: + result[0].typ = disp.typ + result[0].sym = disp + # change the arguments to up/downcasts to fit the dispatcher's parameters: + for i in 1..<result.len: + result[i] = genConv(result[i], disp.typ[i], true, conf) + else: + localError(conf, n.info, "'" & $result[0] & "' lacks a dispatcher") + +type + MethodResult = enum No, Invalid, Yes + +proc sameMethodBucket(a, b: PSym; multiMethods: bool): MethodResult = + result = No + if a.name.id != b.name.id: return + if a.typ.signatureLen != b.typ.signatureLen: + return + + var i = 0 + for x, y in paramTypePairs(a.typ, b.typ): + inc i + var aa = x + var bb = y + while true: + aa = skipTypes(aa, {tyGenericInst, tyAlias}) + bb = skipTypes(bb, {tyGenericInst, tyAlias}) + if aa.kind == bb.kind and aa.kind in {tyVar, tyPtr, tyRef, tyLent, tySink}: + aa = aa.elementType + bb = bb.elementType + else: + break + if sameType(x, y): + if aa.kind == tyObject and result != Invalid: + result = Yes + elif aa.kind == tyObject and bb.kind == tyObject and (i == 1 or multiMethods): + let diff = inheritanceDiff(bb, aa) + if diff < 0: + if result != Invalid: + result = Yes + else: + return No + elif diff != high(int) and sfFromGeneric notin (a.flags+b.flags): + result = Invalid + else: + return No else: - return - result = true + return No + if result == Yes: + # check for return type: + # 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.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) - -proc methodDef*(s: PSym, fromCache: bool) = - var L = len(gMethods) - for i in countup(0, L - 1): - let disp = gMethods[i][0] - if sameMethodBucket(disp, s): - add(gMethods[i], s) - attachDispatcher(s, lastSon(disp.ast)) - when useEffectSystem: checkMethodEffects(disp, s) - return - add(gMethods, @[s]) + 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; g: ModuleGraph; idgen: IdGenerator): PSym = + var disp = copySym(s, idgen) + incl(disp.flags, sfDispatcher) + excl(disp.flags, sfExported) + 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 = ccNimCall + disp.ast = copyTree(s.ast) + 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.add newNodeI(nkEmpty, s.info) + attachDispatcher(s, newSymNode(disp)) + # attach to itself to prevent bugs: + attachDispatcher(disp, newSymNode(disp)) + return disp + +proc fixupDispatcher(meth, disp: PSym; conf: ConfigRef) = + # We may have constructed the dispatcher from a method prototype + # and need to augment the incomplete dispatcher with information + # 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.len > resultPos and meth.ast.len > resultPos and + disp.ast[resultPos].kind == nkEmpty: + disp.ast[resultPos] = copyTree(meth.ast[resultPos]) + +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") + + for i in 0..<g.methods.len: + let disp = g.methods[i].dispatcher + case sameMethodBucket(disp, s, multimethods = optMultiMethods in g.config.globalOptions) + of Yes: + 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) + if {sfBase, sfFromGeneric} * s.flags == {sfBase} and + g.methods[i].methods[0] != s: + # already exists due to forwarding definition? + localError(g.config, s.info, "method is not a base") + return + of No: discard + of Invalid: + if witness.isNil: witness = g.methods[i].methods[0] # create a new dispatcher: - if not fromCache: - var disp = copySym(s) - incl(disp.flags, sfDispatcher) - excl(disp.flags, sfExported) - disp.typ = copyType(disp.typ, disp.typ.owner, false) - # we can't inline the dispatcher itself (for now): - if disp.typ.callConv == ccInline: disp.typ.callConv = ccDefault - disp.ast = copyTree(s.ast) - disp.ast.sons[bodyPos] = ast.emptyNode - if s.typ.sons[0] != nil: - disp.ast.sons[resultPos].sym = copySym(s.ast.sons[resultPos].sym) - attachDispatcher(s, newSymNode(disp)) - # attach to itself to prevent bugs: - attachDispatcher(disp, newSymNode(disp)) - -proc relevantCol(methods: TSymSeq, col: int): bool = + # stores the id and the position + if s.typ.firstParamType.skipTypes(skipPtrs).itemId notin g.bucketTable: + g.bucketTable[s.typ.firstParamType.skipTypes(skipPtrs).itemId] = 1 + else: + g.bucketTable.inc(s.typ.firstParamType.skipTypes(skipPtrs).itemId) + g.methods.add((methods: @[s], dispatcher: createDispatcher(s, g, idgen))) + #echo "adding ", s.info + if witness != nil: + 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: 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) - if not SameType(t2, t): + 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: TIntSet): int = - for col in countup(1, sonsLen(a.typ) - 1): - if Contains(relevantCols, col): - var aa = skipTypes(a.typ.sons[col], skipPtrs) - var bb = skipTypes(b.typ.sons[col], skipPtrs) + +proc cmpSignatures(a, b: PSym, relevantCols: IntSet): int = + result = 0 + for col in FirstParamAt..<a.typ.signatureLen: + if contains(relevantCols, col): + var aa = skipTypes(a.typ[col], skipPtrs) + var bb = skipTypes(b.typ[col], skipPtrs) var d = inheritanceDiff(aa, bb) - if (d != high(int)): + if (d != high(int)) and d != 0: return d - -proc sortBucket(a: var TSymSeq, relevantCols: TIntSet) = + +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: + while true: h = 3 * h + 1 - if h > N: break - while true: + 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: + while cmpSignatures(a[j - h], v, relevantCols) >= 0: a[j] = a[j - h] j = j - h - if j < h: break + if j < h: break a[j] = v - if h == 1: break - -proc genDispatcher(methods: TSymSeq, relevantCols: TIntSet): PSym = - var base = lastSon(methods[0].ast).sym + if h == 1: break + +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("and") - var iss = getSysSym("of") - for meth in countup(0, high(methods)): + 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[col].sym + if param.typ.skipTypes(abstractInst).kind in {tyRef, tyPtr}: + 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): - if Contains(relevantCols, col): - var isn = newNodeIT(nkCall, base.info, getSysType(tyBool)) - addSon(isn, newSymNode(iss)) - addSon(isn, newSymNode(base.typ.n.sons[col].sym)) - addSon(isn, newNodeIT(nkType, base.info, curr.typ.sons[col])) - if cond != nil: - var a = newNodeIT(nkCall, base.info, getSysType(tyBool)) - addSon(a, newSymNode(ands)) - addSon(a, cond) - addSon(a, isn) + for col in FirstParamAt..<paramLen: + if contains(relevantCols, col): + var isn = newNodeIT(nkCall, base.info, boolType) + 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) + a.add newSymNode(ands) + a.add cond + a.add isn cond = a else: cond = isn - var call = newNodeI(nkCall, base.info) - 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)) + let retTyp = base.typ.returnType + let call = newNodeIT(nkCall, base.info, retTyp) + 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 base.typ.sons[0] != nil: - var a = newNodeI(nkAsgn, base.info) - addSon(a, newSymNode(base.ast.sons[resultPos].sym)) - addSon(a, call) + if retTyp != nil: + var a = newNodeI(nkFastAsgn, base.info) + 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 - result.ast.sons[bodyPos] = disp + nilchecks.add disp + nilchecks.flags.incl nfTransf # should not be further transformed + result.ast[bodyPos] = nilchecks -proc generateMethodDispatchers*(): PNode = - result = newNode(nkStmtList) - for bucket in countup(0, len(gMethods) - 1): +proc generateIfMethodDispatchers*(g: ModuleGraph, idgen: IdGenerator) = + for bucket in 0..<g.methods.len: var relevantCols = initIntSet() - for col in countup(1, sonsLen(gMethods[bucket][0].typ) - 1): - if relevantCol(gMethods[bucket], col): Incl(relevantCols, col) - sortBucket(gMethods[bucket], relevantCols) - addSon(result, newSymNode(genDispatcher(gMethods[bucket], relevantCols))) - + 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) + g.addDispatchers genIfDispatcher(g, g.methods[bucket].methods, relevantCols, idgen) diff --git a/compiler/charsets.nim b/compiler/charsets.nim deleted file mode 100644 index d3d00b687..000000000 --- a/compiler/charsets.nim +++ /dev/null @@ -1,49 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -const - CharSize* = SizeOf(Char) - Lrz* = ' ' - Apo* = '\'' - Tabulator* = '\x09' - ESC* = '\x1B' - CR* = '\x0D' - FF* = '\x0C' - LF* = '\x0A' - BEL* = '\x07' - BACKSPACE* = '\x08' - VT* = '\x0B' - -when defined(macos): - DirSep == ':' - "\n" == CR & "" - FirstNLchar == CR - PathSep == ';' # XXX: is this correct? -else: - when defined(unix): - DirSep == '/' - "\n" == LF & "" - FirstNLchar == LF - PathSep == ':' - else: - # windows, dos - DirSep == '\\' - "\n" == CR + LF - FirstNLchar == CR - DriveSeparator == ':' - PathSep == ';' -UpLetters == {'A'..'Z', '\xC0'..'\xDE'} -DownLetters == {'a'..'z', '\xDF'..'\xFF'} -Numbers == {'0'..'9'} -Letters == UpLetters + DownLetters -type - TCharSet* = set[Char] - PCharSet* = ref TCharSet - -# implementation diff --git a/compiler/closureiters.nim b/compiler/closureiters.nim new file mode 100644 index 000000000..8bdd04ca7 --- /dev/null +++ b/compiler/closureiters.nim @@ -0,0 +1,1618 @@ +# +# +# The Nim Compiler +# (c) Copyright 2018 Nim Contributors +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +# This file implements closure iterator transformations. +# The main idea is to split the closure iterator body to top level statements. +# The body is split by yield statement. +# +# Example: +# while a > 0: +# echo "hi" +# yield a +# dec a +# +# Should be transformed to: +# case :state +# of 0: +# if a > 0: +# echo "hi" +# :state = 1 # Next state +# return a # yield +# else: +# :state = 2 # Next state +# break :stateLoop # Proceed to the next state +# of 1: +# dec a +# :state = 0 # Next state +# break :stateLoop # Proceed to the next state +# of 2: +# :state = -1 # End of execution +# 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. + +# One special subtransformation is nkStmtListExpr lowering. +# Example: +# template foo(): int = +# yield 1 +# 2 +# +# iterator it(): int {.closure.} = +# if foo() == 2: +# yield 3 +# +# If a nkStmtListExpr has yield inside, it has first to be lowered to: +# yield 1 +# :tmpSlLower = 2 +# if :tmpSlLower == 2: +# yield 3 + +# nkTryStmt Transformations: +# If the iter has an nkTryStmt with a yield inside +# - the closure iter is promoted to have exceptions (ctx.hasExceptions = true) +# - exception table is created. This is a const array, where +# `abs(exceptionTable[i])` is a state idx to which we should jump from state +# `i` should exception be raised in state `i`. For all states in `try` block +# the target state is `except` block. For all states in `except` block +# the target state is `finally` block. For all other states there is no +# target state (0, as the first block can never be neither except nor finally). +# `exceptionTable[i]` is < 0 if `abs(exceptionTable[i])` is except block, +# and > 0, for finally block. +# - local variable :curExc is created +# - the iter body is wrapped into a +# try: +# closureIterSetupExc(:curExc) +# ...body... +# catch: +# :state = exceptionTable[:state] +# if :state == 0: raise # No state that could handle exception +# :unrollFinally = :state > 0 # Target state is finally +# if :state < 0: +# :state = -:state +# :curExc = getCurrentException() +# +# nkReturnStmt within a try/except/finally now has to behave differently as we +# want the nearest finally block to be executed before the return, thus it is +# transformed to: +# :tmpResult = returnValue (if return doesn't have a value, this is skipped) +# :unrollFinally = true +# goto nearestFinally (or -1 if not exists) +# +# Example: +# +# try: +# yield 0 +# raise ... +# except: +# yield 1 +# return 3 +# finally: +# yield 2 +# +# Is transformed to (yields are left in place for example simplicity, +# in reality the code is subdivided even more, as described above): +# +# case :state +# of 0: # Try +# yield 0 +# raise ... +# :state = 2 # What would happen should we not raise +# break :stateLoop +# of 1: # Except +# yield 1 +# :tmpResult = 3 # Return +# :unrollFinally = true # Return +# :state = 2 # Goto Finally +# break :stateLoop +# :state = 2 # What would happen should we not return +# break :stateLoop +# of 2: # Finally +# yield 2 +# if :unrollFinally: # This node is created by `newEndFinallyNode` +# if :curExc.isNil: +# if nearestFinally == 0: +# return :tmpResult +# else: +# :state = nearestFinally # bubble up +# else: +# closureIterSetupExc(nil) +# raise +# state = -1 # Goto next state. In this case we just exit +# break :stateLoop +# else: +# return + +import + ast, msgs, idents, + renderer, magicsys, lowerings, lambdalifting, modulegraphs, lineinfos, + options + +import std/tables + +when defined(nimPreviewSlimSystem): + import std/assertions + +type + Ctx = object + g: ModuleGraph + fn: PSym + 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[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 + tempVarId: int # unique name counter + tempVars: PNode # Temp var decls, nkVarSection + exceptionTable: seq[int] # For state `i` jump to state `exceptionTable[i]` if exception is raised + hasExceptions: bool # Does closure have yield in try? + 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, 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) + else: + result = newSymNode(ctx.stateVarSym) + +proc newStateAssgn(ctx: var Ctx, toValue: PNode): PNode = + # Creates state assignment: + # :state = toValue + newTree(nkAsgn, ctx.newStateAccess(), toValue) + +proc newStateAssgn(ctx: var Ctx, stateNo: int = -2): PNode = + # Creates state assignment: + # :state = stateNo + 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.idgen, ctx.fn, ctx.fn.info) + result.typ = typ + 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, + # it will be lifted later + if ctx.tempVars.isNil: + ctx.tempVars = newNodeI(nkVarSection, ctx.fn.info) + addVar(ctx.tempVars, newSymNode(result)) + else: + let envParam = getEnvParam(ctx.fn) + # let obj = envParam.typ.lastSon + result = addUniqueField(envParam.typ.elementType, result, ctx.g.cache, ctx.idgen) + +proc newEnvVarAccess(ctx: Ctx, s: PSym): PNode = + if ctx.stateVarSym.isNil: + result = rawIndirectAccess(newSymNode(getEnvParam(ctx.fn)), s, ctx.fn.info) + 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.returnType) + ctx.newEnvVarAccess(ctx.tmpResultSym) + +proc newUnrollFinallyAccess(ctx: var Ctx, info: TLineInfo): PNode = + if ctx.unrollFinallySym.isNil: + ctx.unrollFinallySym = ctx.newEnvVar(":unrollFinally", ctx.g.getSysType(info, tyBool)) + ctx.newEnvVarAccess(ctx.unrollFinallySym) + +proc newCurExcAccess(ctx: var Ctx): PNode = + if ctx.curExcSym.isNil: + ctx.curExcSym = ctx.newEnvVar(":curExc", ctx.g.callCodegenProc("getCurrentException").typ) + ctx.newEnvVarAccess(ctx.curExcSym) + +proc newState(ctx: var Ctx, n, gotoOut: PNode): int = + # Creates a new state, adds it to the context fills out `gotoOut` so that it + # will goto this state. + # Returns index of the newly created state + + result = ctx.states.len + let resLit = ctx.g.newIntLit(n.info, result) + ctx.states.add((result, n)) + ctx.exceptionTable.add(ctx.curExcHandlingState) + + if not gotoOut.isNil: + assert(gotoOut.len == 0) + gotoOut.add(ctx.g.newIntLit(gotoOut.info, result)) + +proc toStmtList(n: PNode): PNode = + result = n + if result.kind notin {nkStmtList, nkStmtListExpr}: + result = newNodeI(nkStmtList, n.info) + result.add(n) + +proc addGotoOut(n: PNode, gotoOut: PNode): PNode = + # Make sure `n` is a stmtlist, and ends with `gotoOut` + result = toStmtList(n) + if result.len == 0 or result[^1].kind != nkGotoState: + result.add(gotoOut) + +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. + case n.kind + of nkYieldStmt: + result = true + of nkSkip: + result = false + else: + result = false + for i in ord(n.kind == nkCast)..<n.len: + if n[i].hasYields: + result = true + break + +proc transformBreaksAndContinuesInWhile(ctx: var Ctx, n: PNode, before, after: PNode): PNode = + result = n + case n.kind + of nkSkip: + discard + of nkWhileStmt: discard # Do not recurse into nested whiles + of nkContinueStmt: + result = before + of nkBlockStmt: + inc ctx.blockLevel + result[1] = ctx.transformBreaksAndContinuesInWhile(result[1], before, after) + dec ctx.blockLevel + of nkBreakStmt: + if ctx.blockLevel == 0: + result = after + else: + 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 = + result = n + case n.kind + of nkSkip: + discard + of nkBlockStmt, nkWhileStmt: + inc ctx.blockLevel + result[1] = ctx.transformBreaksInBlock(result[1], label, after) + dec ctx.blockLevel + of nkBreakStmt: + if n[0].kind == nkEmpty: + if ctx.blockLevel == 0: + result = after + else: + if label.kind == nkSym and n[0].sym == label.sym: + result = after + else: + for i in 0..<n.len: + n[i] = ctx.transformBreaksInBlock(n[i], label, after) + +proc newNullifyCurExc(ctx: var Ctx, info: TLineInfo): PNode = + # :curEcx = nil + let curExc = ctx.newCurExcAccess() + curExc.info = info + let nilnode = newNode(nkNilLit) + nilnode.typ = curExc.typ + result = newTree(nkAsgn, curExc, nilnode) + +proc newOr(g: ModuleGraph, a, b: PNode): PNode {.inline.} = + result = newTree(nkCall, newSymNode(g.getSysMagic(a.info, "or", mOr)), a, b) + result.typ = g.getSysType(a.info, tyBool) + result.info = a.info + +proc collectExceptState(ctx: var Ctx, n: PNode): PNode {.inline.} = + var ifStmt = newNodeI(nkIfStmt, n.info) + let g = ctx.g + for c in n: + if c.kind == nkExceptBranch: + var ifBranch: PNode + + if c.len > 1: + 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"), + c[i]) + nextCond.typ = ctx.g.getSysType(c.info, tyBool) + nextCond.info = c.info + + if cond.isNil: + cond = nextCond + else: + cond = g.newOr(cond, nextCond) + + ifBranch = newNodeI(nkElifBranch, c.info) + ifBranch.add(cond) + else: + if ifStmt.len == 0: + ifStmt = newNodeI(nkStmtList, c.info) + ifBranch = newNodeI(nkStmtList, c.info) + else: + ifBranch = newNodeI(nkElse, c.info) + + ifBranch.add(c[^1]) + ifStmt.add(ifBranch) + + if ifStmt.len != 0: + result = newTree(nkStmtList, ctx.newNullifyCurExc(n.info), ifStmt) + else: + result = ctx.g.emptyNode + +proc addElseToExcept(ctx: var Ctx, n: PNode) = + if n.kind == nkStmtList and n[1].kind == nkIfStmt and n[1][^1].kind != nkElse: + # Not all cases are covered + let branchBody = newNodeI(nkStmtList, n.info) + + block: # :unrollFinally = true + branchBody.add(newTree(nkAsgn, + ctx.newUnrollFinallyAccess(n.info), + newIntTypeNode(1, ctx.g.getSysType(n.info, tyBool)))) + + block: # :curExc = getCurrentException() + branchBody.add(newTree(nkAsgn, + ctx.newCurExcAccess(), + ctx.g.callCodegenProc("getCurrentException"))) + + block: # goto nearestFinally + branchBody.add(newTree(nkGotoState, ctx.g.newIntLit(n.info, ctx.nearestFinally))) + + let elseBranch = newTree(nkElse, branchBody) + n[1].add(elseBranch) + +proc getFinallyNode(ctx: var Ctx, n: PNode): PNode = + result = n[^1] + if result.kind == nkFinally: + result = result[0] + else: + result = ctx.g.emptyNode + +proc hasYieldsInExpressions(n: PNode): bool = + case n.kind + of nkSkip: + 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 = (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.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 = + # 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) + input = res + if ctx.nimOptItersEnabled: + output.add(ctx.newTempVarAsgn(sym, input)) + else: + output.add(ctx.newEnvVarAsgn(sym, input)) + +proc convertExprBodyToAsgn(ctx: Ctx, exprBody: PNode, res: PSym): PNode = + result = newNodeI(nkStmtList, exprBody.info) + ctx.addExprAssgn(result, exprBody, res) + +proc newNotCall(g: ModuleGraph; e: PNode): PNode = + result = newTree(nkCall, newSymNode(g.getSysMagic(e.info, "not", mNot), e.info), e) + result.typ = g.getSysType(e.info, tyBool) + +proc boolLit(g: ModuleGraph; info: TLineInfo; value: bool): PNode = + result = newIntLit(g, info, ord value) + result.typ = getSysType(g, info, tyBool) + +proc captureVar(c: var Ctx, s: PSym) = + if c.varStates.getOrDefault(s.itemId) != localRequiresLifting: + c.varStates[s.itemId] = localRequiresLifting # Mark this variable for lifting + let e = getEnvParam(c.fn) + discard addField(e.typ.elementType, s, c.g.cache, c.idgen) + +proc lowerStmtListExprs(ctx: var Ctx, n: PNode, needsSplit: var bool): PNode = + result = n + case n.kind + of nkSkip: + discard + + of nkYieldStmt: + var ns = false + for i in 0..<n.len: + n[i] = ctx.lowerStmtListExprs(n[i], ns) + + if ns: + result = newNodeI(nkStmtList, n.info) + let (st, ex) = exprToStmtList(n[0]) + result.add(st) + n[0] = ex + result.add(n) + + needsSplit = true + + of nkPar, nkObjConstr, nkTupleConstr, nkBracket: + var ns = false + for i in 0..<n.len: + n[i] = ctx.lowerStmtListExprs(n[i], ns) + + if ns: + needsSplit = true + + result = newNodeI(nkStmtListExpr, n.info) + if n.typ.isNil: internalError(ctx.g.config, "lowerStmtListExprs: constr typ.isNil") + result.typ = n.typ + + 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: + n[i] = ctx.lowerStmtListExprs(n[i], ns) + + if ns: + needsSplit = true + var tmp: PSym = nil + let isExpr = not isEmptyType(n.typ) + if isExpr: + result = newNodeI(nkStmtListExpr, n.info) + result.typ = n.typ + tmp = ctx.newTempVar(n.typ, result) + else: + result = newNodeI(nkStmtList, n.info) + + var curS = result + + for branch in n: + case branch.kind + of nkElseExpr, nkElse: + if isExpr: + let branchBody = newNodeI(nkStmtList, branch.info) + ctx.addExprAssgn(branchBody, branch[0], tmp) + let newBranch = newTree(nkElse, branchBody) + curS.add(newBranch) + else: + curS.add(branch) + + of nkElifExpr, nkElifBranch: + var newBranch: PNode + if branch[0].kind == nkStmtListExpr: + let (st, res) = exprToStmtList(branch[0]) + let elseBody = newTree(nkStmtList, st) + + newBranch = newTree(nkElifBranch, res, branch[1]) + + let newIf = newTree(nkIfStmt, newBranch) + elseBody.add(newIf) + if curS.kind == nkIfStmt: + let newElse = newNodeI(nkElse, branch.info) + newElse.add(elseBody) + curS.add(newElse) + else: + curS.add(elseBody) + curS = newIf + else: + newBranch = branch + if curS.kind == nkIfStmt: + curS.add(newBranch) + else: + let newIf = newTree(nkIfStmt, newBranch) + curS.add(newIf) + curS = newIf + + if isExpr: + let branchBody = newNodeI(nkStmtList, branch[1].info) + ctx.addExprAssgn(branchBody, branch[1], tmp) + newBranch[1] = branchBody + + else: + internalError(ctx.g.config, "lowerStmtListExpr(nkIf): " & $branch.kind) + + if isExpr: + if ctx.nimOptItersEnabled: + result.add(ctx.newTempVarAccess(tmp)) + else: + result.add(ctx.newEnvVarAccess(tmp)) + + of nkTryStmt, nkHiddenTryStmt: + var ns = false + for i in 0..<n.len: + n[i] = ctx.lowerStmtListExprs(n[i], ns) + + if ns: + needsSplit = true + let isExpr = not isEmptyType(n.typ) + + if isExpr: + result = newNodeI(nkStmtListExpr, n.info) + result.typ = n.typ + let tmp = ctx.newTempVar(n.typ, result) + + n[0] = ctx.convertExprBodyToAsgn(n[0], tmp) + for i in 1..<n.len: + let branch = n[i] + case branch.kind + of nkExceptBranch: + if branch[0].kind == nkType: + branch[1] = ctx.convertExprBodyToAsgn(branch[1], tmp) + else: + branch[0] = ctx.convertExprBodyToAsgn(branch[0], tmp) + of nkFinally: + discard + else: + internalError(ctx.g.config, "lowerStmtListExpr(nkTryStmt): " & $branch.kind) + result.add(n) + 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: + n[i] = ctx.lowerStmtListExprs(n[i], ns) + + if ns: + needsSplit = true + + let isExpr = not isEmptyType(n.typ) + + if isExpr: + 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: + let branch = n[i] + case branch.kind + of nkOfBranch: + 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) + if ctx.nimOptItersEnabled: + result.add(ctx.newTempVarAccess(tmp)) + else: + result.add(ctx.newEnvVarAccess(tmp)) + elif n[0].kind == nkStmtListExpr: + result = newNodeI(nkStmtList, n.info) + let (st, ex) = exprToStmtList(n[0]) + result.add(st) + n[0] = ex + result.add(n) + + of nkCallKinds, nkChckRange, nkChckRangeF, nkChckRange64: + var ns = false + for i in 0..<n.len: + n[i] = ctx.lowerStmtListExprs(n[i], ns) + + if ns: + needsSplit = true + let isExpr = not isEmptyType(n.typ) + + if isExpr: + result = newNodeI(nkStmtListExpr, n.info) + result.typ = n.typ + else: + result = newNodeI(nkStmtList, n.info) + + if n[0].kind == nkSym and n[0].sym.magic in {mAnd, mOr}: # `and`/`or` short cirquiting + var cond = n[1] + if cond.kind == nkStmtListExpr: + let (st, ex) = exprToStmtList(cond) + result.add(st) + cond = ex + + let tmp = ctx.newTempVar(cond.typ, result, cond) + # result.add(ctx.newTempVarAsgn(tmp, cond)) + + 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) + + cond = n[2] + let ifBody = newNodeI(nkStmtList, cond.info) + if cond.kind == nkStmtListExpr: + let (st, ex) = exprToStmtList(cond) + ifBody.add(st) + cond = ex + 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) + if ctx.nimOptItersEnabled: + result.add(ctx.newTempVarAccess(tmp)) + else: + result.add(ctx.newEnvVarAccess(tmp)) + else: + for i in 0..<n.len: + if n[i].kind == nkStmtListExpr: + 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, 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) + + of nkVarSection, nkLetSection: + result = newNodeI(nkStmtList, n.info) + for c in n: + let varSect = newNodeI(n.kind, n.info) + varSect.add(c) + var ns = false + c[^1] = ctx.lowerStmtListExprs(c[^1], ns) + if ns: + needsSplit = true + 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: + n[i] = ctx.lowerStmtListExprs(n[i], ns) + + if ns: + needsSplit = true + result = newNodeI(nkStmtList, n.info) + let (st, ex) = exprToStmtList(n[0]) + result.add(st) + n[0] = ex + result.add(n) + + of nkCast, nkHiddenStdConv, nkHiddenSubConv, nkConv, nkObjDownConv, + nkDerefExpr, nkHiddenDeref: + var ns = false + 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]) + result.add(st) + n[^1] = ex + result.add(n) + + of nkAsgn, nkFastAsgn, nkSinkAsgn: + var ns = false + for i in 0..<n.len: + n[i] = ctx.lowerStmtListExprs(n[i], ns) + + if ns: + needsSplit = true + result = newNodeI(nkStmtList, n.info) + if n[0].kind == nkStmtListExpr: + let (st, ex) = exprToStmtList(n[0]) + result.add(st) + n[0] = ex + + if n[1].kind == nkStmtListExpr: + let (st, ex) = exprToStmtList(n[1]) + result.add(st) + n[1] = ex + + result.add(n) + + 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 + n[1] = ctx.lowerStmtListExprs(n[1], bodyNeedsSplit) + + if condNeedsSplit or bodyNeedsSplit: + needsSplit = true + + if condNeedsSplit: + let (st, ex) = exprToStmtList(n[0]) + let brk = newTree(nkBreakStmt, ctx.g.emptyNode) + let branch = newTree(nkElifBranch, ctx.g.newNotCall(ex), brk) + let check = newTree(nkIfStmt, branch) + let newBody = newTree(nkStmtList, st, check, n[1]) + + n[0] = ctx.g.boolLit(n[0].info, true) + n[1] = newBody + + of nkDotExpr, nkCheckedFieldExpr: + var ns = false + n[0] = ctx.lowerStmtListExprs(n[0], ns) + if ns: + needsSplit = true + result = newNodeI(nkStmtListExpr, n.info) + result.typ = n.typ + let (st, ex) = exprToStmtList(n[0]) + result.add(st) + n[0] = ex + result.add(n) + + of nkBlockExpr: + var ns = false + n[1] = ctx.lowerStmtListExprs(n[1], ns) + if ns: + needsSplit = true + result = newNodeI(nkStmtListExpr, n.info) + result.typ = n.typ + let (st, ex) = exprToStmtList(n[1]) + n.transitionSonsKind(nkBlockStmt) + n.typ = nil + n[1] = st + result.add(n) + result.add(ex) + + else: + 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: + # if nearestFinally == 0: + # return :tmpResult + # else: + # :state = nearestFinally # bubble up + # else: + # raise + let curExc = ctx.newCurExcAccess() + let nilnode = newNode(nkNilLit) + nilnode.typ = curExc.typ + let cmp = newTree(nkCall, newSymNode(ctx.g.getSysMagic(info, "==", mEqRef), info), curExc, nilnode) + cmp.typ = ctx.g.getSysType(info, tyBool) + + 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 branch = newTree(nkElifBranch, cmp, retStmt) + + 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, newTree(nkStmtList, nullifyExc, raiseStmt)) + + let ifBody = newTree(nkIfStmt, branch, elseBranch) + let elifBranch = newTree(nkElifBranch, ctx.newUnrollFinallyAccess(info), ifBody) + elifBranch.info = info + result = newTree(nkIfStmt, elifBranch) + +proc transformReturnsInTry(ctx: var Ctx, n: PNode): PNode = + result = n + # TODO: This is very inefficient. It traverses the node, looking for nkYieldStmt. + case n.kind + of nkReturnStmt: + # We're somewhere in try, transform to finally unrolling + 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(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()) + 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)) + + let goto = newTree(nkGotoState, ctx.g.newIntLit(n.info, ctx.nearestFinally)) + result.add(goto) + + of nkSkip: + discard + of nkTryStmt: + if n.hasYields: + # the inner try will handle these transformations + discard + else: + for i in 0..<n.len: + n[i] = ctx.transformReturnsInTry(n[i]) + else: + for i in 0..<n.len: + n[i] = ctx.transformReturnsInTry(n[i]) + +proc transformClosureIteratorBody(ctx: var Ctx, n: PNode, gotoOut: PNode): PNode = + result = n + case n.kind + of nkSkip: discard + + 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 + + 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) + + 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, 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 + + let outToFinally = newNodeI(nkGotoState, finallyBody.info) + + 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 + let realExceptIdx = ctx.newState(exceptBody, nil) + assert(realExceptIdx == -exceptIdx) + + ctx.curExcHandlingState = oldExcHandlingState + let realFinallyIdx = ctx.newState(finallyBody, outToFinally) + assert(realFinallyIdx == finallyIdx) + + block: # Subdivide the states + let oldNearestFinally = ctx.nearestFinally + ctx.nearestFinally = finallyIdx + + 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 transformStateAssignments(ctx: var Ctx, n: PNode): PNode = + # This transforms 3 patterns: + ########################## 1 + # yield e + # goto STATE + # -> + # :state = STATE + # return e + ########################## 2 + # goto STATE + # -> + # :state = STATE + # break :stateLoop + ########################## 3 + # return e + # -> + # :state = -1 + # return e + # + result = n + case n.kind + of nkStmtList, nkStmtListExpr: + if n.len != 0 and n[0].kind == nkYieldStmt: + assert(n.len == 2) + assert(n[1].kind == nkGotoState) + + result = newNodeI(nkStmtList, n.info) + result.add(ctx.newStateAssgn(stateFromGotoState(n[1]))) + + var retStmt = newNodeI(nkReturnStmt, n.info) + 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.transformStateAssignments(n[i]) + + of nkSkip: + discard + + of nkReturnStmt: + result = newNodeI(nkStmtList, n.info) + result.add(ctx.newStateAssgn(-1)) + result.add(n) + + of nkGotoState: + result = newNodeI(nkStmtList, n.info) + result.add(ctx.newStateAssgn(stateFromGotoState(n))) + + let breakState = newNodeI(nkBreakStmt, n.info) + breakState.add(newSymNode(ctx.stateLoopLabel)) + result.add(breakState) + + else: + for i in 0..<n.len: + n[i] = ctx.transformStateAssignments(n[i]) + +proc skipStmtList(ctx: Ctx; n: PNode): PNode = + result = n + while result.kind in {nkStmtList}: + if result.len == 0: return ctx.g.emptyNode + result = result[0] + +proc skipEmptyStates(ctx: Ctx, stateIdx: int): int = + # Returns first non-empty state idx for `stateIdx`. Returns `stateIdx` if + # it is not empty + var maxJumps = ctx.states.len # maxJumps used only for debugging purposes. + var stateIdx = stateIdx + while true: + let label = stateIdx + if label == ctx.exitStateIdx: break + var newLabel = label + if label == emptyStateLabel: + newLabel = ctx.exitStateIdx + else: + let fs = skipStmtList(ctx, ctx.states[label].body) + if fs.kind == nkGotoState: + newLabel = fs[0].intVal.int + if label == newLabel: break + stateIdx = newLabel + dec maxJumps + if maxJumps == 0: + assert(false, "Internal error") + + result = ctx.states[stateIdx].label + +proc skipThroughEmptyStates(ctx: var Ctx, n: PNode): PNode= + result = n + case n.kind + of nkSkip: + discard + of nkGotoState: + result = copyTree(n) + result[0].intVal = ctx.skipEmptyStates(result[0].intVal.int) + else: + for i in 0..<n.len: + n[i] = ctx.skipThroughEmptyStates(n[i]) + +proc newArrayType(g: ModuleGraph; n: int, t: PType; idgen: IdGenerator; owner: PSym): PType = + result = newType(tyArray, idgen, owner) + + 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) + result.rawAddSon(t) + +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.idgen, ctx.fn) + + for i in ctx.exceptionTable: + let elem = newIntNode(nkIntLit, i) + elem.typ = ctx.g.getSysType(ctx.fn.info, tyInt16) + result.add(elem) + +proc newCatchBody(ctx: var Ctx, info: TLineInfo): PNode {.inline.} = + # Generates the code: + # :state = exceptionTable[:state] + # if :state == 0: raise + # :unrollFinally = :state > 0 + # if :state < 0: + # :state = -:state + # :curExc = getCurrentException() + + result = newNodeI(nkStmtList, info) + + let intTyp = ctx.g.getSysType(info, tyInt) + let boolTyp = ctx.g.getSysType(info, tyBool) + + # :state = exceptionTable[:state] + block: + # exceptionTable[:state] + let getNextState = newTree(nkBracketExpr, + ctx.createExceptionTable(), + ctx.newStateAccess()) + getNextState.typ = intTyp + + # :state = exceptionTable[:state] + result.add(ctx.newStateAssgn(getNextState)) + + # if :state == 0: raise + block: + let cond = newTree(nkCall, + ctx.g.getSysMagic(info, "==", mEqI).newSymNode(), + ctx.newStateAccess(), + newIntTypeNode(0, intTyp)) + cond.typ = boolTyp + + let raiseStmt = newTree(nkRaiseStmt, ctx.g.emptyNode) + let ifBranch = newTree(nkElifBranch, cond, raiseStmt) + let ifStmt = newTree(nkIfStmt, ifBranch) + result.add(ifStmt) + + # :unrollFinally = :state > 0 + block: + let cond = newTree(nkCall, + ctx.g.getSysMagic(info, "<", mLtI).newSymNode, + newIntTypeNode(0, intTyp), + ctx.newStateAccess()) + cond.typ = boolTyp + + let asgn = newTree(nkAsgn, ctx.newUnrollFinallyAccess(info), cond) + result.add(asgn) + + # if :state < 0: :state = -:state + block: + let cond = newTree(nkCall, + ctx.g.getSysMagic(info, "<", mLtI).newSymNode, + ctx.newStateAccess(), + newIntTypeNode(0, intTyp)) + cond.typ = boolTyp + + let negateState = newTree(nkCall, + ctx.g.getSysMagic(info, "-", mUnaryMinusI).newSymNode, + ctx.newStateAccess()) + negateState.typ = intTyp + + let ifBranch = newTree(nkElifBranch, cond, ctx.newStateAssgn(negateState)) + let ifStmt = newTree(nkIfStmt, ifBranch) + result.add(ifStmt) + + # :curExc = getCurrentException() + block: + result.add(newTree(nkAsgn, + ctx.newCurExcAccess(), + ctx.g.callCodegenProc("getCurrentException"))) + +proc wrapIntoTryExcept(ctx: var Ctx, n: PNode): PNode {.inline.} = + let setupExc = newTree(nkCall, + newSymNode(ctx.g.getCompilerProc("closureIterSetupExc")), + ctx.newCurExcAccess()) + + let tryBody = newTree(nkStmtList, setupExc, n) + let exceptBranch = newTree(nkExceptBranch, ctx.newCatchBody(ctx.fn.info)) + + result = newTree(nkTryStmt, tryBody, exceptBranch) + +proc wrapIntoStateLoop(ctx: var Ctx, n: PNode): PNode = + # while true: + # block :stateLoop: + # local vars decl (if needed) + # body # Might get wrapped in try-except + let loopBody = newNodeI(nkStmtList, n.info) + 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)) + localVars.add(varSect) + + if not ctx.tempVars.isNil: + localVars.add(ctx.tempVars) + + let blockStmt = newNodeI(nkBlockStmt, n.info) + blockStmt.add(newSymNode(ctx.stateLoopLabel)) + + var blockBody = newTree(nkStmtList, localVars, n) + if ctx.hasExceptions: + blockBody = ctx.wrapIntoTryExcept(blockBody) + + blockStmt.add(blockBody) + loopBody.add(blockStmt) + +proc deleteEmptyStates(ctx: var Ctx) = + let goOut = newTree(nkGotoState, ctx.g.newIntLit(TLineInfo(), -1)) + ctx.exitStateIdx = ctx.newState(goOut, nil) + + # Apply new state indexes and mark unused states with -1 + var iValid = 0 + 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.label = emptyStateLabel + else: + s.label = iValid + inc iValid + + for i, s in ctx.states: + let body = skipStmtList(ctx, s.body) + if body.kind != nkGotoState or i == 0: + 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 = 1 # ignore the entry and the exit + while i < ctx.states.len - 1: + if ctx.states[i].label == emptyStateLabel: + ctx.states.delete(i) + ctx.exceptionTable.delete(i) + else: + inc i + +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] + + 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. + + 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() + + 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: + 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) + + when false: + echo "TRANSFORM TO STATES: " + echo renderTree(result) + + 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 ca0c309bd..cbf915ca6 100644 --- a/compiler/commands.nim +++ b/compiler/commands.nim @@ -1,7 +1,7 @@ # # -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -9,514 +9,1191 @@ # This module handles the parsing of command line arguments. -import - os, msgs, options, nversion, condsyms, strutils, extccomp, platform, lists, - wordrecg, parseutils, babelcmd +# We do this here before the 'import' statement so 'defined' does not get +# 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: "" -proc writeCommandLineUsage*() +bootSwitch(usedRelease, defined(release), "-d:release") +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(usedGoGC, defined(gogc), "--gc:go") +bootSwitch(usedNoGC, defined(nogc), "--gc:none") -type - TCmdLinePass* = enum +import std/[setutils, os, strutils, parseutils, parseopt, sequtils, strtabs, enumutils] +import + 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(usedFFI, hasFFI, "-d:nimHasLibFFI") + +type + TCmdLinePass* = enum passCmd1, # first pass over the command line passCmd2, # second pass over the command line - passPP # preprocessor called ProcessCommand() + passPP # preprocessor called processCommand() -proc ProcessCommand*(switch: string, pass: TCmdLinePass) -proc processSwitch*(switch, arg: string, pass: TCmdlinePass, info: TLineInfo) +const + HelpMessage = "Nim Compiler Version $1 [$2: $3]\n" & + "Compiled at $4\n" & + "Copyright (c) 2006-" & copyrightYear & " by Andreas Rumpf\n" -# implementation +proc genFeatureDesc[T: enum](t: typedesc[T]): string {.compileTime.} = + result = "" + for f in T: + if result.len > 0: result.add "|" + result.add $f const - HelpMessage = "Nimrod Compiler Version $1 (" & compileDate & ") [$2: $3]\n" & - "Copyright (c) 2004-2013 by Andreas Rumpf\n" + Usage = slurp"../doc/basicopt.txt".replace(" //", " ") + AdvancedUsage = slurp"../doc/advopt.txt".replace(" //", " ") % [genFeatureDesc(Feature), genFeatureDesc(LegacyFeature)] -const - Usage = slurp"doc/basicopt.txt".replace("//", "") - AdvancedUsage = slurp"doc/advopt.txt".replace("//", "") +proc getCommandLineDesc(conf: ConfigRef): string = + result = (HelpMessage % [VersionAsString, platform.OS[conf.target.hostOS].name, + CPU[conf.target.hostCPU].name, CompileDate]) & + Usage -proc getCommandLineDesc(): string = - result = (HelpMessage % [VersionAsString, platform.os[platform.hostOS].name, - cpu[platform.hostCPU].name]) & Usage +proc helpOnError(conf: ConfigRef; pass: TCmdLinePass) = + if pass == passCmd1: + msgWriteln(conf, getCommandLineDesc(conf), {msgStdout}) + msgQuit(0) -proc HelpOnError(pass: TCmdLinePass) = +proc writeAdvancedUsage(conf: ConfigRef; pass: TCmdLinePass) = if pass == passCmd1: - MsgWriteln(getCommandLineDesc()) - quit(0) + msgWriteln(conf, (HelpMessage % [VersionAsString, + platform.OS[conf.target.hostOS].name, + CPU[conf.target.hostCPU].name, CompileDate]) & + AdvancedUsage, + {msgStdout}) + msgQuit(0) -proc writeAdvancedUsage(pass: TCmdLinePass) = +proc writeFullhelp(conf: ConfigRef; pass: TCmdLinePass) = if pass == passCmd1: - MsgWriteln(`%`(HelpMessage, [VersionAsString, - platform.os[platform.hostOS].name, - cpu[platform.hostCPU].name]) & AdvancedUsage) - quit(0) + msgWriteln(conf, `%`(HelpMessage, [VersionAsString, + platform.OS[conf.target.hostOS].name, + CPU[conf.target.hostCPU].name, CompileDate]) & + Usage & AdvancedUsage, + {msgStdout}) + msgQuit(0) -proc writeVersionInfo(pass: TCmdLinePass) = +proc writeVersionInfo(conf: ConfigRef; pass: TCmdLinePass) = if pass == passCmd1: - MsgWriteln(`%`(HelpMessage, [VersionAsString, - platform.os[platform.hostOS].name, - cpu[platform.hostCPU].name])) - quit(0) + msgWriteln(conf, `%`(HelpMessage, [VersionAsString, + platform.OS[conf.target.hostOS].name, + CPU[conf.target.hostCPU].name, CompileDate]), + {msgStdout}) + + 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}) -var - helpWritten: bool + msgWriteln(conf, "active boot switches:" & usedRelease & usedDanger & + usedTinyC & useLinenoise & + usedFFI & usedBoehm & usedMarkAndSweep & usedGoGC & usedNoGC, + {msgStdout}) + msgQuit(0) -proc writeCommandLineUsage() = - if not helpWritten: - MsgWriteln(getCommandLineDesc()) - 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 -proc InvalidCmdLineOption(pass: TCmdLinePass, switch: string, info: TLineInfo) = - if switch == " ": LocalError(info, errInvalidCmdLineOption, "-") - else: LocalError(info, errInvalidCmdLineOption, addPrefix(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 % "-") + else: localError(conf, info, errInvalidCmdLineOption % addPrefix(switch)) -proc splitSwitch(switch: string, cmd, arg: var string, pass: TCmdLinePass, - info: TLineInfo) = +proc splitSwitch(conf: ConfigRef; switch: string, cmd, arg: var string, pass: TCmdLinePass, + 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]) - else: break + 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) - else: InvalidCmdLineOption(pass, switch, info) - -proc ProcessOnOffSwitch(op: TOptions, arg: string, pass: TCmdlinePass, - info: TLineInfo) = - case whichKeyword(arg) - of wOn: gOptions = gOptions + op - of wOff: gOptions = gOptions - op - else: LocalError(info, errOnOrOffExpectedButXFound, arg) - -proc ProcessOnOffSwitchG(op: TGlobalOptions, arg: string, pass: TCmdlinePass, - info: TLineInfo) = - case whichKeyword(arg) - of wOn: gGlobalOptions = gGlobalOptions + op - of wOff: gGlobalOptions = gGlobalOptions - op - else: LocalError(info, errOnOrOffExpectedButXFound, arg) - -proc ExpectArg(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = - if arg == "": LocalError(info, errCmdLineArgExpected, addPrefix(switch)) - -proc ExpectNoArg(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = - if arg != "": LocalError(info, errCmdLineNoArgExpected, addPrefix(switch)) - -proc ProcessSpecificNote(arg: string, state: TSpecialWord, pass: TCmdlinePass, - info: TLineInfo) = - var id = "" # arg = "X]:on|off" + 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.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.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.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) = + if arg == "": + localError(conf, info, "argument for command line option expected: '$1'" % addPrefix(switch)) + +proc expectNoArg(conf: ConfigRef; switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = + if arg != "": + localError(conf, info, "invalid argument for command line option: '$1'" % addPrefix(switch)) + +proc processSpecificNote*(arg: string, state: TSpecialWord, pass: TCmdLinePass, + info: TLineInfo; orig: string; conf: ConfigRef) = + var id = "" # arg = key or [key] or key:val or [key]:val; with val=on|off var i = 0 - var n = hintMin - 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(pass, arg, info) - if i < len(arg) and (arg[i] in {':', '='}): inc(i) - else: InvalidCmdLineOption(pass, arg, info) - if state == wHint: - var x = findStr(msgs.HintsToStr, id) - if x >= 0: n = TNoteKind(x + ord(hintMin)) - else: InvalidCmdLineOption(pass, arg, info) - else: - var x = findStr(msgs.WarningsToStr, id) - if x >= 0: n = TNoteKind(x + ord(warnMin)) - else: InvalidCmdLineOption(pass, arg, info) - case whichKeyword(substr(arg, i)) - of wOn: incl(gNotes, n) - of wOff: excl(gNotes, n) - else: LocalError(info, errOnOrOffExpectedButXFound, arg) - -proc processCompile(filename: string) = - var found = findFile(filename) - if found == "": found = filename - var trunc = changeFileExt(found, "") - extccomp.addExternalFileToCompile(found) - extccomp.addFileToLink(completeCFilePath(trunc, false)) - -proc testCompileOptionArg*(switch, arg: string, info: TLineInfo): bool = + 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) + + 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 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.isEmpty: found = AbsoluteFile filename + extccomp.addExternalFileToCompile(conf, found) + +const + 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', '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 = gSelectedGC == gcBoehm - of "refc": result = gSelectedGC == gcRefc - of "v2": result = gSelectedGC == gcV2 - of "markandsweep": result = gSelectedGC == gcMarkAndSweep - of "generational": result = gSelectedGC == gcGenerational - of "none": result = gSelectedGC == gcNone - else: LocalError(info, errNoneBoehmRefcExpectedButXFound, arg) + of "boehm": result = conf.selectedGC == gcBoehm + of "refc": result = conf.selectedGC == gcRefc + of "markandsweep": result = conf.selectedGC == gcMarkAndSweep + 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 + of "atomicarc": result = conf.selectedGC == gcAtomicArc + else: + result = false + localError(conf, info, errNoneBoehmRefcExpectedButXFound % arg) of "opt": case arg.normalize - of "speed": result = contains(gOptions, optOptimizeSpeed) - of "size": result = contains(gOptions, optOptimizeSize) - of "none": result = gOptions * {optOptimizeSpeed, optOptimizeSize} == {} - else: LocalError(info, errNoneSpeedOrSizeExpectedButXFound, arg) - else: InvalidCmdLineOption(passCmd1, switch, info) + of "speed": result = contains(conf.options, optOptimizeSpeed) + of "size": result = contains(conf.options, optOptimizeSize) + of "none": result = conf.options * {optOptimizeSpeed, optOptimizeSize} == {} + 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 + not contains(conf.globalOptions, optGenGuiApp) + of "staticlib": result = contains(conf.globalOptions, optGenStaticLib) and + not contains(conf.globalOptions, optGenGuiApp) + else: + result = false + localError(conf, info, errGuiConsoleOrLibExpectedButXFound % arg) + of "dynliboverride": + result = isDynlibOverride(conf, arg) + 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*(switch: string, info: TLineInfo): bool = +proc testCompileOption*(conf: ConfigRef; switch: string, info: TLineInfo): bool = case switch.normalize - of "debuginfo": result = contains(gGlobalOptions, optCDebug) - of "compileonly", "c": result = contains(gGlobalOptions, optCompileOnly) - of "nolinking": result = contains(gGlobalOptions, optNoLinking) - of "nomain": result = contains(gGlobalOptions, optNoMain) - of "forcebuild", "f": result = contains(gGlobalOptions, optForceFullMake) - of "warnings", "w": result = contains(gOptions, optWarns) - of "hints": result = contains(gOptions, optHints) - of "threadanalysis": result = contains(gGlobalOptions, optThreadAnalysis) - of "stacktrace": result = contains(gOptions, optStackTrace) - of "linetrace": result = contains(gOptions, optLineTrace) - of "debugger": result = contains(gOptions, optEndb) - of "profiler": result = contains(gOptions, optProfiler) - of "checks", "x": result = gOptions * checksOptions == checksOptions + of "debuginfo": result = contains(conf.globalOptions, optCDebug) + of "compileonly", "c": result = contains(conf.globalOptions, optCompileOnly) + of "nolinking": result = contains(conf.globalOptions, optNoLinking) + of "nomain": result = contains(conf.globalOptions, optNoMain) + of "forcebuild", "f": result = contains(conf.globalOptions, optForceFullMake) + of "warnings", "w": result = contains(conf.options, optWarns) + 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.globalOptions, optCDebug) + of "profiler": result = contains(conf.options, optProfiler) + of "memtracker": result = contains(conf.options, optMemTracker) + of "checks", "x": result = conf.options * ChecksOptions == ChecksOptions of "floatchecks": - result = gOptions * {optNanCheck, optInfCheck} == {optNanCheck, optInfCheck} - of "infchecks": result = contains(gOptions, optInfCheck) - of "nanchecks": result = contains(gOptions, optNanCheck) - of "objchecks": result = contains(gOptions, optObjCheck) - of "fieldchecks": result = contains(gOptions, optFieldCheck) - of "rangechecks": result = contains(gOptions, optRangeCheck) - of "boundchecks": result = contains(gOptions, optBoundsCheck) - of "overflowchecks": result = contains(gOptions, optOverflowCheck) - of "linedir": result = contains(gOptions, optLineDir) - of "assertions", "a": result = contains(gOptions, optAssert) - of "deadcodeelim": result = contains(gGlobalOptions, optDeadCodeElim) - of "run", "r": result = contains(gGlobalOptions, optRun) - of "symbolfiles": result = contains(gGlobalOptions, optSymbolFiles) - of "genscript": result = contains(gGlobalOptions, optGenScript) - of "threads": result = contains(gGlobalOptions, optThreads) - of "taintmode": result = contains(gGlobalOptions, optTaintMode) - of "tlsemulation": result = contains(gGlobalOptions, optTlsEmulation) - of "implicitstatic": result = contains(gOptions, optImplicitStatic) - of "patterns": result = contains(gOptions, optPatterns) - else: InvalidCmdLineOption(passCmd1, switch, info) - -proc processPath(path: string, notRelativeToProj = false): string = - let p = if notRelativeToProj or os.isAbsolute(path) or - '$' in path or path[0] == '.': - path + result = conf.options * {optNaNCheck, optInfCheck} == {optNaNCheck, optInfCheck} + of "infchecks": result = contains(conf.options, optInfCheck) + of "nanchecks": result = contains(conf.options, optNaNCheck) + 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 "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 "tlsemulation": result = contains(conf.globalOptions, optTlsEmulation) + of "implicitstatic": result = contains(conf.options, optImplicitStatic) + of "patterns", "trmacros": + if switch.normalize == "patterns": deprecatedAlias(switch, "trmacros") + result = contains(conf.options, optTrMacros) + of "excessivestacktrace": result = contains(conf.globalOptions, optExcessiveStackTrace) + of "nilseqs", "nilchecks", "taintmode": + warningOptionNoop(switch) + result = false + of "panics": result = contains(conf.globalOptions, optPanics) + of "jsbigint64": result = contains(conf.globalOptions, optJsBigInt64) + else: + result = false + invalidCmdLineOption(conf, passCmd1, switch, info) + +proc processPath(conf: ConfigRef; path: string, info: TLineInfo, + notRelativeToProj = false): AbsoluteDir = + let p = if os.isAbsolute(path) or '$' in path: + path + elif notRelativeToProj: + getCurrentDir() / path else: - options.gProjectPath / path - result = UnixToNativePath(p % ["nimrod", getPrefixDir(), "lib", libpath, - "home", removeTrailingDirSep(os.getHomeDir()), - "projectname", options.gProjectName, - "projectpath", options.gProjectPath]) + conf.projectPath.string / path + try: + result = AbsoluteDir pathSubs(conf, p, toFullPath(conf, info).splitFile().dir) + except ValueError: + localError(conf, info, "invalid path: " & p) + result = AbsoluteDir p -proc trackDirty(arg: string, info: TLineInfo) = +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 = AbsoluteDir pathSubs(conf, p, basedir) + except ValueError: + localError(conf, info, "invalid path: " & 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(info, errTokenExpected, - "DIRTY_BUFFER,ORIGINAL_FILE,LINE,COLUMN") - var line, column: int - if parseUtils.parseInt(a[2], line) <= 0: - LocalError(info, errInvalidNumber, a[1]) - if parseUtils.parseInt(a[3], column) <= 0: - LocalError(info, errInvalidNumber, a[2]) - - gDirtyBufferIdx = a[0].fileInfoIdx - gDirtyOriginalIdx = a[1].fileInfoIdx - - optTrackPos = newLineInfo(gDirtyBufferIdx, line, column) - msgs.addCheckpoint(optTrackPos) - -proc track(arg: string, info: TLineInfo) = + if a.len != 4: localError(conf, info, + "DIRTY_BUFFER,ORIGINAL_FILE,LINE,COLUMN expected") + setTrackingInfo(conf, a[0], a[1], a[2], a[3], info) + +proc track(conf: ConfigRef; arg: string, info: TLineInfo) = + var a = arg.split(',') + if a.len != 3: localError(conf, info, "FILE,LINE,COLUMN expected") + 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(',') - if a.len != 3: LocalError(info, errTokenExpected, "FILE,LINE,COLUMN") - var line, column: int - if parseUtils.parseInt(a[1], line) <= 0: - LocalError(info, errInvalidNumber, a[1]) - if parseUtils.parseInt(a[2], column) <= 0: - LocalError(info, errInvalidNumber, a[2]) - optTrackPos = newLineInfo(a[0], line, column) - msgs.addCheckpoint(optTrackPos) - -proc dynlibOverride(switch, arg: string, pass: TCmdlinePass, info: TLineInfo) = + 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}: - expectArg(switch, arg, pass, info) - options.inclDynlibOverride(arg) - -proc processSwitch(switch, arg: string, pass: TCmdlinePass, info: TLineInfo) = - var - theOS: TSystemOS - cpu: TSystemCPU - key, val: string + 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 = "" + var val = "" case switch.normalize - of "path", "p": - expectArg(switch, arg, pass, info) - addPath(processPath(arg), info) - of "babelpath": - if pass in {passCmd2, passPP}: - expectArg(switch, arg, pass, info) - let path = processPath(arg, notRelativeToProj=true) - babelpath(path, info) + 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) + 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 = 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": + expectNoArg(conf, switch, arg, pass, info) + disableNimblePath(conf) + of "clearnimblepath": + expectNoArg(conf, switch, arg, pass, info) + clearNimblePath(conf) of "excludepath": - expectArg(switch, arg, pass, info) - let path = processPath(arg) - lists.ExcludeStr(options.searchPaths, path) - lists.ExcludeStr(options.lazyPaths, path) + expectArg(conf, switch, arg, pass, info) + let path = processPath(conf, arg, info) + conf.searchPaths.keepItIf(it != path) + conf.lazyPaths.keepItIf(it != path) of "nimcache": - expectArg(switch, arg, pass, info) - options.nimcacheDir = processPath(arg) - of "out", "o": - expectArg(switch, arg, pass, info) - options.outFile = arg - of "mainmodule", "m": - expectArg(switch, arg, pass, info) - optMainModule = arg - of "define", "d": - expectArg(switch, arg, pass, info) - DefineSymbol(arg) - of "undef", "u": - expectArg(switch, arg, pass, info) - UndefSymbol(arg) - of "compile": - expectArg(switch, arg, pass, info) - if pass in {passCmd2, passPP}: processCompile(arg) - of "link": - expectArg(switch, arg, pass, info) - if pass in {passCmd2, passPP}: addFileToLink(arg) - of "debuginfo": - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optCDebug) + expectArg(conf, switch, arg, pass, info) + var arg = arg + # refs bug #18674, otherwise `--os:windows` messes up with `--nimcache` set + # in config nims files, e.g. via: `import os; switch("nimcache", "/tmp/somedir")` + if conf.target.targetOS == osWindows and DirSep == '/': arg = arg.replace('\\', '/') + conf.nimcacheDir = processPath(conf, pathRelativeToConfig(arg, pass, conf), info, notRelativeToProj=true) + of "out", "o": + expectArg(conf, switch, arg, pass, info) + let f = splitFile(processPath(conf, arg, info, notRelativeToProj=true).string) + 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 "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 "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, AbsoluteFile arg) + of "debuginfo": + processOnOffSwitchG(conf, {optCDebug}, arg, pass, info) of "embedsrc": - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optEmbedOrigSrc) - of "compileonly", "c": - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optCompileOnly) - of "nolinking": - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optNoLinking) - of "nomain": - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optNoMain) - of "forcebuild", "f": - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optForceFullMake) + processOnOffSwitchG(conf, {optEmbedOrigSrc}, arg, pass, info) + of "compileonly", "c": + processOnOffSwitchG(conf, {optCompileOnly}, arg, pass, info) + of "nolinking": + processOnOffSwitchG(conf, {optNoLinking}, arg, pass, info) + of "nomain": + processOnOffSwitchG(conf, {optNoMain}, arg, pass, info) + of "forcebuild", "f": + processOnOffSwitchG(conf, {optForceFullMake}, arg, pass, info) of "project": - expectNoArg(switch, arg, pass, info) - gWholeProject = true - of "gc": - expectArg(switch, arg, pass, info) + processOnOffSwitchG(conf, {optWholeProject, optGenIndex}, arg, pass, info) + of "gc": + 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": + 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 "boehm": - gSelectedGC = gcBoehm - DefineSymbol("boehmgc") - of "refc": - gSelectedGC = gcRefc - of "v2": - gSelectedGC = gcV2 - of "markandsweep": - gSelectedGC = gcMarkAndSweep - defineSymbol("gcmarkandsweep") - of "generational": - gSelectedGC = gcGenerational - defineSymbol("gcgenerational") - of "none": - gSelectedGC = gcNone - defineSymbol("nogc") - else: LocalError(info, errNoneBoehmRefcExpectedButXFound, arg) - of "warnings", "w": ProcessOnOffSwitch({optWarns}, arg, pass, info) - of "warning": ProcessSpecificNote(arg, wWarning, pass, info) - of "hint": ProcessSpecificNote(arg, wHint, pass, info) - of "hints": ProcessOnOffSwitch({optHints}, arg, pass, info) - of "threadanalysis": ProcessOnOffSwitchG({optThreadAnalysis}, arg, pass, info) - of "stacktrace": ProcessOnOffSwitch({optStackTrace}, arg, pass, info) - of "linetrace": ProcessOnOffSwitch({optLineTrace}, arg, pass, info) - of "debugger": - ProcessOnOffSwitch({optEndb}, arg, pass, info) - if optEndb in gOptions: DefineSymbol("endb") - else: UndefSymbol("endb") - of "profiler": - ProcessOnOffSwitch({optProfiler}, arg, pass, info) - if optProfiler in gOptions: DefineSymbol("profiler") - else: UndefSymbol("profiler") - of "checks", "x": ProcessOnOffSwitch(checksOptions, arg, pass, info) + 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.globalOptions.excl optCDebug + else: + 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") + else: undefSymbol(conf.symbols, "profiler") + of "memtracker": + processOnOffSwitch(conf, {optMemTracker}, arg, pass, info) + if optMemTracker in conf.options: defineSymbol(conf.symbols, "memtracker") + else: undefSymbol(conf.symbols, "memtracker") + of "hotcodereloading": + 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: + undefSymbol(conf.symbols, "hotcodereloading") + undefSymbol(conf.symbols, "useNimRtl") + of "checks", "x": processOnOffSwitch(conf, ChecksOptions, arg, pass, info) of "floatchecks": - ProcessOnOffSwitch({optNanCheck, optInfCheck}, arg, pass, info) - of "infchecks": ProcessOnOffSwitch({optInfCheck}, arg, pass, info) - of "nanchecks": ProcessOnOffSwitch({optNanCheck}, arg, pass, info) - of "objchecks": ProcessOnOffSwitch({optObjCheck}, arg, pass, info) - of "fieldchecks": ProcessOnOffSwitch({optFieldCheck}, arg, pass, info) - of "rangechecks": ProcessOnOffSwitch({optRangeCheck}, arg, pass, info) - of "boundchecks": ProcessOnOffSwitch({optBoundsCheck}, arg, pass, info) - of "overflowchecks": ProcessOnOffSwitch({optOverflowCheck}, arg, pass, info) - of "linedir": ProcessOnOffSwitch({optLineDir}, arg, pass, info) - of "assertions", "a": ProcessOnOffSwitch({optAssert}, arg, pass, info) - of "deadcodeelim": ProcessOnOffSwitchG({optDeadCodeElim}, arg, pass, info) - of "threads": ProcessOnOffSwitchG({optThreads}, arg, pass, info) - of "tlsemulation": ProcessOnOffSwitchG({optTlsEmulation}, arg, pass, info) - of "taintmode": ProcessOnOffSwitchG({optTaintMode}, arg, pass, info) + processOnOffSwitch(conf, {optNaNCheck, optInfCheck}, arg, pass, info) + of "infchecks": processOnOffSwitch(conf, {optInfCheck}, arg, pass, info) + of "nanchecks": processOnOffSwitch(conf, {optNaNCheck}, arg, pass, info) + of "objchecks": processOnOffSwitch(conf, {optObjCheck}, arg, pass, info) + of "fieldchecks": processOnOffSwitch(conf, {optFieldCheck}, arg, pass, info) + of "rangechecks": processOnOffSwitch(conf, {optRangeCheck}, arg, pass, info) + of "boundchecks": processOnOffSwitch(conf, {optBoundsCheck}, arg, pass, info) + of "refchecks": + warningDeprecated(conf, info, "refchecks is deprecated!") + processOnOffSwitch(conf, {optRefCheck}, arg, pass, info) + of "overflowchecks": processOnOffSwitch(conf, {optOverflowCheck}, arg, pass, info) + of "staticboundchecks": processOnOffSwitch(conf, {optStaticBoundsCheck}, arg, pass, info) + of "stylechecks": processOnOffSwitch(conf, {optStyleCheck}, arg, pass, info) + of "linedir": processOnOffSwitch(conf, {optLineDir}, arg, pass, info) + of "assertions", "a": processOnOffSwitch(conf, {optAssert}, arg, pass, info) + of "threads": + 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({optImplicitStatic}, arg, pass, info) - of "patterns": - ProcessOnOffSwitch({optPatterns}, arg, pass, info) + processOnOffSwitch(conf, {optImplicitStatic}, arg, pass, info) + of "patterns", "trmacros": + if switch.normalize == "patterns": deprecatedAlias(switch, "trmacros") + processOnOffSwitch(conf, {optTrMacros}, arg, pass, info) of "opt": - expectArg(switch, arg, pass, info) + expectArg(conf, switch, arg, pass, info) case arg.normalize - of "speed": - incl(gOptions, optOptimizeSpeed) - excl(gOptions, optOptimizeSize) - of "size": - excl(gOptions, optOptimizeSpeed) - incl(gOptions, optOptimizeSize) + of "speed": + incl(conf.options, optOptimizeSpeed) + excl(conf.options, optOptimizeSize) + of "size": + excl(conf.options, optOptimizeSpeed) + incl(conf.options, optOptimizeSize) of "none": - excl(gOptions, optOptimizeSpeed) - excl(gOptions, optOptimizeSize) - else: LocalError(info, errNoneSpeedOrSizeExpectedButXFound, arg) - of "app": - expectArg(switch, arg, pass, info) + excl(conf.options, optOptimizeSpeed) + excl(conf.options, optOptimizeSize) + else: localError(conf, info, errNoneSpeedOrSizeExpectedButXFound % arg) + of "app": + expectArg(conf, switch, arg, pass, info) case arg.normalize of "gui": - incl(gGlobalOptions, optGenGuiApp) - defineSymbol("executable") - defineSymbol("guiapp") + incl(conf.globalOptions, optGenGuiApp) + defineSymbol(conf.symbols, "executable") + defineSymbol(conf.symbols, "guiapp") of "console": - excl(gGlobalOptions, optGenGuiApp) - defineSymbol("executable") - defineSymbol("consoleapp") + excl(conf.globalOptions, optGenGuiApp) + defineSymbol(conf.symbols, "executable") + defineSymbol(conf.symbols, "consoleapp") of "lib": - incl(gGlobalOptions, optGenDynLib) - excl(gGlobalOptions, optGenGuiApp) - defineSymbol("library") - defineSymbol("dll") + incl(conf.globalOptions, optGenDynLib) + excl(conf.globalOptions, optGenGuiApp) + defineSymbol(conf.symbols, "library") + defineSymbol(conf.symbols, "dll") of "staticlib": - incl(gGlobalOptions, optGenStaticLib) - excl(gGlobalOptions, optGenGuiApp) - defineSymbol("library") - defineSymbol("staticlib") - else: LocalError(info, errGuiConsoleOrLibExpectedButXFound, arg) - of "passc", "t": - expectArg(switch, arg, pass, info) - if pass in {passCmd2, passPP}: extccomp.addCompileOption(arg) - of "passl", "l": - expectArg(switch, arg, pass, info) - if pass in {passCmd2, passPP}: extccomp.addLinkOption(arg) + incl(conf.globalOptions, optGenStaticLib) + incl(conf.globalOptions, optNoMain) + excl(conf.globalOptions, optGenGuiApp) + defineSymbol(conf.symbols, "library") + defineSymbol(conf.symbols, "staticlib") + else: localError(conf, info, errGuiConsoleOrLibExpectedButXFound % arg) + of "passc", "t": + expectArg(conf, switch, arg, pass, info) + if pass in {passCmd2, passPP}: extccomp.addCompileOptionCmd(conf, arg) + of "passl", "l": + expectArg(conf, switch, arg, pass, info) + if pass in {passCmd2, passPP}: extccomp.addLinkOptionCmd(conf, arg) of "cincludes": - expectArg(switch, arg, pass, info) - if pass in {passCmd2, passPP}: cIncludes.add arg + expectArg(conf, switch, arg, pass, info) + if pass in {passCmd2, passPP}: conf.cIncludes.add processPath(conf, arg, info) of "clibdir": - expectArg(switch, arg, pass, info) - if pass in {passCmd2, passPP}: cLibs.add arg + expectArg(conf, switch, arg, pass, info) + if pass in {passCmd2, passPP}: conf.cLibs.add processPath(conf, arg, info) of "clib": - expectArg(switch, arg, pass, info) - if pass in {passCmd2, passPP}: cLinkedLibs.add arg + expectArg(conf, switch, arg, pass, info) + if pass in {passCmd2, passPP}: + conf.cLinkedLibs.add arg of "header": - headerFile = arg - incl(gGlobalOptions, optGenIndex) + if conf != nil: conf.headerFile = arg + incl(conf.globalOptions, optGenIndex) + of "nimbasepattern": + if conf != nil: conf.nimbasePattern = arg of "index": - ProcessOnOffSwitchG({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(switch, arg, pass, info) - if pass in {passCmd2, passPP}: implicitImports.add arg + expectArg(conf, switch, arg, pass, info) + if pass in {passCmd2, passPP}: + conf.implicitImports.add findModule(conf, arg, toFullPath(conf, info)).string of "include": - expectArg(switch, arg, pass, info) - if pass in {passCmd2, passPP}: implicitIncludes.add arg - of "listcmd": - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optListCmd) - of "genmapping": - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optGenMapping) - of "os": - expectArg(switch, arg, pass, info) - if pass in {passCmd1, passPP}: - theOS = platform.NameToOS(arg) - if theOS == osNone: LocalError(info, errUnknownOS, arg) - elif theOS != platform.hostOS: - setTarget(theOS, targetCPU) - condsyms.InitDefines() - of "cpu": - expectArg(switch, arg, pass, info) - if pass in {passCmd1, passPP}: - cpu = platform.NameToCPU(arg) - if cpu == cpuNone: LocalError(info, errUnknownCPU, arg) - elif cpu != platform.hostCPU: - setTarget(targetOS, cpu) - condsyms.InitDefines() - of "run", "r": - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optRun) - of "verbosity": - expectArg(switch, arg, pass, info) - gVerbosity = parseInt(arg) - of "parallelbuild": - expectArg(switch, arg, pass, info) - gNumberOfProcessors = parseInt(arg) - of "version", "v": - expectNoArg(switch, arg, pass, info) - writeVersionInfo(pass) - of "advanced": - expectNoArg(switch, arg, pass, info) - writeAdvancedUsage(pass) - of "help", "h": - expectNoArg(switch, arg, pass, info) - helpOnError(pass) - of "symbolfiles": - ProcessOnOffSwitchG({optSymbolFiles}, arg, pass, info) - of "skipcfg": - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optSkipConfigFile) - of "skipprojcfg": - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optSkipProjConfigFile) + expectArg(conf, switch, arg, pass, info) + if pass in {passCmd2, passPP}: + conf.implicitIncludes.add findModule(conf, arg, toFullPath(conf, info)).string + of "listcmd": + processOnOffSwitchG(conf, {optListCmd}, arg, pass, info) + of "asm": + processOnOffSwitchG(conf, {optProduceAsm}, arg, pass, info) + of "genmapping": + processOnOffSwitchG(conf, {optGenMapping}, arg, pass, info) + of "os": + expectArg(conf, switch, arg, pass, info) + let theOS = platform.nameToOS(arg) + if theOS == osNone: + let osList = platform.listOSnames().join(", ") + localError(conf, info, "unknown OS: '$1'. Available options are: $2" % [arg, $osList]) + else: + setTarget(conf.target, theOS, conf.target.targetCPU) + of "cpu": + expectArg(conf, switch, arg, pass, info) + let cpu = platform.nameToCPU(arg) + if cpu == cpuNone: + let cpuList = platform.listCPUnames().join(", ") + localError(conf, info, "unknown CPU: '$1'. Available options are: $2" % [ arg, cpuList]) + else: + setTarget(conf.target, conf.target.targetOS, cpu) + of "run", "r": + processOnOffSwitchG(conf, {optRun}, arg, pass, info) + if conf.backend == backendJs: + # for now, -r uses nodejs, so define nodejs + defineSymbol(conf.symbols, "nodejs") + of "maxloopiterationsvm": + expectArg(conf, switch, arg, pass, info) + 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) + 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) + var value: int = 0 + discard parseSaturatedNatural(arg, value) + conf.numberOfProcessors = value + of "version", "v": + expectNoArg(conf, switch, arg, pass, info) + writeVersionInfo(conf, pass) + of "advanced": + expectNoArg(conf, switch, arg, pass, info) + writeAdvancedUsage(conf, pass) + of "fullhelp": + expectNoArg(conf, switch, arg, pass, info) + writeFullhelp(conf, pass) + of "help", "h": + expectNoArg(conf, switch, arg, pass, info) + helpOnError(conf, pass) + 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": + processOnOffSwitchG(conf, {optSkipSystemConfigFile}, arg, pass, info) + of "skipprojcfg": + processOnOffSwitchG(conf, {optSkipProjConfigFile}, arg, pass, info) of "skipusercfg": - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optSkipUserConfigFile) + processOnOffSwitchG(conf, {optSkipUserConfigFile}, arg, pass, info) of "skipparentcfg": - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optSkipParentConfigFiles) - of "genscript": - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optGenScript) + processOnOffSwitchG(conf, {optSkipParentConfigFiles}, arg, pass, info) + of "genscript", "gendeps": + 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(switch, arg, pass, info) - libpath = processPath(arg, notRelativeToProj=true) - of "putenv": - expectArg(switch, arg, pass, info) - splitSwitch(arg, key, val, pass, info) + expectArg(conf, switch, arg, pass, info) + conf.libpath = processPath(conf, arg, info, notRelativeToProj=true) + of "putenv": + expectArg(conf, switch, arg, pass, info) + splitSwitch(conf, arg, key, val, pass, info) os.putEnv(key, val) - of "cc": - expectArg(switch, arg, pass, info) - setCC(arg) + of "cc": + if conf.backend != backendJs: # bug #19330 + expectArg(conf, switch, arg, pass, info) + setCC(conf, arg, info) of "track": - expectArg(switch, arg, pass, info) - track(arg, info) + expectArg(conf, switch, arg, pass, info) + track(conf, arg, info) of "trackdirty": - expectArg(switch, arg, pass, info) - trackDirty(arg, info) - of "suggest": - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optSuggest) + expectArg(conf, switch, arg, pass, info) + trackDirty(conf, arg, info) + of "suggest": + expectNoArg(conf, switch, arg, pass, info) + conf.ideCmd = ideSug of "def": - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optDef) - of "eval": - expectArg(switch, arg, pass, info) - gEvalExpr = arg + expectArg(conf, switch, arg, pass, info) + trackIde(conf, ideDef, arg, info) of "context": - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optContext) + expectNoArg(conf, switch, arg, pass, info) + conf.ideCmd = ideCon of "usages": - expectNoArg(switch, arg, pass, info) - incl(gGlobalOptions, optUsages) + 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(switch, arg, pass, info) - incl(gGlobalOptions, 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(switch, arg, pass, info) - gListFullPaths = true + # 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(switch, arg, pass, info) + dynlibOverride(conf, switch, arg, pass, info) + of "dynliboverrideall": + processOnOffSwitchG(conf, {optDynlibOverrideAll}, arg, pass, info) + of "experimental": + if arg.len == 0: + conf.features.incl oldExperimentalFeatures + else: + try: + 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) + 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) + 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": + 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) + +proc processCommand*(switch: string, pass: TCmdLinePass; config: ConfigRef) = + 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 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) & ':' & 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.setCmd cmdNimscript + incl(config.globalOptions, optWasNimscript) + config.projectName = unixToNativePath(p.key) + config.arguments = cmdLineRest(p) + result = true + elif pass != passCmd2: + setCommandEarly(config, p.key) + result = false + else: result = false else: - if strutils.find(switch, '.') >= 0: options.setConfigVar(switch, arg) - else: InvalidCmdLineOption(pass, switch, info) - -proc ProcessCommand(switch: string, pass: TCmdLinePass) = - var cmd, arg: string - splitSwitch(switch, cmd, arg, pass, gCmdLineInfo) - processSwitch(cmd, arg, pass, gCmdLineInfo) + if pass == passCmd1: config.commandArgs.add p.key + if argsCount == 1: + if p.key.endsWith(".nims"): + incl(config.globalOptions, optWasNimscript) + # support UNIX style filenames everywhere for portable build scripts: + if config.projectName.len == 0: + config.projectName = unixToNativePath(p.key) + config.arguments = cmdLineRest(p) + result = true + else: + result = false + inc argsCount diff --git a/compiler/compiler.nimble b/compiler/compiler.nimble new file mode 100644 index 000000000..ef3f343e1 --- /dev/null +++ b/compiler/compiler.nimble @@ -0,0 +1,28 @@ +include "../lib/system/compilation.nim" +version = $NimMajor & "." & $NimMinor & "." & $NimPatch +author = "Andreas Rumpf" +description = "Compiler package providing the compiler sources as a library." +license = "MIT" +skipDirs = @["."] +installDirs = @["compiler"] + +import os + +var compilerDir = "" + +before install: + rmDir("compiler") + + let + files = listFiles(".") + dirs = listDirs(".") + + mkDir("compiler") + + for f in files: + cpFile(f, "compiler" / f) + + for d in dirs: + cpDir(d, "compiler" / d) + +requires "nim" diff --git a/compiler/concepts.nim b/compiler/concepts.nim 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 be6cb9875..5043fc5d4 100644 --- a/compiler/condsyms.nim +++ b/compiler/condsyms.nim @@ -1,7 +1,7 @@ # # -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -9,94 +9,163 @@ # This module handles the conditional symbols. -import - ast, astalgo, hashes, platform, strutils, idents - -var gSymbols*: TStrTable - -proc DefineSymbol*(symbol: string) = - var i = getIdent(symbol) - var sym = StrTableGet(gSymbols, i) - if sym == nil: - new(sym) # circumvent the ID mechanism - sym.kind = skConditional - sym.name = i - StrTableAdd(gSymbols, sym) - sym.position = 1 - -proc UndefSymbol*(symbol: string) = - var sym = StrTableGet(gSymbols, getIdent(symbol)) - if sym != nil: sym.position = 0 - -proc isDefined*(symbol: PIdent): bool = - var sym = StrTableGet(gSymbols, symbol) - result = sym != nil and sym.position == 1 - -proc isDefined*(symbol: string): bool = - result = isDefined(getIdent(symbol)) - -iterator definedSymbolNames*: string = - var it: TTabIter - var s = InitTabIter(it, gSymbols) - while s != nil: - if s.position == 1: yield s.name.s - s = nextIter(it, gSymbols) - -proc countDefinedSymbols*(): int = - var it: TTabIter - var s = InitTabIter(it, gSymbols) - result = 0 - while s != nil: - if s.position == 1: inc(result) - s = nextIter(it, gSymbols) - -proc InitDefines*() = - initStrTable(gSymbols) - DefineSymbol("nimrod") # 'nimrod' is always defined +import + std/strtabs + +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.del(symbol) + +#proc lookupSymbol*(symbols: StringTableRef; symbol: string): string = +# result = if isDefined(symbol): gSymbols[symbol] else: nil + +iterator definedSymbolNames*(symbols: StringTableRef): string = + for key in keys(symbols): + yield key + +proc countDefinedSymbols*(symbols: StringTableRef): int = + symbols.len + +proc initDefines*(symbols: StringTableRef) = # for bootstrapping purposes and old code: - DefineSymbol("nimhygiene") - DefineSymbol("niminheritable") - DefineSymbol("nimmixin") - DefineSymbol("nimeffects") - DefineSymbol("nimbabel") - - # add platform specific symbols: - case targetCPU - of cpuI386: DefineSymbol("x86") - of cpuIa64: DefineSymbol("itanium") - of cpuAmd64: DefineSymbol("x8664") - else: nil - case targetOS - of osDOS: - DefineSymbol("msdos") - of osWindows: - DefineSymbol("mswindows") - DefineSymbol("win32") - of osLinux, osMorphOS, osSkyOS, osIrix, osPalmOS, osQNX, osAtari, osAix, - osHaiku: - # these are all 'unix-like' - DefineSymbol("unix") - DefineSymbol("posix") - of osSolaris: - DefineSymbol("sunos") - DefineSymbol("unix") - DefineSymbol("posix") - of osNetBSD, osFreeBSD, osOpenBSD: - DefineSymbol("unix") - DefineSymbol("bsd") - DefineSymbol("posix") - of osMacOS: - DefineSymbol("macintosh") - of osMacOSX: - DefineSymbol("macintosh") - DefineSymbol("unix") - DefineSymbol("posix") - else: nil - DefineSymbol("cpu" & $cpu[targetCPU].bit) - DefineSymbol(normalize(endianToStr[cpu[targetCPU].endian])) - DefineSymbol(cpu[targetCPU].name) - DefineSymbol(platform.os[targetOS].name) - if platform.OS[targetOS].props.contains(ospLacksThreadVars): - DefineSymbol("emulatedthreadvars") + template defineSymbol(s) = symbols.defineSymbol(s) + 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/crc.nim b/compiler/crc.nim deleted file mode 100644 index a3b181e20..000000000 --- a/compiler/crc.nim +++ /dev/null @@ -1,147 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -import - strutils - -type - TCrc32* = int32 - -const - InitCrc32* = TCrc32(- 1) - InitAdler32* = int32(1) - -proc updateCrc32*(val: int8, crc: TCrc32): TCrc32 {.inline.} -proc updateCrc32*(val: Char, crc: TCrc32): TCrc32 {.inline.} -proc crcFromBuf*(buf: Pointer, length: int): TCrc32 -proc strCrc32*(s: string): TCrc32 -proc crcFromFile*(filename: string): TCrc32 -proc updateAdler32*(adler: int32, buf: pointer, length: int): int32 -# implementation - -type - TCRC_TabEntry = int - -const - crc32table: array[0..255, TCRC_TabEntry] = [0, 1996959894, - 301047508, - - 1727442502, 124634137, 1886057615, - 379345611, - 1637575261, 249268274, - 2044508324, - 522852066, - 1747789432, 162941995, 2125561021, - 407360249, - - 1866523247, 498536548, 1789927666, - 205950648, - 2067906082, 450548861, - 1843258603, - 187386543, - 2083289657, 325883990, 1684777152, - 43845254, - - 1973040660, 335633487, 1661365465, - 99664541, - 1928851979, 997073096, - 1281953886, - 715111964, - 1570279054, 1006888145, 1258607687, - 770865667, - - 1526024853, 901097722, 1119000684, - 608450090, - 1396901568, 853044451, - 1172266101, - 589951537, - 1412350631, 651767980, 1373503546, - 925412992, - - 1076862698, 565507253, 1454621731, - 809855591, - 1195530993, 671266974, - 1594198024, - 972236366, - 1324619484, 795835527, 1483230225, - 1050600021, - - 1234817731, 1994146192, 31158534, - 1731059524, - 271249366, 1907459465, - 112637215, - 1614814043, - 390540237, 2013776290, 251722036, - 1777751922, - - 519137256, 2137656763, 141376813, - 1855689577, - 429695999, 1802195444, - 476864866, - 2056965928, - 228458418, 1812370925, 453092731, - 2113342271, - - 183516073, 1706088902, 314042704, - 1950435094, - 54949764, 1658658271, - 366619977, - 1932296973, - 69972891, 1303535960, 984961486, - 1547960204, - - 725929758, 1256170817, 1037604311, - 1529756563, - 740887301, 1131014506, - 879679996, - 1385723834, - 631195440, 1141124467, 855842277, - 1442165665, - - 586318647, 1342533948, 654459306, - 1106571248, - 921952122, 1466479909, - 544179635, - 1184443383, - 832445281, 1591671054, 702138776, - 1328506846, - - 942167884, 1504918807, 783551873, - 1212326853, - 1061524307, - 306674912, - - 1698712650, 62317068, 1957810842, - 355121351, - 1647151185, 81470997, - 1943803523, - 480048366, - 1805370492, 225274430, 2053790376, - 468791541, - - 1828061283, 167816743, 2097651377, - 267414716, - 2029476910, 503444072, - 1762050814, - 144550051, - 2140837941, 426522225, 1852507879, - 19653770, - - 1982649376, 282753626, 1742555852, - 105259153, - 1900089351, 397917763, - 1622183637, - 690576408, - 1580100738, 953729732, 1340076626, - 776247311, - - 1497606297, 1068828381, 1219638859, - 670225446, - 1358292148, 906185462, - 1090812512, - 547295293, - 1469587627, 829329135, 1181335161, - 882789492, - - 1134132454, 628085408, 1382605366, - 871598187, - 1156888829, 570562233, - 1426400815, - 977650754, - 1296233688, 733239954, 1555261956, - 1026031705, - - 1244606671, 752459403, 1541320221, - 1687895376, - 328994266, 1969922972, - 40735498, - 1677130071, - 351390145, 1913087877, 83908371, - 1782625662, - - 491226604, 2075208622, 213261112, - 1831694693, - 438977011, 2094854071, - 198958881, - 2032938284, - 237706686, 1759359992, 534414190, - 2118248755, - - 155638181, 1873836001, 414664567, - 2012718362, - 15766928, 1711684554, - 285281116, - 1889165569, - 127750551, 1634467795, 376229701, - 1609899400, - - 686959890, 1308918612, 956543938, - 1486412191, - 799009033, 1231636301, - 1047427035, - 1362007478, - 640263460, 1088359270, 936918000, - 1447252397, - - 558129467, 1202900863, 817233897, - 1111625188, - 893730166, 1404277552, - 615818150, - 1160759803, - 841546093, 1423857449, 601450431, - 1285129682, - - 1000256840, 1567103746, 711928724, - 1274298825, - 1022587231, 1510334235, - 755167117] - -proc updateCrc32(val: int8, crc: TCrc32): TCrc32 = - result = TCrc32(crc32Table[(int(crc) xor (int(val) and 0x000000FF)) and - 0x000000FF]) xor (crc shr TCrc32(8)) - -proc updateCrc32(val: Char, crc: TCrc32): TCrc32 = - result = updateCrc32(toU8(ord(val)), crc) - -proc strCrc32(s: string): TCrc32 = - result = InitCrc32 - for i in countup(0, len(s) - 1): result = updateCrc32(s[i], result) - -proc `><`*(c: TCrc32, s: string): TCrc32 = - result = c - for i in 0..len(s)-1: result = updateCrc32(s[i], result) - -type - TByteArray = array[0..10000000, int8] - PByteArray = ref TByteArray - -proc crcFromBuf(buf: Pointer, length: int): TCrc32 = - var p = cast[PByteArray](buf) - result = InitCrc32 - for i in countup(0, length - 1): result = updateCrc32(p[i], result) - -proc crcFromFile(filename: string): TCrc32 = - const - bufSize = 8000 # don't use 8K for the memory allocator! - var - bin: tfile - result = InitCrc32 - if not open(bin, filename): - return # not equal if file does not exist - var buf = alloc(BufSize) - var p = cast[PByteArray](buf) - while true: - var readBytes = readBuffer(bin, buf, bufSize) - for i in countup(0, readBytes - 1): result = updateCrc32(p[i], result) - if readBytes != bufSize: break - dealloc(buf) - close(bin) - -const - base = int32(65521) # largest prime smaller than 65536 - # NMAX = 5552; original code with unsigned 32 bit integer - # NMAX is the largest n - # such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^32-1 - nmax = 3854 # code with signed 32 bit integer - # NMAX is the largest n such that - # 255n(n+1)/2 + (n+1)(BASE-1) <= 2^31-1 - # The penalty is the time loss in the extra MOD-calls. - -proc updateAdler32(adler: int32, buf: pointer, length: int): int32 = - var - s1, s2: int32 - L, k, b: int - s1 = adler and int32(0x0000FFFF) - s2 = (adler shr int32(16)) and int32(0x0000FFFF) - L = length - b = 0 - while (L > 0): - if L < nmax: k = L - else: k = nmax - dec(L, k) - while (k > 0): - s1 = s1 +% int32((cast[cstring](buf))[b]) - s2 = s2 +% s1 - inc(b) - dec(k) - s1 = `%%`(s1, base) - s2 = `%%`(s2, base) - result = (s2 shl int32(16)) or s1 diff --git a/compiler/debuginfo.nim b/compiler/debuginfo.nim new file mode 100644 index 000000000..e408a932b --- /dev/null +++ b/compiler/debuginfo.nim @@ -0,0 +1,78 @@ +# +# +# The Nim Compiler +# (c) Copyright 2017 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## The compiler can generate debuginfo to help debuggers in translating back +## from C/C++/JS code to Nim. The data structure has been designed to produce +## something useful with Nim's marshal module. + +import sighashes + +type + FilenameMapping* = object + package*, file*: string + mangled*: SigHash + EnumDesc* = object + size*: int + owner*: SigHash + id*: int + name*: string + values*: seq[(string, int)] + DebugInfo* = object + version*: int + files*: seq[FilenameMapping] + enums*: seq[EnumDesc] + conflicts*: bool + +proc sdbmHash(package, file: string): SigHash = + result = 0 + for i in 0..<package.len: + result &= package[i] + result &= '.' + for i in 0..<file.len: + result &= file[i] + +proc register*(self: var DebugInfo; package, file: string): SigHash = + result = sdbmHash(package, file) + for f in self.files: + if f.mangled == result: + if f.package == package and f.file == file: return + self.conflicts = true + break + self.files.add(FilenameMapping(package: package, file: file, mangled: result)) + +proc hasEnum*(self: DebugInfo; ename: string; id: int; owner: SigHash): bool = + for en in self.enums: + if en.owner == owner and en.name == ename and en.id == id: return true + +proc registerEnum*(self: var DebugInfo; ed: EnumDesc) = + self.enums.add ed + +proc init*(self: var DebugInfo) = + self.version = 1 + self.files = @[] + self.enums = @[] + +var gDebugInfo*: DebugInfo +debuginfo.init gDebugInfo + +import marshal, streams + +proc writeDebugInfo*(self: var DebugInfo; file: string) = + let s = newFileStream(file, fmWrite) + store(s, self) + s.close + +proc writeDebugInfo*(file: string) = writeDebugInfo(gDebugInfo, file) + +proc loadDebugInfo*(self: var DebugInfo; file: string) = + let s = newFileStream(file, fmRead) + load(s, self) + s.close + +proc loadDebugInfo*(file: string) = loadDebugInfo(gDebugInfo, file) 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 1468cbdb9..638f1eb51 100644 --- a/compiler/depends.nim +++ b/compiler/depends.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -9,48 +9,102 @@ # This module implements a dependency file generator. -import - os, options, ast, astalgo, msgs, ropes, idents, passes, importer +import options, ast, ropes, pathutils, msgs, lineinfos -proc generateDot*(project: string) +import modulegraphs -type - TGen = object of TPassContext - module*: PSym +import std/[os, parseutils] +import std/strutils except addf +import std/private/globs + +when defined(nimPreviewSlimSystem): + import std/assertions + + +type + TGen = object of PPassContext + module: PSym + config: ConfigRef + graph: ModuleGraph PGen = ref TGen -var gDotGraph: PRope # the generated DOT file; we need a global variable + Backend = ref object of RootRef + dotGraph: Rope -proc addDependencyAux(importing, imported: string) = - appf(gDotGraph, "$1 -> $2;$n", [toRope(importing), toRope(imported)]) +proc addDependencyAux(b: Backend; importing, imported: string) = + 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 - var g = PGen(c) + 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(n.sons[i]) - addDependencyAux(g.module.name.s, imported) - of nkFromStmt, nkImportExceptStmt: - var imported = getModuleName(n.sons[0]) - addDependencyAux(g.module.name.s, imported) - of nkStmtList, nkBlockStmt, nkStmtListExpr, nkBlockExpr: - for i in countup(0, sonsLen(n) - 1): discard addDotDependency(c, n.sons[i]) - else: - nil - -proc generateDot(project: string) = - writeRope(ropef("digraph $1 {$n$2}$n", [ - toRope(changeFileExt(extractFileName(project), "")), gDotGraph]), - changeFileExt(project, "dot")) - -proc myOpen(module: PSym): PPassContext = - var g: PGen - new(g) - g.module = module - result = g + of nkImportStmt: + for i in 0..<n.len: + addDependency(c, g, b, n[i]) + of nkFromStmt, nkImportExceptStmt: + addDependency(c, g, b, n[0]) + of nkStmtList, nkBlockStmt, nkStmtListExpr, nkBlockExpr: + for i in 0..<n.len: discard addDotDependency(c, n[i]) + else: + discard -const gendependPass* = makePass(open = myOpen, process = addDotDependency) +proc generateDot*(graph: ModuleGraph; project: AbsoluteFile) = + let b = Backend(graph.backend) + discard writeRope("digraph $1 {$n$2}$n" % [ + rope(project.splitFile.name), b.dotGraph], + changeFileExt(project, "dot")) +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: "") diff --git a/compiler/dfa.nim b/compiler/dfa.nim new file mode 100644 index 000000000..5534d07e7 --- /dev/null +++ b/compiler/dfa.nim @@ -0,0 +1,491 @@ +# +# +# The Nim Compiler +# (c) Copyright 2017 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## 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 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), '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 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, lineinfos, renderer, aliasanalysis +import std/private/asciitables +import std/intsets + +when defined(nimPreviewSlimSystem): + import std/assertions + +type + InstrKind* = enum + goto, loop, fork, def, use + Instr* = object + case kind*: InstrKind + of goto, fork, loop: dest*: int + of def, use: + n*: PNode # contains the def/use location. + + ControlFlowGraph* = seq[Instr] + + TPosition = distinct int + + 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 + inTryStmt, interestingInstructions: int + blocks: seq[TBlock] + owner: PSym + root: PSym + +proc codeListing(c: ControlFlowGraph, start = 0; last = -1): string = + # for debugging purposes + # first iteration: compute all necessary labels: + result = "" + var jumpTargets = initIntSet() + let last = if last < 0: c.len-1 else: min(last, c.len-1) + for i in start..last: + if c[i].kind in {goto, fork, 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 ($i & " " & $c[i].kind) + result.add "\t" + case c[i].kind + 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.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.} = + ## echos the ControlFlowGraph for debugging purposes. + echo codeListing(c, start, last).alignTable + +proc forkI(c: var Con): TPosition = + result = TPosition(c.code.len) + c.code.add Instr(kind: fork, dest: 0) + +proc gotoI(c: var Con): TPosition = + result = TPosition(c.code.len) + c.code.add Instr(kind: goto, dest: 0) + +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, 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 + 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) = + 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) = + let oldLen = c.blocks.len + c.blocks.add TBlock(isTryBlock: false, label: labl) + body + popBlock(c, oldLen) + +template forkT(body) = + let lab1 = c.forkI() + body + c.patch(lab1) + +proc genWhile(c: var Con; n: PNode) = + # lab1: + # cond, tmp + # fork tmp, lab2 + # body + # jmp lab1 + # lab2: + let lab1 = c.genLabel + withBlock(nil): + if isTrue(n[0]): + c.gen(n[1]) + c.jmpBack(lab1) + else: + 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] = @[] + let oldInteresting = c.interestingInstructions + let oldLen = c.code.len + + for i in 0..<n.len: + let it = n[i] + c.gen(it[0]) + if it.len == 2: + forkT: + c.gen(it.lastSon) + endings.add c.gotoI() + + if oldInteresting == c.interestingInstructions: + setLen c.code, oldLen + else: + for i in countdown(endings.high, 0): + c.patch(endings[i]) + +proc genAndOr(c: var Con; n: PNode) = + # asgn dest, a + # fork lab1 + # asgn dest, b + # lab1: + c.gen(n[1]) + forkT: + c.gen(n[2]) + +proc genCase(c: var Con; n: PNode) = + # if (!expr1) goto lab1; + # thenPart + # goto LEnd + # lab1: + # if (!expr2) goto lab2; + # thenPart2 + # goto LEnd + # lab2: + # elsePart + # Lend: + let isExhaustive = skipTypes(n[0].typ, + abstractVarRange-{tyTypeDesc}).kind notin {tyFloat..tyFloat128, tyString, tyCstring} + + var endings: seq[TPosition] = @[] + c.gen(n[0]) + let oldInteresting = c.interestingInstructions + let oldLen = c.code.len + for i in 1..<n.len: + let it = n[i] + if it.len == 1 or (i == n.len-1 and isExhaustive): + # treat the last branch as 'else' if this is an exhaustive case statement. + c.gen(it.lastSon) + 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 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: + 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[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) = + 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) = + inc c.interestingInstructions + if n[0].kind != nkEmpty: + gen(c, n[0]) + else: + genImplicitReturn(c) + genBreakOrRaiseAux(c, 0, n) + +const + 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) + + if n.kind == nkSym and n.sym.kind in InterestingSyms: + 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) + for i in 1..<n.len: + gen(c, n[i]) + if t != nil and i < t.signatureLen and isOutParam(t[i]): + # Pass by 'out' is a 'must def'. Good enough for a move optimizer. + genDef(c, n[i]) + # every call can potentially raise: + if c.inTryStmt > 0 and canRaiseConservative(n[0]): + inc c.interestingInstructions + # we generate the instruction sequence: + # fork lab1 + # goto exceptionHandler (except or finally) + # lab1: + 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 + of mAnd, mOr: c.genAndOr(n) + of mNew, mNewFinalize: + genDef(c, n[1]) + for i in 2..<n.len: gen(c, n[i]) + else: + genCall(c, n) + +proc genVarSection(c: var Con; n: PNode) = + for a in n: + if a.kind == nkCommentStmt: + discard + elif a.kind == nkVarTuple: + gen(c, a.lastSon) + for i in 0..<a.len-2: genDef(c, a[i]) + else: + gen(c, a.lastSon) + if a.lastSon.kind != nkEmpty: + genDef(c, a[0]) + +proc gen(c: var Con; n: PNode) = + case n.kind + of nkSym: genUse(c, n) + of nkCallKinds: + 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, 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 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[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, nkHiddenTryStmt: genTry(c, n) + of nkStmtList, nkStmtListExpr, nkChckRangeF, nkChckRange64, nkChckRange, + nkBracket, nkCurly, nkPar, nkTupleConstr, nkClosure, nkObjConstr, nkYieldStmt: + for x in n: gen(c, x) + of nkPragmaBlock: gen(c, n.lastSon) + 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 + +when false: + proc optimizeJumps(c: var ControlFlowGraph) = + for i in 0..<c.len: + case c[i].kind + of goto, fork: + var pc = i + c[i].dest + if pc < c.len and c[pc].kind == goto: + while pc < c.len and c[pc].kind == goto: + let newPc = pc + c[pc].dest + if newPc > pc: + pc = newPc + else: + break + c[i].dest = pc - i + of loop, def, use: discard + +proc constructCfg*(s: PSym; body: PNode; root: PSym): ControlFlowGraph = + ## constructs a control flow graph for ``body``. + var c = Con(code: @[], blocks: @[], owner: s, 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 9929b4bd9..8e5f5e4e7 100644 --- a/compiler/docgen.nim +++ b/compiler/docgen.nim @@ -1,399 +1,1954 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this # 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, rstast, rst, rstgen, times, highlite, - importer, sempass2 +import + 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, PRope] - TDocumentor = object of rstgen.TRstGenerator - modDesc: PRope # module description - id: int # for generating IDs - toc, section: TSections + 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 + 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. + jEntriesPre: seq[JsonItem] # pre-processed RST + JSON content + jEntriesFinal: JsonNode # final JSON after RST pass 2 and rendering + types: TStrTable + 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: + result = nil + for i in 0..<n.safeLen: + let x = whichType(d, n[i]) + if x != nil: return x + +proc attachToType(d: PDoc; p: PSym): PSym = + result = nil + let params = p.ast[paramsPos] + template check(i) = + result = whichType(d, params[i]) + 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(currentFilename: AbsoluteFile, destFile: string) = + proc compilerMsgHandler(filename: string, line, col: int, + msgKind: rst.MsgKind, arg: string) {.gcsafe.} = + # translate msg kind: + var k: TMsgKind + case msgKind + of meCannotOpenFile: k = errCannotOpenFile + of meExpected: k = errXExpected + 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 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('\\', '/') + - PDoc* = ref TDocumentor - -proc compilerMsgHandler(filename: string, line, col: int, - msgKind: rst.TMsgKind, arg: string) {.procvar.} = - # translate msg kind: - var k: msgs.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 - GlobalError(newLineInfo(filename, line, col), k, arg) - -proc parseRst(text, filename: string, - line, column: int, hasToc: var bool, - rstOptions: TRstParseOptions): PRstNode = - result = rstParse(text, filename, line, column, hasToc, rstOptions, - options.FindFile, compilerMsgHandler) - -proc newDocumentor*(filename: string, config: PStringTable): PDoc = +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) - initRstGenerator(result[], (if gCmd != cmdRst2Tex: outHtml else: outLatex), - options.gConfigVars, filename, {roSupportRawDirective}, - options.FindFile, compilerMsgHandler) + let d = result # pass `d` to `declareClosures`: + declareClosures(currentFilename = filename, destFile = destFile) + result.module = module + result.conf = conf + result.cache = cache + result.outDir = conf.outDir.string + 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> + (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){ + (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o), + m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m) + })(window,document,'script','//www.google-analytics.com/analytics.js','ga'); + + ga('create', '$1', 'auto'); + ga('send', 'pageview'); + +</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.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 dispA(dest: var PRope, xml, tex: string, args: openarray[PRope]) = - if gCmd != cmdRst2Tex: appf(dest, xml, args) - else: appf(dest, tex, args) - -proc getVarIdx(varnames: openarray[string], id: string): int = - for i in countup(0, high(varnames)): - if cmpIgnoreStyle(varnames[i], id) == 0: + 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 0..high(varnames): + if cmpIgnoreStyle(varnames[i], id) == 0: return i result = -1 -proc ropeFormatNamedVars(frmt: TFormatStr, varnames: openarray[string], - varvalues: openarray[PRope]): PRope = - 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 '#': - app(result, varvalues[num]) - inc(num) - inc(i) - of '$': - app(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: internalError("ropeFormatNamedVars") - num = j - app(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: app(result, varvalues[idx]) - else: rawMessage(errUnkownSubstitionVar, id) - of '{': - var id = "" - inc(i) - while frmt[i] != '}': - if frmt[i] == '\0': rawMessage(errTokenExpected, "}") - add(id, frmt[i]) - inc(i) - inc(i) # skip } - # search for the variable: - var idx = getVarIdx(varnames, id) - if idx >= 0: app(result, varvalues[idx]) - else: rawMessage(errUnkownSubstitionVar, id) - else: InternalError("ropeFormatNamedVars") - var start = i - while i < L: - if frmt[i] != '$': inc(i) - else: break - if i - 1 >= start: app(result, substr(frmt, start, i - 1)) - -proc genComment(d: PDoc, n: PNode): string = - result = "" - var dummyHasToc: bool - if n.comment != nil and startsWith(n.comment, "##"): - renderRstToOut(d[], parseRst(n.comment, toFilename(n.info), - toLineNumber(n.info), toColumn(n.info), - dummyHasToc, d.options + {roSkipPounds}), 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): PRope = +proc genRecCommentAux(d: PDoc, n: PNode): PRstNode = if n == nil: return nil - result = genComment(d, n).toRope - if result == nil: - if n.kind notin {nkEmpty..nkNilLit}: - for i in countup(0, len(n)-1): - result = genRecComment(d, n.sons[i]) - if result != nil: return + result = genComment(d, n) + if result == nil: + 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 findDocComment(n: PNode): PNode = +proc genRecComment(d: PDoc, n: PNode): PRstNode = 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 + 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. + ## + ## 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. + if n == nil: result = "" + elif startsWith(n.comment, "##"): + result = n.comment + else: + result = "" + for i in 0..<n.safeLen: + result = getPlainDocstring(n[i]) + if result.len > 0: return + +proc 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 = "" + 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}", + [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}", + [literal]) + of tkOpr: + dispA(d.conf, result, "<span class=\"Operator\">$1</span>", "\\spanOperator{$1}", + [escLit]) + of tkStrLit..tkTripleStrLit, tkCustomLit: + dispA(d.conf, result, "<span class=\"StringLit\">$1</span>", + "\\spanStringLit{$1}", [escLit]) + of tkCharLit: + dispA(d.conf, result, "<span class=\"CharLit\">$1</span>", "\\spanCharLit{$1}", + [escLit]) + of tkIntLit..tkUInt64Lit: + dispA(d.conf, result, "<span class=\"DecNumber\">$1</span>", + "\\spanDecNumber{$1}", [escLit]) + of tkFloatLit..tkFloat128Lit: + dispA(d.conf, result, "<span class=\"FloatNumber\">$1</span>", + "\\spanFloatNumber{$1}", [escLit]) + of tkSymbol: + 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: + 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, + tkAccent, tkColonColon, + tkGStrLit, tkGTripleStrLit, tkInfixOpr, tkPrefixOpr, tkPostfixOpr, + tkBracketLeColon: + dispA(d.conf, result, "<span class=\"Other\">$1</span>", "\\spanOther{$1}", + [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 extractDocComment*(s: PSym, d: PDoc = nil): string = - let n = findDocComment(s.ast) +proc quoted(a: string): string = result = "" - if not n.isNil: - if not d.isNil: - var dummyHasToc: bool - renderRstToOut(d[], parseRst(n.comment, toFilename(n.info), - toLineNumber(n.info), toColumn(n.info), - dummyHasToc, d.options + {roSkipPounds}), - 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 + ]## + + case n.kind + of nkCommentStmt: + if state in {rsStart, rsRunnable}: + dest.add genRecComment(d, n) + return rsComment + of nkCallKinds: + if isRunnableExamples(n[0]) and + n.len >= 2 and n.lastSon.kind == nkStmtList: + if state in {rsStart, rsComment, rsRunnable}: + let (rdoccmd, code) = prepareExample(d, n, topLevel) + var msg = "Example:" + if rdoccmd.len > 0: msg.add " cmd: " & rdoccmd + var s: string = "" + dispA(d.conf, s, "\n<p><strong class=\"examples_text\">$1</strong></p>\n", + "\n\n\\textbf{$1}\n", [msg]) + dest.add s + inc d.listingCounter + let id = $d.listingCounter + dest.add(d.config.getOrDefault"doc.listing_start" % [id, "langNim", ""]) + var dest2 = "" + renderNimCode(dest2, code, d.target) + dest.add dest2 + dest.add(d.config.getOrDefault"doc.listing_end" % id) + return rsRunnable + else: + localError(d.conf, n.info, errUser, "runnableExamples must appear before the first non-comment statement") + else: discard + return rsDone + # change this to `rsStart` if you want to keep generating doc comments + # 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: - result = n.comment.substr(2).replace("\n##", "\n").strip + 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.kind == nkPostfix: + 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]) - -proc getName(d: PDoc, n: PNode, splitAfter = -1): string = + result = isVisible(d, n[0]) + +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 nkAccQuoted: - result = esc(d.target, "`") - for i in 0.. <n.len: result.add(getName(d, n[i], splitAfter)) - result.add esc(d.target, "`") + 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 = "`" + for i in 0..<n.len: result.add(getName(n[i])) + result = "`" + of nkOpenSymChoice, nkClosedSymChoice, nkOpenSym: + result = getName(n[0]) else: - internalError(n.info, "getName()") result = "" -proc getRstName(n: PNode): PRstNode = +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 = 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 nkAccQuoted: - result = getRstName(n.sons[0]) - for i in 1 .. <n.len: result.text.add(getRstName(n[i]).text) + 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, nkOpenSym: + result = getNameIdent(cache, n[0]) else: - internalError(n.info, "getRstName()") result = nil -proc genItem(d: PDoc, n, nameNode: PNode, k: TSymKind) = - if not isVisible(nameNode): return - var name = toRope(getName(d, nameNode)) - var result: PRope = nil - var literal = "" +proc getRstName(n: PNode): PRstNode = + case n.kind + 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[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 + +proc newUniquePlainSymbol(d: PDoc, original: string): string = + ## Returns a new unique plain symbol made up from the original. + ## + ## When a collision is found in the seenSymbols table, new numerical variants + ## with underscore + number will be generated. + if not d.seenSymbols.hasKey(original): + 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): + d.seenSymbols[result] = "" + break + count += 1 + +proc complexName(k: TSymKind, n: PNode, baseName: string): string = + ## Builds a complex unique href name for the node. + ## + ## Pass as ``baseName`` the plain symbol obtained from the nodeName. The + ## format of the returned symbol will be ``baseName(.callable type)?,(param + ## type)?(,param type)*``. The callable type part will be added only if the + ## node is not a proc, as those are the common ones. The suffix will be a dot + ## and a single letter representing the type of the callable. The parameter + ## 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.rst``. + result = baseName + 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 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 + ## separators. + ## + ## No guarantees are made on the size of the output, but it should be small. + ## Also, we hope to not break the rst, but maybe we do. If there is any + ## trimming done, an ellipsis unicode char is added. + const maxDocstringChars = 100 + assert(rstText.len < 2 or (rstText[0] == '#' and rstText[1] == '#')) + result = rstText.substr(2).strip + var pos = result.find('\L') + if pos > 0: + result.setLen(pos - 1) + result.add("…") + if pos < maxDocstringChars: + return + # Try to keep trimming at other natural boundaries. + pos = result.find({'.', ',', ':'}) + let last = result.len - 1 + if pos > 0 and 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) + + 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(nameNode) + nameEsc = esc(d.target, name) + var plainDocstring = getPlainDocstring(n) # call here before genRecComment! + var result = "" + var literal, plainName = "" var kind = tkEof - var comm = genRecComment(d, n) # call this here for the side-effect! - var r: TSrcGen - initTokRender(r, n, {renderNoBody, renderNoComments, renderDocComments}) - while true: + 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. + var r: TSrcGen = initTokRender(n, {renderNoBody, renderNoComments, renderDocComments, + renderNoPragmas, renderNoProcDefs, renderExpandUsing, renderNoPostfix}) + while true: getNextTok(r, kind, literal) - case kind - of tkEof: - break - of tkComment: - dispA(result, "<span class=\"Comment\">$1</span>", "\\spanComment{$1}", - [toRope(esc(d.target, literal))]) - of tokKeywordLow..tokKeywordHigh: - dispA(result, "<span class=\"Keyword\">$1</span>", "\\spanKeyword{$1}", - [toRope(literal)]) - of tkOpr: - dispA(result, "<span class=\"Operator\">$1</span>", "\\spanOperator{$1}", - [toRope(esc(d.target, literal))]) - of tkStrLit..tkTripleStrLit: - dispA(result, "<span class=\"StringLit\">$1</span>", - "\\spanStringLit{$1}", [toRope(esc(d.target, literal))]) - of tkCharLit: - dispA(result, "<span class=\"CharLit\">$1</span>", "\\spanCharLit{$1}", - [toRope(esc(d.target, literal))]) - of tkIntLit..tkUInt64Lit: - dispA(result, "<span class=\"DecNumber\">$1</span>", - "\\spanDecNumber{$1}", [toRope(esc(d.target, literal))]) - of tkFloatLit..tkFloat128Lit: - dispA(result, "<span class=\"FloatNumber\">$1</span>", - "\\spanFloatNumber{$1}", [toRope(esc(d.target, literal))]) - of tkSymbol: - dispA(result, "<span class=\"Identifier\">$1</span>", - "\\spanIdentifier{$1}", [toRope(esc(d.target, literal))]) - of tkSpaces, tkInvalid: - app(result, literal) - of tkParLe, tkParRi, tkBracketLe, tkBracketRi, tkCurlyLe, tkCurlyRi, - tkBracketDotLe, tkBracketDotRi, tkCurlyDotLe, tkCurlyDotRi, tkParDotLe, - tkParDotRi, tkComma, tkSemiColon, tkColon, tkEquals, tkDot, tkDotDot, - tkAccent, tkColonColon, - tkGStrLit, tkGTripleStrLit, tkInfixOpr, tkPrefixOpr, tkPostfixOpr: - dispA(result, "<span class=\"Other\">$1</span>", "\\spanOther{$1}", - [toRope(esc(d.target, literal))]) + if kind == tkEof: + break + plainName.add(literal) + + var pragmaNode = getDeclPragma(n) + if pragmaNode != nil: pragmaNode = findPragma(pragmaNode, wDeprecated) + inc(d.id) - app(d.section[k], ropeFormatNamedVars(getConfigVar("doc.item"), - ["name", "header", "desc", "itemID"], - [name, result, comm, toRope(d.id)])) - app(d.toc[k], ropeFormatNamedVars(getConfigVar("doc.item.toc"), - ["name", "header", "desc", "itemID"], [ - toRope(getName(d, nameNode, d.splitAfter)), result, comm, toRope(d.id)])) - setIndexTerm(d[], $d.id, getName(d, nameNode)) - -proc checkForFalse(n: PNode): bool = - result = n.kind == nkIdent and IdentEq(n.ident, "false") - -proc traceDeps(d: PDoc, n: PNode) = + let + 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) + plainSymbolEnc = encodeUrl(cleanPlainSymbol, usePlus = false) + symbolOrId = d.newUniquePlainSymbol(complexSymbol) + 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 = 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 = 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) + +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 d.section[k] != nil: app(d.section[k], ", ") - dispA(d.section[k], - "<a class=\"reference external\" href=\"$1.html\">$1</a>", - "$1", [toRope(getModuleName(n))]) + 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[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: + result = nil + +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 -proc generateDoc*(d: PDoc, n: PNode) = + 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: app(d.modDesc, genComment(d, n)) - of nkProcDef: - when useEffectSystem: documentRaises(n) - genItem(d, n, n.sons[namePos], skProc) + 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) + genItemAux(skProc) of nkMethodDef: - when useEffectSystem: documentRaises(n) - genItem(d, n, n.sons[namePos], skMethod) - of nkIteratorDef: - when useEffectSystem: documentRaises(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) + when useEffectSystem: documentRaises(d.cache, n) + genItemAux(skMethod) + of nkIteratorDef: + when useEffectSystem: documentRaises(d.cache, n) + genItemAux(skIterator) + of nkMacroDef: genItemAux(skMacro) + of nkTemplateDef: genItemAux(skTemplate) of nkConverterDef: - when useEffectSystem: documentRaises(n) - genItem(d, n, n.sons[namePos], skConverter) + when useEffectSystem: documentRaises(d.cache, n) + 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))) - of nkStmtList: - for i in countup(0, sonsLen(n) - 1): generateDoc(d, n.sons[i]) - of nkWhenStmt: + genItem(d, n[i], n[i][0], + succ(skType, ord(n.kind)-ord(nkTypeSection)), docFlags, showNonExports) + of nkStmtList: + 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]) - else: nil - -proc genSection(d: PDoc, kind: TSymKind) = - const sectionNames: array[skModule..skTemplate, string] = [ - "Imports", "Types", "Vars", "Lets", "Consts", "Vars", "Procs", "Methods", - "Iterators", "Converters", "Macros", "Templates" + 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 overloadGroupName(s: string, k: TSymKind): string = + ## Turns a name like `f` into anchor `f-procs-all` + s & "-" & k.toHumanStr & "s-all" + +proc setIndexTitle(d: PDoc, useMetaTitle: bool) = + let titleKind = if d.standaloneDoc: ieMarkupTitle else: ieNimTitle + let external = AbsoluteFile(d.destFile) + .relativeTo(d.conf.outDir, '/') + .changeFileExt(HtmlExt) + .string + var term, linkTitle: string + if useMetaTitle and d.meta[metaTitle].len != 0: + term = d.meta[metaTitleRaw] + linkTitle = d.meta[metaTitleRaw] + else: + let filename = extractFilename(d.filename) + term = + if d.standaloneDoc: filename # keep .rst/.md extension + else: changeFileExt(filename, "") # rm .nim extension + linkTitle = + if d.standaloneDoc: term # keep .rst/.md extension + else: canonicalImport(d.conf, AbsoluteFile d.filename) + if not d.standaloneDoc: + linkTitle = "module " & linkTitle + setIndexTerm(d[], titleKind, htmlFile = external, id = "", + term = term, linkTitle = linkTitle) + +proc finishGenerateDoc*(d: var PDoc) = + ## Perform 2nd RST pass for resolution of links/footnotes/headings... + # copy file map `filenames` to ``rstgen.nim`` for its warnings + d.filenames = d.sharedState.filenames + + # Main title/subtitle are allowed only in the first RST fragment of document + var firstRst = PRstNode(nil) + for fragment in d.modDescPre: + if fragment.isRst: + firstRst = fragment.rst + break + d.hasToc = d.hasToc or d.sharedState.hasToc + # in --index:only mode we do NOT want to load other .idx, only write ours: + let importdoc = optGenIndexOnly notin d.conf.globalOptions and + optNoImportdoc notin d.conf.globalOptions + preparePass2(d.sharedState, firstRst, importdoc) + + if optGenIndexOnly in d.conf.globalOptions: + # Top-level doc.comments may contain titles and :idx: statements: + for fragment in d.modDescPre: + if fragment.isRst: + traverseForIndex(d[], fragment.rst) + setIndexTitle(d, useMetaTitle = d.standaloneDoc) + # Symbol-associated doc.comments may contain :idx: statements: + for k in TSymKind: + for _, overloadChoices in d.section[k].secItems: + for item in overloadChoices: + for fragment in item.descRst: + if fragment.isRst: + traverseForIndex(d[], fragment.rst) + + # add anchors to overload groups before RST resolution + for k in TSymKind: + if k in routineKinds: + for plainName, overloadChoices in d.section[k].secItems: + if overloadChoices.len > 1: + let refn = overloadGroupName(plainName, k) + let tooltip = "$1 ($2 overloads)" % [ + k.toHumanStr & " " & plainName, $overloadChoices.len] + let name = nimIdentBackticksNormalize(plainName) + # save overload group to ``.idx`` + let external = d.destFile.AbsoluteFile.relativeTo(d.conf.outDir, '/'). + changeFileExt(HtmlExt).string + setIndexTerm(d[], ieNimGroup, htmlFile = external, id = refn, + term = name, linkTitle = k.toHumanStr, + linkDesc = "", line = overloadChoices[0].info.line.int) + if optGenIndexOnly in d.conf.globalOptions: continue + addAnchorNim(d.sharedState, external=false, refn, tooltip, + LangSymbol(symKind: k.toHumanStr, + name: name, + isGroup: true), + priority = symbolPriority(k), + # select index `0` just to have any meaningful warning: + info = overloadChoices[0].info, + module = addRstFileIndex(d, FileIndex d.module.position)) + + if optGenIndexOnly in d.conf.globalOptions: + return + + # Finalize fragments of ``.nim`` or ``.rst`` file + proc renderItemPre(d: PDoc, fragments: ItemPre, result: var string) = + for f in fragments: + case f.isRst: + of true: + var resolved = resolveSubs(d.sharedState, f.rst) + renderRstToOut(d[], resolved, result) + of false: result &= f.str + proc cmp(x, y: Item): int = cmpDecimalsIgnoreCase(x.sortName, y.sortName) + for k in TSymKind: + # add symbols to section for each `k`, while optionally wrapping + # overloadable items with the same basic name by ``doc.item2`` + let overloadableNames = toSeq(keys(d.section[k].secItems)) + for plainName in overloadableNames.sorted(cmpDecimalsIgnoreCase): + var overloadChoices = d.section[k].secItems[plainName] + overloadChoices.sort(cmp) + var nameContent = "" + for item in overloadChoices: + var itemDesc: string = "" + renderItemPre(d, item.descRst, itemDesc) + nameContent.add( + getConfigVar(d.conf, "doc.item") % ( + item.substitutions & @[ + "desc", itemDesc, + "name", item.name, + "itemSymOrID", item.anchor])) + if k in routineKinds: + let plainNameEsc1 = esc(d.target, plainName.strip) + let plainNameEsc2 = esc(d.target, plainName.strip, escMode=emUrl) + d.section[k].finalMarkup.add( + getConfigVar(d.conf, "doc.item2") % ( + @["header_plain", plainNameEsc1, + "overloadGroupName", overloadGroupName(plainNameEsc2, k), + "content", nameContent])) + else: + d.section[k].finalMarkup.add(nameContent) + d.section[k].secItems.clear + renderItemPre(d, d.modDescPre, d.modDescFinal) + d.modDescPre.setLen 0 + + # Finalize fragments of ``.json`` file + for i, entry in d.jEntriesPre: + if entry.rst != nil: + let resolved = resolveSubs(d.sharedState, entry.rst) + var str: string = "" + renderRstToOut(d[], resolved, str) + entry.json[entry.rstField] = %str + d.jEntriesPre[i].rst = nil + + d.jEntriesFinal.add entry.json # generates docs + + setIndexTitle(d, useMetaTitle = d.standaloneDoc) + completePass2(d.sharedState) + +proc add(d: PDoc; j: JsonItem) = + if j.json != nil or j.rst != nil: d.jEntriesPre.add j + +proc generateJson*(d: PDoc, n: PNode, config: ConfigRef, includeComments: bool = true) = + case n.kind + of nkPragma: + let doctypeNode = findPragma(n, wDoctype) + setDoctype(d, doctypeNode) + of nkCommentStmt: + if includeComments: + d.add 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[namePos], skProc) + of nkMethodDef: + when useEffectSystem: documentRaises(d.cache, n) + d.add genJsonItem(d, n, n[namePos], skMethod) + of nkIteratorDef: + when useEffectSystem: documentRaises(d.cache, n) + d.add genJsonItem(d, n, n[namePos], skIterator) + of nkMacroDef: + d.add genJsonItem(d, n, n[namePos], skMacro) + of nkTemplateDef: + d.add genJsonItem(d, n, n[namePos], skTemplate) + of nkConverterDef: + when useEffectSystem: documentRaises(d.cache, n) + d.add genJsonItem(d, n, n[namePos], skConverter) + of nkTypeSection, nkVarSection, nkLetSection, nkConstSection: + for i in 0..<n.len: + if n[i].kind != nkCommentStmt: + # order is always 'type var let const': + d.add genJsonItem(d, n[i], n[i][0], + succ(skType, ord(n.kind)-ord(nkTypeSection)), optShowNonExportedFields in config.globalOptions) + of nkStmtList: + 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[0][0]): + generateJson(d, lastSon(n[0]), config, includeComments) + else: discard + +proc genTagsItem(d: PDoc, n, nameNode: PNode, k: TSymKind): string = + result = getNameEsc(d, nameNode) & "\n" + +proc generateTags*(d: PDoc, n: PNode, r: var string) = + case n.kind + of nkCommentStmt: + 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[namePos], skProc) + of nkFuncDef: + when useEffectSystem: documentRaises(d.cache, n) + r.add genTagsItem(d, n, n[namePos], skFunc) + of nkMethodDef: + when useEffectSystem: documentRaises(d.cache, n) + r.add genTagsItem(d, n, n[namePos], skMethod) + of nkIteratorDef: + when useEffectSystem: documentRaises(d.cache, n) + r.add genTagsItem(d, n, n[namePos], skIterator) + of nkMacroDef: + r.add genTagsItem(d, n, n[namePos], skMacro) + of nkTemplateDef: + r.add genTagsItem(d, n, n[namePos], skTemplate) + of nkConverterDef: + when useEffectSystem: documentRaises(d.cache, n) + r.add genTagsItem(d, n, n[namePos], skConverter) + of nkTypeSection, nkVarSection, nkLetSection, nkConstSection: + for i in 0..<n.len: + if n[i].kind != nkCommentStmt: + # order is always 'type var let const': + r.add genTagsItem(d, n[i], n[i][0], + succ(skType, ord(n.kind)-ord(nkTypeSection))) + of nkStmtList: + for i in 0..<n.len: + generateTags(d, n[i], r) + of nkWhenStmt: + # generate documentation for the first branch only: + if not checkForFalse(n[0][0]): + generateTags(d, lastSon(n[0]), r) + else: discard + +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", "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].toRope - d.section[kind] = ropeFormatNamedVars(getConfigVar("doc.section"), [ - "sectionid", "sectionTitle", "sectionTitleID", "content"], [ - ord(kind).toRope, title, toRope(ord(kind) + 50), d.section[kind]]) - d.toc[kind] = ropeFormatNamedVars(getConfigVar("doc.section.toc"), [ - "sectionid", "sectionTitle", "sectionTitleID", "content"], [ - ord(kind).toRope, title, toRope(ord(kind) + 50), d.toc[kind]]) - -proc genOutFile(d: PDoc): PRope = + + # 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: PRope + code, content: string = "" title = "" var j = 0 - var tmp = "" - renderTocEntries(d[], j, 1, tmp) - var toc = tmp.toRope - for i in countup(low(TSymKind), high(TSymKind)): - genSection(d, i) - app(toc, d.toc[i]) - if toc != nil: - toc = ropeFormatNamedVars(getConfigVar("doc.toc"), ["content"], [toc]) - for i in countup(low(TSymKind), high(TSymKind)): app(code, d.section[i]) - if d.meta[metaTitle].len != 0: title = d.meta[metaTitle] - else: title = "Module " & extractFilename(changeFileExt(d.filename, "")) - - let bodyname = if d.hasToc: "doc.body_toc" else: "doc.body_no_toc" - content = ropeFormatNamedVars(getConfigVar(bodyname), ["title", - "tableofcontents", "moduledesc", "date", "time", "content"], - [title.toRope, toc, d.modDesc, toRope(getDateStr()), - toRope(getClockStr()), code]) - if optCompileOnly notin gGlobalOptions: + 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] + else: + 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" + 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(getConfigVar("doc.file"), ["title", - "tableofcontents", "moduledesc", "date", "time", - "content", "author", "version"], - [title.toRope, toc, d.modDesc, toRope(getDateStr()), - toRope(getClockStr()), content, d.meta[metaAuthor].toRope, - d.meta[metaVersion].toRope]) - else: + 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 gGlobalOptions: - writeIndexFile(d[], splitFile(options.outFile).dir / - splitFile(d.filename).name & indexExt) - -proc writeOutput*(d: PDoc, filename, outExt: string, useWarning = false) = - var content = genOutFile(d) - if optStdout in gGlobalOptions: - writeRope(stdout, content) + if optGenIndex in d.conf.globalOptions: + 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: + write(stdout, content) + else: + template outfile: untyped = d.destFile.AbsoluteFile + #let outfile = getOutFile2(d.conf, shortenDir(d.conf, filename), outExt) + let dir = outfile.splitFile.dir + createDir(dir) + updateOutfile(d, outfile) + 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), + "moduleDescription": modDesc, + "entries": d.jEntriesFinal} + if optStdout in d.conf.globalOptions: + writeLine(stdout, $content) else: - writeRope(content, getOutFile(filename, outExt), useWarning) - -proc CommandDoc*() = - var ast = parseFile(gProjectMainIdx) - if ast == nil: return - var d = newDocumentor(gProjectFull, options.gConfigVars) - d.hasToc = true - generateDoc(d, ast) - writeOutput(d, gProjectFull, HtmlExt) + 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: + 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, hasToc = true) + generateDoc(d, ast, ast, conf) + finishGenerateDoc(d) + writeOutput(d) generateIndex(d) -proc CommandRstAux(filename, outExt: string) = +proc commandRstAux(cache: IdentCache, conf: ConfigRef; + filename: AbsoluteFile, outExt: string, + preferMarkdown: bool) = var filen = addFileExt(filename, "txt") - var d = newDocumentor(filen, options.gConfigVars) - var rst = parseRst(readFile(filen), filen, 0, 1, d.hasToc, - {roSupportRawDirective}) - var modDesc = newStringOfCap(30_000) - #d.modDesc = newMutableRope(30_000) - renderRstToOut(d[], rst, modDesc) - #freezeMutableRope(d.modDesc) - d.modDesc = toRope(modDesc) - writeOutput(d, filename, outExt) - generateIndex(d) + 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, 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: + write(stdout, content) + else: + #echo getOutFile(gProjectFull, JsonExt) + 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, 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 = "" + generateTags(d, ast, content) + + if optStdout in d.conf.globalOptions: + write(stdout, content) + else: + #echo getOutFile(gProjectFull, TagsExt) + 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 + + 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) -proc CommandRst2Html*() = - CommandRstAux(gProjectFull, HtmlExt) - -proc CommandRst2TeX*() = - splitter = "\\-" - CommandRstAux(gProjectFull, TexExt) - -proc CommandBuildIndex*() = - var content = mergeIndexes(gProjectFull).toRope - - let code = ropeFormatNamedVars(getConfigVar("doc.file"), ["title", - "tableofcontents", "moduledesc", "date", "time", - "content", "author", "version"], - ["Index".toRope, nil, nil, toRope(getDateStr()), - toRope(getClockStr()), content, nil, nil]) - writeRope(code, getOutFile("theindex", HtmlExt)) + try: + writeFile(filename, $body) + except IOError: + rawMessage(conf, errCannotOpenFile, filename.string) diff --git a/compiler/docgen2.nim b/compiler/docgen2.nim index d48f53d15..7fb11a3bd 100644 --- a/compiler/docgen2.nim +++ b/compiler/docgen2.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -10,40 +10,71 @@ # This module implements a new documentation generator that runs after # semantic checking. -import - os, options, ast, astalgo, msgs, ropes, idents, passes, docgen +import + options, ast, msgs, docgen, lineinfos, pathutils, packages -type - TGen = object of TPassContext +from modulegraphs import ModuleGraph, PPassContext + +type + TGen = object of PPassContext doc: PDoc module: PSym + config: ConfigRef PGen = ref TGen -proc close(p: PPassContext, n: PNode): PNode = +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 - if gWholeProject or sfMainModule in g.module.flags: - writeOutput(g.doc, g.module.filename, HtmlExt, useWarning) + let groupedToc = true + if shouldProcess(g): + finishGenerateDoc(g.doc) + body try: generateIndex(g.doc) - except EIO: - nil + except IOError: + discard + +proc closeDoc*(graph: ModuleGraph; p: PPassContext, n: PNode): PNode = + result = nil + closeImpl: + writeOutput(g.doc, useWarning, groupedToc) + +proc closeJson*(graph: ModuleGraph; p: PPassContext, n: PNode): PNode = + result = nil + closeImpl: + writeOutputJson(g.doc, useWarning) -proc processNode(c: PPassContext, n: PNode): PNode = +proc processNode*(c: PPassContext, n: PNode): PNode = result = n var g = PGen(c) - generateDoc(g.doc, n) + if shouldProcess(g): + generateDoc(g.doc, n, n, g.config) -proc myOpen(module: PSym): PPassContext = +proc processNodeJson*(c: PPassContext, n: PNode): PNode = + result = n + var g = PGen(c) + if shouldProcess(g): + generateJson(g.doc, n, g.config, false) + +template myOpenImpl(ext: untyped) {.dirty.} = var g: PGen new(g) g.module = module - var d = newDocumentor(module.filename, options.gConfigVars) - 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) +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) = - nil +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 21a131996..9871c81af 100644 --- a/compiler/evalffi.nim +++ b/compiler/evalffi.nim @@ -1,75 +1,93 @@ # # -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # -## This file implements the FFI part of the evaluator for Nimrod code. +## This file implements the FFI part of the evaluator for Nim code. -import ast, astalgo, ropes, types, options, tables, dynlib, libffi, msgs +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]() - gExeHandle = LoadLib() + gDllCache = initTable[string, LibHandle]() + +when defined(windows): + 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 -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[TAddress](system.stdin) - of "stdout": result.intVal = cast[TAddress](system.stdout) - of "stderr": result.intVal = cast[TAddress](system.stderr) - 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.checkedSymAddr(name) - else: - let dllhandle = gDllCache.getDll(lib.path.strVal, sym.info) - theAddr = dllhandle.checkedSymAddr(name) - result.intVal = cast[TAddress](theAddr) + let dllhandle = getDll(conf, gDllCache, libcDll, sym.info) + theAddr = dllhandle.symAddr(name.cstring) + elif not lib.isNil: + let dll = if lib.kind == libHeader: libcDll else: lib.path.strVal + libPathMsg = dll + let dllhandle = getDll(conf, gDllCache, dll, sym.info) + theAddr = dllhandle.symAddr(name.cstring) + if theAddr.isNil: globalError(conf, sym.info, + "cannot import symbol: " & name & " from " & libPathMsg) + result.intVal = cast[int](theAddr) -proc mapType(t: ast.PType): ptr libffi.TType = +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 @@ -77,92 +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, tyPointer, tyPtr, tyRef, tyCString, tySequence, tyString, tyExpr, - tyStmt, tyTypeDesc, tyProc, tyArray, tyArrayConstr, tyNil: + of tyVar, tyLent, tyPointer, tyPtr, tyRef, tyCstring, tySequence, tyString, tyUntyped, + tyTyped, tyTypeDesc, tyProc, tyArray, tyStatic, tyNil: result = addr libffi.type_pointer - of tyDistinct: - result = mapType(t.sons[0]) + of tyDistinct, tyAlias, tySink: + 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: expr): expr {.immediate.} = (cast[ptr T](p))[] -template wr(T, p, v: expr) {.immediate.} = (cast[ptr T](p))[] = v -template `+!`(x, y: expr): expr {.immediate.} = - cast[pointer](cast[TAddress](x) + y) +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[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: + of tyPtr, tyRef, tyVar, tyLent: if v.kind in {nkNilLit, nkPtrLit}: result = sizeof(pointer) else: - result = sizeof(pointer) + packSize(v.sons[0], typ.sons[0]) - of tyDistinct, tyGenericInst: - result = packSize(v, typ.sons[0]) - of tyArray, tyArrayConstr: + result = sizeof(pointer) + packSize(conf, v[0], typ.elementType) + of tyDistinct, tyGenericInst, tyAlias, tySink: + 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) - if result != nil: return + 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: nil + else: result = nil + else: result = nil -proc packObject(x: PNode, typ: PType, res: pointer) = - InternalAssert x.kind in {nkObjConstr, nkPar} +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: - GlobalError(x.info, "cannot pack unnamed tuple") + # XXX: todo + 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: expr) {.immediate, dirty.} = - 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) @@ -178,111 +202,111 @@ 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 - nil + discard elif v.kind == nkPtrLit: awr(pointer, cast[pointer](v.intVal)) elif v.kind in {nkStrLit..nkTripleStrLit}: awr(cstring, cstring(v.strVal)) else: - GlobalError(v.info, "cannot map pointer/proc value to FFI") - of tyPtr, tyRef, tyVar: + 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 - nil + discard elif v.kind == nkPtrLit: awr(pointer, cast[pointer](v.intVal)) 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.sons[0], res +! sizeof(pointer)) + pack(conf, v[0], typ.elementType, res +! sizeof(pointer)) dec packRecCheck awr(pointer, res +! sizeof(pointer)) - of tyArray, tyArrayConstr: - let baseSize = typ.sons[1].getSize - for i in 0 .. <v.len: - pack(v.sons[i], typ.sons[1], res +! i * baseSize) + of tyArray: + 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: - nil - of tyDistinct, tyGenericInst: - pack(v, typ.sons[0], res) + discard + of tyDistinct, tyGenericInst, tyAlias, tySink: + 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: nil + 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: if n.isNil: - result = newNode(nkPar) + 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}: - GlobalError(n.info, "cannot map value from FFI") + if result.kind notin {nkObjConstr, nkPar, nkTupleConstr}: + 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 @@ -291,8 +315,8 @@ proc canonNodeKind(k: TNodeKind): TNodeKind = of nkStrLit..nkTripleStrLit: result = nkStrLit else: result = k -proc unpack(x: pointer, typ: PType, n: PNode): PNode = - template aw(k, v, field: expr) {.immediate, dirty.} = +proc unpack(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode = + template aw(k, v, field: untyped): untyped = if n.isNil: result = newNode(k) result.typ = typ @@ -303,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() = @@ -313,13 +337,13 @@ 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: expr) {.immediate, dirty.} = aw(kind, v, intVal) - template awf(kind, v: expr) {.immediate, dirty.} = aw(kind, v, floatVal) - template aws(kind, v: expr) {.immediate, dirty.} = aw(kind, v, strVal) - + template awi(kind, v: untyped): untyped = aw(kind, v, intVal) + template awf(kind, v: untyped): untyped = aw(kind, v, floatVal) + template aws(kind, v: untyped): untyped = aw(kind, v, strVal) + case typ.kind of tyBool: awi(nkIntLit, rd(bool, x).ord) of tyChar: awi(nkCharLit, rd(char, x).ord) @@ -328,19 +352,20 @@ proc unpack(x: pointer, typ: PType, n: PNode): PNode = of tyInt16: awi(nkInt16Lit, rd(int16, x)) of tyInt32: awi(nkInt32Lit, rd(int32, x)) of tyInt64: awi(nkInt64Lit, rd(int64, x)) - of tyUInt: awi(nkUIntLit, rd(uint, x).biggestInt) - of tyUInt8: awi(nkUInt8Lit, rd(uint8, x).biggestInt) - of tyUInt16: awi(nkUInt16Lit, rd(uint16, x).biggestInt) - of tyUInt32: awi(nkUInt32Lit, rd(uint32, x).biggestInt) - of tyUInt64: awi(nkUInt64Lit, rd(uint64, x).biggestInt) + of tyUInt: awi(nkUIntLit, rd(uint, x).BiggestInt) + of tyUInt8: awi(nkUInt8Lit, rd(uint8, x).BiggestInt) + of tyUInt16: awi(nkUInt16Lit, rd(uint16, x).BiggestInt) + of tyUInt32: awi(nkUInt32Lit, rd(uint32, x).BiggestInt) + of tyUInt64: awi(nkUInt64Lit, rd(uint64, x).BiggestInt) of tyEnum: - case typ.getSize - 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) + 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)) @@ -353,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[TAddress](p)) - of tyPtr, tyRef, tyVar: + 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[TAddress](p)) + awi(nkPtrLit, cast[int](p)) elif n != nil and n.len == 1: - internalAssert n.kind == nkRefTy - n.sons[0] = unpack(p, typ.sons[0], 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) - of tyArray, tyArrayConstr: - result = unpackArray(x, typ, n) - of tyCString, tyString: + result = unpackObject(conf, x, typ, n) + of tyArray: + result = unpackArray(conf, x, typ, n) + of tyCstring, tyString: let p = rd(cstring, x) if p.isNil: setNil() @@ -378,15 +404,16 @@ proc unpack(x: pointer, typ: PType, n: PNode): PNode = aws(nkStrLit, $p) of tyNil: setNil() - of tyDistinct, tyGenericInst: - result = unpack(x, typ.sons[0], n) + of tyDistinct, tyGenericInst, tyAlias, tySink: + 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 = - if x.kind == nkPtrLit and x.typ.kind in {tyPtr, tyRef, tyVar, tyPointer, - tyProc, tyCString, tyString, +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, tySequence}: result = newNodeIT(x.kind, x.info, destTyp) result.intVal = x.intVal @@ -394,50 +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 - - var cif: TCif - var sig: TParamList +proc callForeignFunction*(conf: ConfigRef, call: PNode): PNode = + internalAssert conf, call[0].kind == nkPtrLit + + 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 = emptyNode + + 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*(conf: ConfigRef, fn: PNode, fntyp: PType, + args: var TNodeSeq, start, len: int, + info: TLineInfo): PNode = + internalAssert conf, fn.kind == nkPtrLit + + 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 conf, i+1 < fntyp.len + aTyp = fntyp[i+1] + args[i+start].typ = aTyp + sig[i] = mapType(conf, aTyp) + if sig[i].isNil: globalError(conf, info, "cannot map FFI type") + + 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: ArgList = default(ArgList) + let fn = cast[pointer](fn.intVal) + for i in 0..len-1: + let t = args[i+start].typ + 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(conf, retVal, fntyp[0], nil) + result.info = info + + if retVal != nil: dealloc retVal + for i in 0..len-1: + let t = args[i+start].typ + args[i+start] = unpack(conf, cargs[i], t, args[i+start]) + dealloc cargs[i] diff --git a/compiler/evals.nim b/compiler/evals.nim deleted file mode 100644 index 9655ef952..000000000 --- a/compiler/evals.nim +++ /dev/null @@ -1,1558 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This file implements the evaluator for Nimrod code. -# The evaluator is very slow, but simple. Since this -# is used mainly for evaluating macros and some other -# stuff at compile time, performance is not that -# important. - -import - strutils, magicsys, lists, options, ast, astalgo, trees, treetab, nimsets, - msgs, os, condsyms, idents, renderer, types, passes, semfold, transf, - parser, ropes, rodread, idgen, osproc, streams, evaltempl - -when hasFFI: - import evalffi - -type - PStackFrame* = ref TStackFrame - TStackFrame* = object - prc: PSym # current prc; proc that is evaluated - slots: TNodeSeq # parameters passed to the proc + locals; - # parameters come first - call: PNode - next: PStackFrame # for stacking - - TEvalMode* = enum ## reason for evaluation - emRepl, ## evaluate because in REPL mode - emConst, ## evaluate for 'const' according to spec - emOptimize, ## evaluate for optimization purposes (same as - ## emConst?) - emStatic ## evaluate for enforced compile time eval - ## ('static' context) - - 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] - - TEvalContext* = object of passes.TPassContext - module*: PSym - tos*: PStackFrame # top of stack - lastException*: PNode - callsite: PNode # for 'callsite' magic - mode*: TEvalMode - features: TSandboxFlags - globals*: TIdNodeTable # state of global vars - getType*: proc(n: PNode): PNode {.closure.} - - PEvalContext* = ref TEvalContext - - TEvalFlag = enum - efNone, efLValue - TEvalFlags = set[TEvalFlag] - -const - evalMaxIterations = 500_000 # max iterations of all loops - evalMaxRecDepth = 10_000 # max recursion depth for evaluation - -# other idea: use a timeout! -> Wether code compiles depends on the machine -# the compiler runs on then! Bad idea! - -proc newStackFrame*(): PStackFrame = - new(result) - result.slots = @[] - -proc newEvalContext*(module: PSym, mode: TEvalMode): PEvalContext = - new(result) - result.module = module - result.mode = mode - result.features = {allowFFI} - initIdNodeTable(result.globals) - -proc pushStackFrame*(c: PEvalContext, t: PStackFrame) {.inline.} = - t.next = c.tos - c.tos = t - -proc popStackFrame*(c: PEvalContext) {.inline.} = - if c.tos != nil: c.tos = c.tos.next - else: InternalError("popStackFrame") - -proc evalMacroCall*(c: PEvalContext, n, nOrig: PNode, sym: PSym): PNode -proc evalAux(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode - -proc raiseCannotEval(c: PEvalContext, info: TLineInfo): PNode = - result = newNodeI(nkExceptBranch, info) - # creating a nkExceptBranch without sons - # means that it could not be evaluated - -proc stackTraceAux(x: PStackFrame) = - if x != nil: - stackTraceAux(x.next) - var info = if x.call != nil: x.call.info else: UnknownLineInfo() - # we now use the same format as in system/except.nim - var s = toFilename(info) - var line = toLineNumber(info) - if line > 0: - add(s, '(') - add(s, $line) - add(s, ')') - if x.prc != nil: - for k in 1..max(1, 25-s.len): add(s, ' ') - add(s, x.prc.name.s) - MsgWriteln(s) - -proc stackTrace(c: PEvalContext, n: PNode, msg: TMsgKind, arg = "") = - MsgWriteln("stack trace: (most recent call last)") - stackTraceAux(c.tos) - LocalError(n.info, msg, arg) - -proc isSpecial(n: PNode): bool {.inline.} = - result = n.kind == nkExceptBranch - -proc myreset(n: PNode) = - when defined(system.reset): - var oldInfo = n.info - reset(n[]) - n.info = oldInfo - -proc evalIf(c: PEvalContext, n: PNode): PNode = - var i = 0 - var length = sonsLen(n) - while (i < length) and (sonsLen(n.sons[i]) >= 2): - result = evalAux(c, n.sons[i].sons[0], {}) - if isSpecial(result): return - if (result.kind == nkIntLit) and (result.intVal != 0): - return evalAux(c, n.sons[i].sons[1], {}) - inc(i) - if (i < length) and (sonsLen(n.sons[i]) < 2): - result = evalAux(c, n.sons[i].sons[0], {}) - else: - result = emptyNode - -proc evalCase(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[0], {}) - if isSpecial(result): return - var res = result - result = emptyNode - for i in countup(1, sonsLen(n) - 1): - if n.sons[i].kind == nkOfBranch: - for j in countup(0, sonsLen(n.sons[i]) - 2): - if overlap(res, n.sons[i].sons[j]): - return evalAux(c, lastSon(n.sons[i]), {}) - else: - result = evalAux(c, lastSon(n.sons[i]), {}) - -var - gWhileCounter: int # Use a counter to prevent endless loops! - # We make this counter global, because otherwise - # nested loops could make the compiler extremely slow. - gNestedEvals: int # count the recursive calls to ``evalAux`` to prevent - # endless recursion - -proc evalWhile(c: PEvalContext, n: PNode): PNode = - while true: - result = evalAux(c, n.sons[0], {}) - if isSpecial(result): return - if getOrdValue(result) == 0: break - result = evalAux(c, n.sons[1], {}) - case result.kind - of nkBreakStmt: - if result.sons[0].kind == nkEmpty: - result = emptyNode # consume ``break`` token - # Bugfix (see tmacro2): but break in any case! - break - of nkExceptBranch, nkReturnToken: break - else: nil - dec(gWhileCounter) - if gWhileCounter <= 0: - if allowInfiniteLoops in c.features: - gWhileCounter = 0 - else: - stackTrace(c, n, errTooManyIterations) - break - -proc evalBlock(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {}) - if result.kind == nkBreakStmt: - if result.sons[0] != nil: - assert(result.sons[0].kind == nkSym) - if n.sons[0].kind != nkEmpty: - assert(n.sons[0].kind == nkSym) - if result.sons[0].sym.id == n.sons[0].sym.id: result = emptyNode - # blocks can only be left with an explicit label now! - #else: - # result = emptyNode # consume ``break`` token - -proc evalFinally(c: PEvalContext, n, exc: PNode): PNode = - var finallyNode = lastSon(n) - if finallyNode.kind == nkFinally: - result = evalAux(c, finallyNode, {}) - if result.kind != nkExceptBranch: result = exc - else: - result = exc - -proc evalTry(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[0], {}) - case result.kind - of nkBreakStmt, nkReturnToken: - nil - of nkExceptBranch: - if sonsLen(result) >= 1: - # creating a nkExceptBranch without sons means that it could not be - # evaluated - var exc = result - var i = 1 - var length = sonsLen(n) - while (i < length) and (n.sons[i].kind == nkExceptBranch): - var blen = sonsLen(n.sons[i]) - if blen == 1: - # general except section: - result = evalAux(c, n.sons[i].sons[0], {}) - exc = result - break - else: - for j in countup(0, blen - 2): - assert(n.sons[i].sons[j].kind == nkType) - if exc.typ.id == n.sons[i].sons[j].typ.id: - result = evalAux(c, n.sons[i].sons[blen - 1], {}) - exc = result - break - inc(i) - result = evalFinally(c, n, exc) - else: result = evalFinally(c, n, emptyNode) - -proc getNullValue(typ: PType, info: TLineInfo): PNode -proc getNullValueAux(obj: PNode, result: PNode) = - case obj.kind - of nkRecList: - for i in countup(0, sonsLen(obj) - 1): getNullValueAux(obj.sons[i], result) - of nkRecCase: - getNullValueAux(obj.sons[0], result) - for i in countup(1, sonsLen(obj) - 1): - getNullValueAux(lastSon(obj.sons[i]), result) - of nkSym: - var s = obj.sym - var p = newNodeIT(nkExprColonExpr, result.info, s.typ) - addSon(p, newSymNode(s, result.info)) - addSon(p, getNullValue(s.typ, result.info)) - addSon(result, p) - else: InternalError(result.info, "getNullValueAux") - -proc getNullValue(typ: PType, info: TLineInfo): PNode = - var t = skipTypes(typ, abstractRange-{tyTypeDesc}) - result = emptyNode - case t.kind - of tyBool, tyEnum, tyChar, tyInt..tyInt64: - result = newNodeIT(nkIntLit, info, t) - of tyUInt..tyUInt64: - result = newNodeIT(nkUIntLit, info, t) - of tyFloat..tyFloat128: - result = newNodeIt(nkFloatLit, info, t) - of tyVar, tyPointer, tyPtr, tyRef, tyCString, tySequence, tyString, tyExpr, - tyStmt, tyTypeDesc, tyProc: - result = newNodeIT(nkNilLit, info, t) - of tyObject: - result = newNodeIT(nkPar, info, t) - getNullValueAux(t.n, result) - # initialize inherited fields: - var base = t.sons[0] - while base != nil: - getNullValueAux(skipTypes(base, skipPtrs).n, result) - base = base.sons[0] - of tyArray, tyArrayConstr: - result = newNodeIT(nkBracket, info, t) - for i in countup(0, int(lengthOrd(t)) - 1): - addSon(result, getNullValue(elemType(t), info)) - of tyTuple: - # XXX nkExprColonExpr is out of fashion ... - result = newNodeIT(nkPar, info, t) - for i in countup(0, sonsLen(t) - 1): - var p = newNodeIT(nkExprColonExpr, info, t.sons[i]) - var field = if t.n != nil: t.n.sons[i].sym else: newSym( - skField, getIdent(":tmp" & $i), t.owner, info) - addSon(p, newSymNode(field, info)) - addSon(p, getNullValue(t.sons[i], info)) - addSon(result, p) - of tySet: - result = newNodeIT(nkCurly, info, t) - else: InternalError("getNullValue: " & $t.kind) - -proc evalVarValue(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n, {}) - if result.kind in {nkType..nkNilLit}: result = result.copyNode - -proc setSlot(c: PStackFrame, sym: PSym, val: PNode) = - assert sym.owner == c.prc - var idx = sym.position - if idx == 0: - idx = c.slots.len - if idx == 0: idx = 1 - sym.position = idx - setLen(c.slots, max(idx+1, c.slots.len)) - c.slots[idx] = val - -proc setVar(c: PEvalContext, v: PSym, n: PNode) = - if sfGlobal notin v.flags: setSlot(c.tos, v, n) - else: IdNodeTablePut(c.globals, v, n) - -proc evalVar(c: PEvalContext, n: PNode): PNode = - for i in countup(0, sonsLen(n) - 1): - let a = n.sons[i] - if a.kind == nkCommentStmt: continue - #assert(a.sons[0].kind == nkSym) can happen for transformed vars - if a.kind == nkVarTuple: - result = evalVarValue(c, a.lastSon) - if result.kind in {nkType..nkNilLit}: - result = result.copyNode - if isSpecial(result): return - if result.kind != nkPar: - return raiseCannotEval(c, n.info) - for i in 0 .. a.len-3: - var v = a.sons[i].sym - setVar(c, v, result.sons[i]) - else: - if a.sons[2].kind != nkEmpty: - result = evalVarValue(c, a.sons[2]) - if isSpecial(result): return - else: - result = getNullValue(a.sons[0].typ, a.sons[0].info) - if a.sons[0].kind == nkSym: - var v = a.sons[0].sym - setVar(c, v, result) - else: - # assign to a.sons[0]: - var x = result - result = evalAux(c, a.sons[0], {}) - if isSpecial(result): return - myreset(x) - x.kind = result.kind - x.typ = result.typ - case x.kind - of nkCharLit..nkInt64Lit: x.intVal = result.intVal - of nkFloatLit..nkFloat64Lit: x.floatVal = result.floatVal - of nkStrLit..nkTripleStrLit: x.strVal = result.strVal - of nkIdent: x.ident = result.ident - of nkSym: x.sym = result.sym - else: - if x.kind notin {nkEmpty..nkNilLit}: - discardSons(x) - for j in countup(0, sonsLen(result) - 1): addSon(x, result.sons[j]) - result = emptyNode - -proc aliasNeeded(n: PNode, flags: TEvalFlags): bool = - result = efLValue in flags or n.typ == nil or - n.typ.kind in {tyExpr, tyStmt, tyTypeDesc} - -proc evalVariable(c: PStackFrame, sym: PSym, flags: TEvalFlags): PNode = - # We need to return a node to the actual value, - # which can be modified. - assert sym.position != 0 or skResult == sym.kind - var x = c - while x != nil: - if sym.owner == x.prc: - result = x.slots[sym.position] - assert result != nil - if not aliasNeeded(result, flags): - result = copyTree(result) - return - x = x.next - #internalError(sym.info, "cannot eval " & sym.name.s & " " & $sym.position) - result = raiseCannotEval(nil, sym.info) - #result = emptyNode - -proc evalGlobalVar(c: PEvalContext, s: PSym, flags: TEvalFlags): PNode = - if sfCompileTime in s.flags or c.mode == emRepl: - result = IdNodeTableGet(c.globals, s) - if result != nil: - if not aliasNeeded(result, flags): - result = copyTree(result) - else: - when hasFFI: - if sfImportc in s.flags and allowFFI in c.features: - result = importcSymbol(s) - IdNodeTablePut(c.globals, s, result) - return result - - result = s.ast - if result == nil or result.kind == nkEmpty: - result = getNullValue(s.typ, s.info) - else: - result = evalAux(c, result, {}) - if isSpecial(result): return - IdNodeTablePut(c.globals, s, result) - else: - result = raiseCannotEval(nil, s.info) - -proc evalCall(c: PEvalContext, n: PNode): PNode = - var d = newStackFrame() - d.call = n - var prc = n.sons[0] - let isClosure = prc.kind == nkClosure - setlen(d.slots, sonsLen(n) + ord(isClosure)) - if isClosure: - #debug prc - result = evalAux(c, prc.sons[1], {efLValue}) - if isSpecial(result): return - d.slots[sonsLen(n)] = result - result = evalAux(c, prc.sons[0], {}) - else: - result = evalAux(c, prc, {}) - - if isSpecial(result): return - prc = result - # bind the actual params to the local parameter of a new binding - if prc.kind != nkSym: - InternalError(n.info, "evalCall " & n.renderTree) - return - d.prc = prc.sym - if prc.sym.kind notin {skProc, skConverter, skMacro}: - InternalError(n.info, "evalCall") - return - for i in countup(1, sonsLen(n) - 1): - result = evalAux(c, n.sons[i], {}) - if isSpecial(result): return - d.slots[i] = result - if n.typ != nil: d.slots[0] = getNullValue(n.typ, n.info) - - when hasFFI: - if sfImportc in prc.sym.flags and allowFFI in c.features: - var newCall = newNodeI(nkCall, n.info, n.len) - newCall.sons[0] = evalGlobalVar(c, prc.sym, {}) - for i in 1 .. <n.len: - newCall.sons[i] = d.slots[i] - return callForeignFunction(newCall) - - pushStackFrame(c, d) - result = evalAux(c, prc.sym.getBody, {}) - if result.kind == nkExceptBranch: return - if n.typ != nil: result = d.slots[0] - popStackFrame(c) - -proc evalArrayAccess(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode = - result = evalAux(c, n.sons[0], flags) - if isSpecial(result): return - var x = result - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var idx = getOrdValue(result) - result = emptyNode - case x.kind - of nkPar: - if (idx >= 0) and (idx < sonsLen(x)): - result = x.sons[int(idx)] - if result.kind == nkExprColonExpr: result = result.sons[1] - if not aliasNeeded(result, flags): result = copyTree(result) - else: - stackTrace(c, n, errIndexOutOfBounds) - of nkBracket, nkMetaNode: - if (idx >= 0) and (idx < sonsLen(x)): - result = x.sons[int(idx)] - if not aliasNeeded(result, flags): result = copyTree(result) - else: - stackTrace(c, n, errIndexOutOfBounds) - of nkStrLit..nkTripleStrLit: - if efLValue in flags: return raiseCannotEval(c, n.info) - result = newNodeIT(nkCharLit, x.info, getSysType(tyChar)) - if (idx >= 0) and (idx < len(x.strVal)): - result.intVal = ord(x.strVal[int(idx) + 0]) - elif idx == len(x.strVal): - nil - else: - stackTrace(c, n, errIndexOutOfBounds) - else: stackTrace(c, n, errNilAccess) - -proc evalFieldAccess(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode = - # a real field access; proc calls have already been transformed - # XXX: field checks! - result = evalAux(c, n.sons[0], flags) - if isSpecial(result): return - var x = result - if x.kind != nkPar: return raiseCannotEval(c, n.info) - # this is performance critical: - var field = n.sons[1].sym - result = x.sons[field.position] - if result.kind == nkExprColonExpr: result = result.sons[1] - if not aliasNeeded(result, flags): result = copyTree(result) - when false: - var field = n.sons[1].sym - for i in countup(0, sonsLen(x) - 1): - var it = x.sons[i] - if it.kind != nkExprColonExpr: - # lookup per index: - result = x.sons[field.position] - if result.kind == nkExprColonExpr: result = result.sons[1] - if not aliasNeeded(result, flags): result = copyTree(result) - return - #InternalError(it.info, "evalFieldAccess") - if it.sons[0].sym.name.id == field.name.id: - result = x.sons[i].sons[1] - if not aliasNeeded(result, flags): result = copyTree(result) - return - stackTrace(c, n, errFieldXNotFound, field.name.s) - result = emptyNode - -proc evalAsgn(c: PEvalContext, n: PNode): PNode = - var a = n.sons[0] - if a.kind == nkBracketExpr and a.sons[0].typ.kind in {tyString, tyCString}: - result = evalAux(c, a.sons[0], {efLValue}) - if isSpecial(result): return - var x = result - result = evalAux(c, a.sons[1], {}) - if isSpecial(result): return - var idx = getOrdValue(result) - - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - if result.kind != nkCharLit: return raiseCannotEval(c, n.info) - - if (idx >= 0) and (idx < len(x.strVal)): - x.strVal[int(idx)] = chr(int(result.intVal)) - else: - stackTrace(c, n, errIndexOutOfBounds) - else: - result = evalAux(c, n.sons[0], {efLValue}) - if isSpecial(result): return - var x = result - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - myreset(x) - x.kind = result.kind - x.typ = result.typ - case x.kind - of nkCharLit..nkInt64Lit: x.intVal = result.intVal - of nkFloatLit..nkFloat64Lit: x.floatVal = result.floatVal - of nkStrLit..nkTripleStrLit: x.strVal = result.strVal - of nkIdent: x.ident = result.ident - of nkSym: x.sym = result.sym - else: - if x.kind notin {nkEmpty..nkNilLit}: - discardSons(x) - for i in countup(0, sonsLen(result) - 1): addSon(x, result.sons[i]) - result = emptyNode - assert result.kind == nkEmpty - -proc evalSwap(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[0], {efLValue}) - if isSpecial(result): return - var x = result - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - if x.kind != result.kind: - stackTrace(c, n, errCannotInterpretNodeX, $n.kind) - else: - case x.kind - of nkCharLit..nkInt64Lit: swap(x.intVal, result.intVal) - of nkFloatLit..nkFloat64Lit: swap(x.floatVal, result.floatVal) - of nkStrLit..nkTripleStrLit: swap(x.strVal, result.strVal) - of nkIdent: swap(x.ident, result.ident) - of nkSym: swap(x.sym, result.sym) - else: - var tmpn = copyTree(x) - discardSons(x) - for i in countup(0, sonsLen(result) - 1): addSon(x, result.sons[i]) - discardSons(result) - for i in countup(0, sonsLen(tmpn) - 1): addSon(result, tmpn.sons[i]) - result = emptyNode - -proc evalSym(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode = - var s = n.sym - case s.kind - of skProc, skConverter, skMacro, skType: - result = n - #result = s.getBody - of skVar, skLet, skForVar, skTemp, skResult: - if sfGlobal notin s.flags: - result = evalVariable(c.tos, s, flags) - else: - result = evalGlobalVar(c, s, flags) - of skParam: - # XXX what about LValue? - if s.position + 1 <% c.tos.slots.len: - result = c.tos.slots[s.position + 1] - of skConst: result = s.ast - of skEnumField: result = newIntNodeT(s.position, n) - else: result = nil - let mask = if hasFFI and allowFFI in c.features: {sfForward} - else: {sfImportc, sfForward} - if result == nil or mask * s.flags != {}: - result = raiseCannotEval(c, n.info) - -proc evalIncDec(c: PEvalContext, n: PNode, sign: biggestInt): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - case a.kind - of nkCharLit..nkInt64Lit: a.intval = a.intVal + sign * getOrdValue(b) - else: return raiseCannotEval(c, n.info) - result = emptyNode - -proc getStrValue(n: PNode): string = - case n.kind - of nkStrLit..nkTripleStrLit: result = n.strVal - else: - InternalError(n.info, "getStrValue") - result = "" - -proc evalEcho(c: PEvalContext, n: PNode): PNode = - for i in countup(1, sonsLen(n) - 1): - result = evalAux(c, n.sons[i], {}) - if isSpecial(result): return - Write(stdout, getStrValue(result)) - writeln(stdout, "") - result = emptyNode - -proc evalExit(c: PEvalContext, n: PNode): PNode = - if c.mode in {emRepl, emStatic}: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - Message(n.info, hintQuitCalled) - quit(int(getOrdValue(result))) - else: - result = raiseCannotEval(c, n.info) - -proc evalOr(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - if result.kind != nkIntLit: InternalError(n.info, "evalOr") - elif result.intVal == 0: result = evalAux(c, n.sons[2], {}) - -proc evalAnd(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - if result.kind != nkIntLit: InternalError(n.info, "evalAnd") - elif result.intVal != 0: result = evalAux(c, n.sons[2], {}) - -proc evalNew(c: PEvalContext, n: PNode): PNode = - #if c.mode == emOptimize: return raiseCannotEval(c, n.info) - - # we ignore the finalizer for now and most likely forever :-) - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - var t = skipTypes(n.sons[1].typ, abstractVar) - if a.kind == nkEmpty: InternalError(n.info, "first parameter is empty") - myreset(a) - a.kind = nkRefTy - a.info = n.info - a.typ = t - a.sons = nil - addSon(a, getNullValue(t.sons[0], n.info)) - result = emptyNode - -proc evalDeref(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode = - result = evalAux(c, n.sons[0], {efLValue}) - if isSpecial(result): return - case result.kind - of nkNilLit: stackTrace(c, n, errNilAccess) - of nkRefTy: - # XXX efLValue? - result = result.sons[0] - else: - result = raiseCannotEval(c, n.info) - -proc evalAddr(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode = - result = evalAux(c, n.sons[0], {efLValue}) - if isSpecial(result): return - var a = result - var t = newType(tyPtr, c.module) - addSonSkipIntLit(t, a.typ) - result = newNodeIT(nkRefTy, n.info, t) - addSon(result, a) - -proc evalConv(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - if result.typ != nil: - var a = result - result = foldConv(n, a) - if result == nil: - # foldConv() cannot deal with everything that we want to do here: - result = a - -proc evalCast(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode = - if allowCast in c.features: - when hasFFI: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - InternalAssert result.typ != nil - result = fficast(result, n.typ) - else: - result = evalConv(c, n) - else: - result = raiseCannotEval(c, n.info) - -proc evalCheckedFieldAccess(c: PEvalContext, n: PNode, - flags: TEvalFlags): PNode = - result = evalAux(c, n.sons[0], flags) - -proc evalUpConv(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode = - result = evalAux(c, n.sons[0], flags) - if isSpecial(result): return - var dest = skipTypes(n.typ, abstractPtrs) - var src = skipTypes(result.typ, abstractPtrs) - if inheritanceDiff(src, dest) > 0: - stackTrace(c, n, errInvalidConversionFromTypeX, typeToString(src)) - -proc evalRangeChck(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[0], {}) - if isSpecial(result): return - var x = result - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - if leValueConv(a, x) and leValueConv(x, b): - result = x # a <= x and x <= b - result.typ = n.typ - else: - stackTrace(c, n, errGenerated, msgKindToString(errIllegalConvFromXtoY) % [ - typeToString(n.sons[0].typ), typeToString(n.typ)]) - -proc evalConvStrToCStr(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[0], {}) - if isSpecial(result): return - result.typ = n.typ - -proc evalConvCStrToStr(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[0], {}) - if isSpecial(result): return - result.typ = n.typ - -proc evalRaise(c: PEvalContext, n: PNode): PNode = - if c.mode in {emRepl, emStatic}: - if n.sons[0].kind != nkEmpty: - result = evalAux(c, n.sons[0], {}) - if isSpecial(result): return - var a = result - result = newNodeIT(nkExceptBranch, n.info, a.typ) - addSon(result, a) - c.lastException = result - elif c.lastException != nil: - result = c.lastException - else: - stackTrace(c, n, errExceptionAlreadyHandled) - result = newNodeIT(nkExceptBranch, n.info, nil) - addSon(result, ast.emptyNode) - else: - result = raiseCannotEval(c, n.info) - -proc evalReturn(c: PEvalContext, n: PNode): PNode = - if n.sons[0].kind != nkEmpty: - result = evalAsgn(c, n.sons[0]) - if isSpecial(result): return - result = newNodeIT(nkReturnToken, n.info, nil) - -proc evalProc(c: PEvalContext, n: PNode): PNode = - if n.sons[genericParamsPos].kind == nkEmpty: - var s = n.sons[namePos].sym - if (resultPos < sonsLen(n)) and (n.sons[resultPos].kind != nkEmpty): - var v = n.sons[resultPos].sym - result = getNullValue(v.typ, n.info) - if c.tos.slots.len == 0: setLen(c.tos.slots, 1) - c.tos.slots[0] = result - #IdNodeTablePut(c.tos.mapping, v, result) - result = evalAux(c, s.getBody, {}) - if result.kind == nkReturnToken: - result = c.tos.slots[0] - else: - result = evalAux(c, s.getBody, {}) - if result.kind == nkReturnToken: - result = emptyNode - else: - result = emptyNode - -proc evalHigh(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - case skipTypes(n.sons[1].typ, abstractVar).kind - of tyOpenArray, tySequence, tyVarargs: - result = newIntNodeT(sonsLen(result)-1, n) - of tyString: result = newIntNodeT(len(result.strVal) - 1, n) - else: InternalError(n.info, "evalHigh") - -proc evalOf(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - result = newIntNodeT(ord(inheritanceDiff(result.typ, n.sons[2].typ) >= 0), n) - -proc evalSetLengthStr(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - case a.kind - of nkStrLit..nkTripleStrLit: - var newLen = int(getOrdValue(b)) - setlen(a.strVal, newLen) - else: InternalError(n.info, "evalSetLengthStr") - result = emptyNode - -proc evalSetLengthSeq(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - if a.kind != nkBracket: - InternalError(n.info, "evalSetLengthSeq") - return - var newLen = int(getOrdValue(b)) - var oldLen = sonsLen(a) - setlen(a.sons, newLen) - for i in countup(oldLen, newLen - 1): - a.sons[i] = getNullValue(skipTypes(n.sons[1].typ, abstractVar), n.info) - result = emptyNode - -proc evalNewSeq(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - var t = skipTypes(n.sons[1].typ, abstractVar) - if a.kind == nkEmpty: InternalError(n.info, "first parameter is empty") - myreset(a) - a.kind = nkBracket - a.info = n.info - a.typ = t - a.sons = nil - var L = int(getOrdValue(b)) - newSeq(a.sons, L) - for i in countup(0, L-1): - a.sons[i] = getNullValue(t.sons[0], n.info) - result = emptyNode - -proc evalIncl(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - if not inSet(a, b): addSon(a, copyTree(b)) - result = emptyNode - -proc evalExcl(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = newNodeIT(nkCurly, n.info, n.sons[1].typ) - addSon(b, result) - var r = diffSets(a, b) - discardSons(a) - for i in countup(0, sonsLen(r) - 1): addSon(a, r.sons[i]) - result = emptyNode - -proc evalAppendStrCh(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - case a.kind - of nkStrLit..nkTripleStrLit: add(a.strVal, chr(int(getOrdValue(b)))) - else: return raiseCannotEval(c, n.info) - result = emptyNode - -proc evalConStrStr(c: PEvalContext, n: PNode): PNode = - # we cannot use ``evalOp`` for this as we can here have more than 2 arguments - var a = newNodeIT(nkStrLit, n.info, n.typ) - a.strVal = "" - for i in countup(1, sonsLen(n) - 1): - result = evalAux(c, n.sons[i], {}) - if isSpecial(result): return - a.strVal.add(getStrOrChar(result)) - result = a - -proc evalAppendStrStr(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - case a.kind - of nkStrLit..nkTripleStrLit: a.strVal = a.strVal & getStrOrChar(b) - else: return raiseCannotEval(c, n.info) - result = emptyNode - -proc evalAppendSeqElem(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - if a.kind == nkBracket: addSon(a, copyTree(b)) - else: return raiseCannotEval(c, n.info) - result = emptyNode - -proc evalRepr(c: PEvalContext, n: PNode): PNode = - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - result = newStrNodeT(renderTree(result, {renderNoComments}), n) - -proc isEmpty(n: PNode): bool = - result = n != nil and n.kind == nkEmpty - -# The lexer marks multi-line strings as residing at the line where they -# are closed. This function returns the line where the string begins -# Maybe the lexer should mark both the beginning and the end of expressions, -# then this function could be removed. -proc stringStartingLine(s: PNode): int = - result = s.info.line.int - countLines(s.strVal) - -proc evalParseExpr(c: PEvalContext, n: PNode): PNode = - var code = evalAux(c, n.sons[1], {}) - var ast = parseString(code.getStrValue, code.info.toFilename, - code.stringStartingLine) - if sonsLen(ast) != 1: - GlobalError(code.info, errExprExpected, "multiple statements") - result = ast.sons[0] - #result.typ = newType(tyExpr, c.module) - -proc evalParseStmt(c: PEvalContext, n: PNode): PNode = - var code = evalAux(c, n.sons[1], {}) - result = parseString(code.getStrValue, code.info.toFilename, - code.stringStartingLine) - #result.typ = newType(tyStmt, c.module) - -proc evalTypeTrait*(n: PNode, context: PSym): PNode = - ## XXX: This should be pretty much guaranteed to be true - # by the type traits procs' signatures, but until the - # code is more mature it doesn't hurt to be extra safe - internalAssert n.sons.len >= 2 and n.sons[1].kind == nkSym - - let typ = n.sons[1].sym.typ.skipTypes({tyTypeDesc}) - case n.sons[0].sym.name.s.normalize - of "name": - result = newStrNode(nkStrLit, typ.typeToString(preferExported)) - result.typ = newType(tyString, context) - result.info = n.info - else: - internalAssert false - -proc evalIsOp*(n: PNode): PNode = - InternalAssert n.sonsLen == 3 and - n[1].kind == nkSym and n[1].sym.kind == skType and - n[2].kind in {nkStrLit..nkTripleStrLit, nkType} - - let t1 = n[1].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: - let t2 = n[2].typ - var match = if t2.kind == tyTypeClass: matchTypeClass(t2, t1) - else: sameType(t1, t2) - result = newIntNode(nkIntLit, ord(match)) - - result.typ = n.typ - -proc expectString(n: PNode) = - if n.kind notin nkStrKinds: - GlobalError(n.info, errStringLiteralExpected) - -proc evalSlurp*(e: PNode, module: PSym): PNode = - expectString(e) - result = newNodeIT(nkStrLit, e.info, getSysType(tyString)) - try: - var filename = e.strVal.FindFile - result.strVal = readFile(filename) - # we produce a fake include statement for every slurped filename, so that - # the module dependencies are accurate: - appendToModule(module, newNode(nkIncludeStmt, e.info, @[ - newStrNode(nkStrLit, filename)])) - except EIO: - result.strVal = "" - LocalError(e.info, errCannotOpenFile, e.strVal) - -proc readOutput(p: PProcess): string = - result = "" - var output = p.outputStream - discard p.waitForExit - while not output.atEnd: - result.add(output.readLine) - -proc evalStaticExec*(cmd, input: PNode): PNode = - expectString(cmd) - var p = startCmd(cmd.strVal) - if input != nil: - expectString(input) - p.inputStream.write(input.strVal) - p.inputStream.close() - result = newStrNode(nkStrLit, p.readOutput) - result.typ = getSysType(tyString) - result.info = cmd.info - -proc evalExpandToAst(c: PEvalContext, original: PNode): PNode = - var - n = original.copyTree - macroCall = n.sons[1] - expandedSym = macroCall.sons[0].sym - - for i in countup(1, macroCall.sonsLen - 1): - macroCall.sons[i] = evalAux(c, macroCall.sons[i], {}) - - case expandedSym.kind - of skTemplate: - let genSymOwner = if c.tos != nil and c.tos.prc != nil: - c.tos.prc - else: - c.module - result = evalTemplate(macroCall, expandedSym, genSymOwner) - of skMacro: - # At this point macroCall.sons[0] is nkSym node. - # To be completely compatible with normal macro invocation, - # we want to replace it with nkIdent node featuring - # the original unmangled macro name. - macroCall.sons[0] = newIdentNode(expandedSym.name, expandedSym.info) - result = evalMacroCall(c, macroCall, original, expandedSym) - else: - InternalError(macroCall.info, - "ExpandToAst: expanded symbol is no macro or template") - result = emptyNode - -proc evalMagicOrCall(c: PEvalContext, n: PNode): PNode = - var m = getMagic(n) - case m - of mNone: result = evalCall(c, n) - of mOf: result = evalOf(c, n) - of mSizeOf: result = raiseCannotEval(c, n.info) - of mHigh: result = evalHigh(c, n) - of mExit: result = evalExit(c, n) - of mNew, mNewFinalize: result = evalNew(c, n) - of mNewSeq: result = evalNewSeq(c, n) - of mSwap: result = evalSwap(c, n) - of mInc: result = evalIncDec(c, n, 1) - of ast.mDec: result = evalIncDec(c, n, - 1) - of mEcho: result = evalEcho(c, n) - of mSetLengthStr: result = evalSetLengthStr(c, n) - of mSetLengthSeq: result = evalSetLengthSeq(c, n) - of mIncl: result = evalIncl(c, n) - of mExcl: result = evalExcl(c, n) - of mAnd: result = evalAnd(c, n) - of mOr: result = evalOr(c, n) - of mAppendStrCh: result = evalAppendStrCh(c, n) - of mAppendStrStr: result = evalAppendStrStr(c, n) - of mAppendSeqElem: result = evalAppendSeqElem(c, n) - of mParseExprToAst: result = evalParseExpr(c, n) - of mParseStmtToAst: result = evalParseStmt(c, n) - of mExpandToAst: result = evalExpandToAst(c, n) - of mTypeTrait: - n.sons[1] = evalAux(c, n.sons[1], {}) - result = evalTypeTrait(n, c.module) - of mIs: - n.sons[1] = evalAux(c, n.sons[1], {}) - result = evalIsOp(n) - of mSlurp: result = evalSlurp(evalAux(c, n.sons[1], {}), c.module) - of mStaticExec: - let cmd = evalAux(c, n.sons[1], {}) - let input = if n.sonsLen == 3: evalAux(c, n.sons[2], {}) else: nil - result = evalStaticExec(cmd, input) - of mNLen: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = newNodeIT(nkIntLit, n.info, n.typ) - case a.kind - of nkEmpty..nkNilLit: nil - else: result.intVal = sonsLen(a) - of mNChild: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {efLValue}) - if isSpecial(result): return - var k = getOrdValue(result) - if not (a.kind in {nkEmpty..nkNilLit}) and (k >= 0) and (k < sonsLen(a)): - result = a.sons[int(k)] - if result == nil: result = newNode(nkEmpty) - else: - stackTrace(c, n, errIndexOutOfBounds) - result = emptyNode - of mNSetChild: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {efLValue}) - if isSpecial(result): return - var b = result - result = evalAux(c, n.sons[3], {efLValue}) - if isSpecial(result): return - var k = getOrdValue(b) - if (k >= 0) and (k < sonsLen(a)) and not (a.kind in {nkEmpty..nkNilLit}): - a.sons[int(k)] = result - else: - stackTrace(c, n, errIndexOutOfBounds) - result = emptyNode - of mNAdd: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {efLValue}) - if isSpecial(result): return - addSon(a, result) - result = a - of mNAddMultiple: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {efLValue}) - if isSpecial(result): return - for i in countup(0, sonsLen(result) - 1): addSon(a, result.sons[i]) - result = a - of mNDel: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {efLValue}) - if isSpecial(result): return - var b = result - result = evalAux(c, n.sons[3], {efLValue}) - if isSpecial(result): return - for i in countup(0, int(getOrdValue(result)) - 1): - delSon(a, int(getOrdValue(b))) - result = emptyNode - of mNKind: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var a = result - result = newNodeIT(nkIntLit, n.info, n.typ) - result.intVal = ord(a.kind) - of mNIntVal: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var a = result - result = newNodeIT(nkIntLit, n.info, n.typ) - case a.kind - of nkCharLit..nkInt64Lit: result.intVal = a.intVal - else: stackTrace(c, n, errFieldXNotFound, "intVal") - of mNFloatVal: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var a = result - result = newNodeIT(nkFloatLit, n.info, n.typ) - case a.kind - of nkFloatLit..nkFloat64Lit: result.floatVal = a.floatVal - else: stackTrace(c, n, errFieldXNotFound, "floatVal") - of mNSymbol: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - if result.kind != nkSym: stackTrace(c, n, errFieldXNotFound, "symbol") - of mNIdent: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - if result.kind != nkIdent: stackTrace(c, n, errFieldXNotFound, "ident") - of mNGetType: - var ast = evalAux(c, n.sons[1], {}) - InternalAssert c.getType != nil - result = c.getType(ast) - of mNStrVal: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var a = result - result = newNodeIT(nkStrLit, n.info, n.typ) - case a.kind - of nkStrLit..nkTripleStrLit: result.strVal = a.strVal - else: stackTrace(c, n, errFieldXNotFound, "strVal") - of mNSetIntVal: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - if a.kind in {nkCharLit..nkInt64Lit} and - result.kind in {nkCharLit..nkInt64Lit}: - a.intVal = result.intVal - else: - stackTrace(c, n, errFieldXNotFound, "intVal") - result = emptyNode - of mNSetFloatVal: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - if a.kind in {nkFloatLit..nkFloat64Lit} and - result.kind in {nkFloatLit..nkFloat64Lit}: - a.floatVal = result.floatVal - else: - stackTrace(c, n, errFieldXNotFound, "floatVal") - result = emptyNode - of mNSetSymbol: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {efLValue}) - if isSpecial(result): return - if a.kind == nkSym and result.kind == nkSym: - a.sym = result.sym - else: - stackTrace(c, n, errFieldXNotFound, "symbol") - result = emptyNode - of mNSetIdent: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {efLValue}) - if isSpecial(result): return - if a.kind == nkIdent and result.kind == nkIdent: - a.ident = result.ident - else: - stackTrace(c, n, errFieldXNotFound, "ident") - result = emptyNode - of mNSetType: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {efLValue}) - if isSpecial(result): return - InternalAssert result.kind == nkSym and result.sym.kind == skType - a.typ = result.sym.typ - result = emptyNode - of mNSetStrVal: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - - if a.kind in {nkStrLit..nkTripleStrLit} and - result.kind in {nkStrLit..nkTripleStrLit}: - a.strVal = result.strVal - else: stackTrace(c, n, errFieldXNotFound, "strVal") - result = emptyNode - of mNNewNimNode: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var k = getOrdValue(result) - result = evalAux(c, n.sons[2], {efLValue}) - if result.kind == nkExceptBranch: return - var a = result - if k < 0 or k > ord(high(TNodeKind)): - internalError(n.info, "request to create a NimNode with invalid kind") - result = newNodeI(TNodeKind(int(k)), - if a.kind == nkNilLit: n.info else: a.info) - of mNCopyNimNode: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - result = copyNode(result) - of mNCopyNimTree: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - result = copyTree(result) - of mNBindSym: - # trivial implementation: - result = n.sons[1] - of mStrToIdent: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - if not (result.kind in {nkStrLit..nkTripleStrLit}): - stackTrace(c, n, errFieldXNotFound, "strVal") - return - var a = result - result = newNodeIT(nkIdent, n.info, n.typ) - result.ident = getIdent(a.strVal) - of mIdentToStr: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var a = result - result = newNodeIT(nkStrLit, n.info, n.typ) - if a.kind == nkSym: - result.strVal = a.sym.name.s - else: - if a.kind != nkIdent: InternalError(n.info, "no ident node") - result.strVal = a.ident.s - of mEqIdent: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - var b = result - result = newNodeIT(nkIntLit, n.info, n.typ) - if (a.kind == nkIdent) and (b.kind == nkIdent): - if a.ident.id == b.ident.id: result.intVal = 1 - of mEqNimrodNode: - result = evalAux(c, n.sons[1], {efLValue}) - if isSpecial(result): return - var a = result - result = evalAux(c, n.sons[2], {efLValue}) - if isSpecial(result): return - var b = result - result = newNodeIT(nkIntLit, n.info, n.typ) - if (a == b) or - (b.kind in {nkNilLit, nkEmpty}) and (a.kind in {nkNilLit, nkEmpty}): - result.intVal = 1 - of mNLineInfo: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - result = newStrNodeT(result.info.toFileLineCol, n) - of mNHint: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - Message(n.info, hintUser, getStrValue(result)) - result = emptyNode - of mNWarning: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - Message(n.info, warnUser, getStrValue(result)) - result = emptyNode - of mNError: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - stackTrace(c, n, errUser, getStrValue(result)) - result = emptyNode - of mConStrStr: - result = evalConStrStr(c, n) - of mRepr: - result = evalRepr(c, n) - of mNewString: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var a = result - result = newNodeIT(nkStrLit, n.info, n.typ) - result.strVal = newString(int(getOrdValue(a))) - of mNewStringOfCap: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var a = result - result = newNodeIT(nkStrLit, n.info, n.typ) - result.strVal = newString(0) - of mNCallSite: - if c.callsite != nil: result = c.callsite - else: stackTrace(c, n, errFieldXNotFound, "callsite") - else: - result = evalAux(c, n.sons[1], {}) - if isSpecial(result): return - var a = result - var b: PNode = nil - var cc: PNode = nil - if sonsLen(n) > 2: - result = evalAux(c, n.sons[2], {}) - if isSpecial(result): return - b = result - if sonsLen(n) > 3: - result = evalAux(c, n.sons[3], {}) - if isSpecial(result): return - cc = result - if isEmpty(a) or isEmpty(b) or isEmpty(cc): result = emptyNode - else: result = evalOp(m, n, a, b, cc) - -proc evalAux(c: PEvalContext, n: PNode, flags: TEvalFlags): PNode = - result = emptyNode - dec(gNestedEvals) - if gNestedEvals <= 0: stackTrace(c, n, errTooManyIterations) - case n.kind - of nkSym: result = evalSym(c, n, flags) - of nkType..nkNilLit: - # nkStrLit is VERY common in the traces, so we should avoid - # the 'copyNode' here. - result = n #.copyNode - of nkAsgn, nkFastAsgn: result = evalAsgn(c, n) - of nkCommand..nkHiddenCallConv: - result = evalMagicOrCall(c, n) - of nkDotExpr: result = evalFieldAccess(c, n, flags) - of nkBracketExpr: - result = evalArrayAccess(c, n, flags) - of nkDerefExpr, nkHiddenDeref: result = evalDeref(c, n, flags) - of nkAddr, nkHiddenAddr: result = evalAddr(c, n, flags) - of nkHiddenStdConv, nkHiddenSubConv, nkConv: result = evalConv(c, n) - of nkCurly, nkBracket, nkRange: - # flags need to be passed here for mNAddMultiple :-( - # XXX this is not correct in every case! - var a = copyNode(n) - for i in countup(0, sonsLen(n) - 1): - result = evalAux(c, n.sons[i], flags) - if isSpecial(result): return - addSon(a, result) - result = a - of nkPar, nkClosure: - var a = copyTree(n) - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - if it.kind == nkExprColonExpr: - result = evalAux(c, it.sons[1], flags) - if isSpecial(result): return - a.sons[i].sons[1] = result - else: - result = evalAux(c, it, flags) - if isSpecial(result): return - a.sons[i] = result - result = a - of nkObjConstr: - let t = skipTypes(n.typ, abstractInst) - var a: PNode - if t.kind == tyRef: - result = newNodeIT(nkRefTy, n.info, t) - a = getNullValue(t.sons[0], n.info) - addSon(result, a) - else: - a = getNullValue(t, n.info) - result = a - for i in countup(1, sonsLen(n) - 1): - let it = n.sons[i] - if it.kind == nkExprColonExpr: - let value = evalAux(c, it.sons[1], flags) - if isSpecial(value): return value - a.sons[it.sons[0].sym.position] = value - else: return raiseCannotEval(c, n.info) - of nkWhenStmt, nkIfStmt, nkIfExpr: result = evalIf(c, n) - of nkWhileStmt: result = evalWhile(c, n) - of nkCaseStmt: result = evalCase(c, n) - of nkVarSection, nkLetSection: result = evalVar(c, n) - of nkTryStmt: result = evalTry(c, n) - of nkRaiseStmt: result = evalRaise(c, n) - of nkReturnStmt: result = evalReturn(c, n) - of nkBreakStmt, nkReturnToken: result = n - of nkBlockExpr, nkBlockStmt: result = evalBlock(c, n) - of nkDiscardStmt: result = evalAux(c, n.sons[0], {}) - of nkCheckedFieldExpr: result = evalCheckedFieldAccess(c, n, flags) - of nkObjDownConv: result = evalAux(c, n.sons[0], flags) - of nkObjUpConv: result = evalUpConv(c, n, flags) - of nkChckRangeF, nkChckRange64, nkChckRange: result = evalRangeChck(c, n) - of nkStringToCString: result = evalConvStrToCStr(c, n) - of nkCStringToString: result = evalConvCStrToStr(c, n) - of nkStmtListExpr, nkStmtList, nkModule: - for i in countup(0, sonsLen(n) - 1): - result = evalAux(c, n.sons[i], flags) - case result.kind - of nkExceptBranch, nkReturnToken, nkBreakStmt: break - else: nil - of nkProcDef, nkMethodDef, nkMacroDef, nkCommentStmt, nkPragma, - nkTypeSection, nkTemplateDef, nkConstSection, nkIteratorDef, - nkConverterDef, nkIncludeStmt, nkImportStmt, nkFromStmt: - nil - of nkMetaNode: - result = copyTree(n.sons[0]) - result.typ = n.typ - of nkPragmaBlock: - result = evalAux(c, n.sons[1], flags) - of nkCast: - result = evalCast(c, n, flags) - of nkIdentDefs, nkYieldStmt, nkAsmStmt, nkForStmt, nkPragmaExpr, - nkLambdaKinds, nkContinueStmt, nkIdent, nkParForStmt, nkBindStmt, - nkClosedSymChoice, nkOpenSymChoice: - result = raiseCannotEval(c, n.info) - of nkRefTy: - result = evalAux(c, n.sons[0], flags) - of nkEmpty: - # nkEmpty occurs once in each trace that I looked at - result = n - else: InternalError(n.info, "evalAux: " & $n.kind) - if result == nil: - InternalError(n.info, "evalAux: returned nil " & $n.kind) - inc(gNestedEvals) - -proc tryEval(c: PEvalContext, n: PNode): PNode = - #internalAssert nfTransf in n.flags - var n = transformExpr(c.module, n) - gWhileCounter = evalMaxIterations - gNestedEvals = evalMaxRecDepth - result = evalAux(c, n, {}) - -proc eval*(c: PEvalContext, n: PNode): PNode = - ## eval never returns nil! This simplifies the code a lot and - ## makes it faster too. - result = tryEval(c, n) - if result.kind == nkExceptBranch: - if sonsLen(result) >= 1: - stackTrace(c, n, errUnhandledExceptionX, typeToString(result.typ)) - else: - stackTrace(c, result, errCannotInterpretNodeX, renderTree(n)) - -proc evalConstExprAux(module, prc: PSym, e: PNode, mode: TEvalMode): PNode = - var p = newEvalContext(module, mode) - var s = newStackFrame() - s.call = e - s.prc = prc - pushStackFrame(p, s) - result = tryEval(p, e) - if result != nil and result.kind == nkExceptBranch: result = nil - popStackFrame(p) - -proc evalConstExpr*(module: PSym, e: PNode): PNode = - result = evalConstExprAux(module, nil, e, emConst) - -proc evalStaticExpr*(module: PSym, e: PNode, prc: PSym): PNode = - result = evalConstExprAux(module, prc, e, emStatic) - -proc setupMacroParam(x: PNode): PNode = - result = x - if result.kind == nkHiddenStdConv: result = result.sons[1] - -proc evalMacroCall(c: PEvalContext, n, nOrig: PNode, sym: PSym): PNode = - # XXX GlobalError() is ugly here, but I don't know a better solution for now - inc(evalTemplateCounter) - if evalTemplateCounter > 100: - GlobalError(n.info, errTemplateInstantiationTooNested) - - c.callsite = nOrig - var s = newStackFrame() - s.call = n - s.prc = sym - var L = n.safeLen - if L == 0: L = 1 - setlen(s.slots, L) - # return value: - s.slots[0] = newNodeIT(nkNilLit, n.info, sym.typ.sons[0]) - # setup parameters: - for i in 1 .. < L: s.slots[i] = setupMacroParam(n.sons[i]) - pushStackFrame(c, s) - discard eval(c, sym.getBody) - result = s.slots[0] - popStackFrame(c) - if cyclicTree(result): GlobalError(n.info, errCyclicTree) - dec(evalTemplateCounter) - c.callsite = nil - -proc myOpen(module: PSym): PPassContext = - var c = newEvalContext(module, emRepl) - c.features = {allowCast, allowFFI, allowInfiniteLoops} - pushStackFrame(c, newStackFrame()) - result = c - -var oldErrorCount: int - -proc myProcess(c: PPassContext, n: PNode): PNode = - # don't eval errornous code: - if oldErrorCount == msgs.gErrorCounter: - result = eval(PEvalContext(c), n) - else: - result = n - oldErrorCount = msgs.gErrorCounter - -const evalPass* = makePass(myOpen, nil, myProcess, myProcess) - diff --git a/compiler/evaltempl.nim b/compiler/evaltempl.nim index 05be0e9d3..77c136d63 100644 --- a/compiler/evaltempl.nim +++ b/compiler/evaltempl.nim @@ -1,7 +1,7 @@ # # -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2013 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -9,117 +9,222 @@ ## Template evaluation engine. Now hygienic. -import - strutils, options, ast, astalgo, msgs, os, idents, wordrecg, renderer, - rodread +import options, ast, astalgo, msgs, renderer, lineinfos, idents, trees +import std/strutils type - TemplCtx {.pure, final.} = object + TemplCtx = object owner, genSymOwner: PSym - mapping: TIdTable # every gensym'ed symbol needs to be mapped to some - # new symbol + instLines: bool # use the instantiation lines numbers + 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: 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: - let x = actual.sons[s.position] - if x.kind == nkArgList: - for y in items(x): result.add(y) - else: - result.add copyTree(x) + 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 sfGenSym in s.flags - var x = PSym(IdTableGet(c.mapping, s)) + internalAssert c.config, sfGenSym in s.flags or s.kind == skType + var x = idTableGet(c.mapping, s) if x == nil: - x = copySym(s, false) - x.owner = c.genSymOwner - IdTablePut(c.mapping, s, x) - result.add newSymNode(x, templ.info) + x = copySym(s, c.idgen) + # sem'check needs to set the owner properly later, see bug #9476 + x.owner = nil # c.genSymOwner + #if x.kind == skParam and x.owner.kind == skModule: + # internalAssert c.config, false + idTablePut(c.mapping, s, x) + if sfGenSym in s.flags: + # TODO: getIdent(c.ic, "`" & x.name.s & "`gensym" & $c.instID) + result.add newIdentNode(getIdent(c.ic, x.name.s & "`gensym" & $c.instID), + if c.instLines: actual.info else: templ.info) + else: + result.add newSymNode(x, if c.instLines: actual.info else: templ.info) else: - result.add copyNode(templ) + result.add copyNode(c, templ, actual) of nkNone..nkIdent, nkType..nkNilLit: # atom - result.add copyNode(templ) + 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(templ) - for i in countup(0, sonsLen(templ) - 1): - evalTemplateAux(templ.sons[i], actual, c, res) - result.add res - -when false: - proc evalTemplateAux(templ, actual: PNode, c: var TemplCtx): PNode = - case templ.kind - of nkSym: - var s = templ.sym - if s.owner.id == c.owner.id: - if s.kind == skParam: - result = copyTree(actual.sons[s.position]) - else: - InternalAssert sfGenSym in s.flags - var x = PSym(IdTableGet(c.mapping, s)) - if x == nil: - x = copySym(s, false) - x.owner = c.genSymOwner - IdTablePut(c.mapping, s, x) - result = newSymNode(x, templ.info) - else: - result = copyNode(templ) - of nkNone..nkIdent, nkType..nkNilLit: # atom - result = copyNode(templ) + 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: - result = copyNode(templ) - newSons(result, sonsLen(templ)) - for i in countup(0, sonsLen(templ) - 1): - result.sons[i] = evalTemplateAux(templ.sons[i], actual, c) + 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" + errMissingGenericParamsForTemplate = "'$1' has unspecified generic parameters" + errTemplateInstantiationTooNested = "template instantiation too nested" -proc evalTemplateArgs(n: PNode, s: PSym): PNode = +proc evalTemplateArgs(n: PNode, s: PSym; conf: ConfigRef; fromHlo: bool): PNode = # if the template has zero arguments, it can be called without ``()`` # `n` is then a nkSym or something similar - var a: int - case n.kind - of nkCall, nkInfix, nkPrefix, nkPostfix, nkCommand, nkCallStrLit: - a = sonsLen(n) - else: a = 0 - var f = s.typ.sonsLen - if a > f: GlobalError(n.info, errWrongNumberOfArguments) + var totalParams = case n.kind + of nkCallKinds: n.len-1 + else: 0 + + var + # XXX: Since immediate templates are not subject to the + # standard sigmatching algorithm, they will have a number + # of deficiencies when it comes to generic params: + # Type dependencies between the parameters won't be honoured + # and the bound generic symbols won't be resolvable within + # 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 fromHlo: 0 + else: s.ast[genericParamsPos].len + expectedRegularParams = s.typ.paramsLen + givenRegularParams = totalParams - genericParams + if givenRegularParams < 0: givenRegularParams = 0 + + if totalParams > expectedRegularParams + genericParams: + globalError(conf, n.info, errWrongNumberOfArguments) + + if totalParams < genericParams: + globalError(conf, n.info, errMissingGenericParamsForTemplate % + n.renderTree) result = newNodeI(nkArgList, n.info) - for i in countup(1, f - 1): - var arg = if i < a: n.sons[i] else: copyTree(s.typ.n.sons[i].sym.ast) - if arg == nil or arg.kind == nkEmpty: - LocalError(n.info, errWrongNumberOfArguments) - addSon(result, arg) - -var evalTemplateCounter* = 0 - # to prevent endless recursion in templates instantiation - -proc evalTemplate*(n: PNode, tmpl, genSymOwner: PSym): PNode = - inc(evalTemplateCounter) - if evalTemplateCounter > 100: - GlobalError(n.info, errTemplateInstantiationTooNested) + 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[i].sym.ast + if default.isNil or default.kind == nkEmpty: + localError(conf, n.info, errWrongNumberOfArguments) + result.add newNodeI(nkEmpty, n.info) + else: + result.add default.copyTree + + # add any generic parameters + for i in 1..genericParams: + result.add n[givenRegularParams + i] + +# to prevent endless recursion in template instantiation +const evalTemplateLimit* = 1000 + +proc wrapInComesFrom*(info: TLineInfo; sym: PSym; res: PNode): PNode = + when true: + result = res + result.info = info + if result.kind in {nkStmtList, nkStmtListExpr} and result.len > 0: + result.lastSon.info = info + when false: + # this hack is required to + var x = result + while x.kind == nkStmtListExpr: x = x.lastSon + if x.kind in nkCallKinds: + for i in 1..<x.len: + if x[i].kind in nkCallKinds: + x[i].info = info + else: + result = newNodeI(nkStmtListExpr, info) + var d = newNodeI(nkComesFrom, info) + d.add newSymNode(sym, info) + result.add d + result.add res + result.typ = res.typ + +proc evalTemplate*(n: PNode, tmpl, genSymOwner: PSym; + conf: ConfigRef; + ic: IdentCache; instID: ref int; + idgen: IdGenerator; + fromHlo=false): PNode = + inc(conf.evalTemplateCounter) + if conf.evalTemplateCounter > evalTemplateLimit: + globalError(conf, n.info, errTemplateInstantiationTooNested) result = n # replace each param by the corresponding node: - var args = evalTemplateArgs(n, tmpl) - var ctx: TemplCtx - ctx.owner = tmpl - ctx.genSymOwner = genSymOwner - initIdTable(ctx.mapping) - - let body = tmpl.getBody - if isAtom(body): + var args = evalTemplateArgs(n, tmpl, conf, fromHlo) + 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: - GlobalError(result.info, errIllFormedAstX, + localError(conf, result.info, "illformed AST: " & renderTree(result, {renderNoComments})) else: result = copyNode(body) - #evalTemplateAux(body, args, ctx, result) - for i in countup(0, safeLen(body) - 1): - evalTemplateAux(body.sons[i], args, ctx, result) - - dec(evalTemplateCounter) + 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 efb8e5908..ce25da773 100644 --- a/compiler/extccomp.nim +++ b/compiler/extccomp.nim @@ -1,40 +1,52 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2013 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # -# module for calling the different external C compilers -# some things are read in from the configuration file +# Module providing functions for calling the different external C compilers +# Uses some hard-wired facts about each C/C++ compiler, plus options read +# from a lineinfos file, to provide generalized procedures to compile +# nim files. -import - lists, ropes, os, strutils, osproc, platform, condsyms, options, msgs, crc +import ropes, platform, condsyms, options, msgs, lineinfos, pathutils, modulepaths -type - TSystemCC* = enum - ccNone, ccGcc, ccLLVM_Gcc, ccCLang, ccLcc, ccBcc, ccDmc, ccWcc, ccVcc, - ccTcc, ccPcc, ccUcc, ccIcl, ccGpp +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: hasSwitchRange, # CC allows ranges in switch statements (GNU C) hasComputedGoto, # CC has computed goto (GNU C extension) hasCpp, # CC is/contains a C++ compiler hasAssume, # CC has __assume (Visual C extension) - hasGcGuard # CC supports GC_GUARD to keep stack roots + hasGcGuard, # CC supports GC_GUARD to keep stack roots + hasGnuAsm, # CC's asm uses the absurd GNU assembler syntax + hasDeclspec, # CC has __declspec(X) + hasAttribute, # CC has __attribute__((X)) + hasBuiltinUnreachable # CC has __builtin_unreachable TInfoCCProps* = set[TInfoCCProp] TInfoCC* = tuple[ name: string, # the short name of the compiler - objExt: string, # the compiler's object file extenstion + objExt: string, # the compiler's object file extension optSpeed: string, # the options for optimization for speed optSize: string, # the options for optimization for size compilerExe: string, # the compiler's executable + cppCompiler: string, # name of the C++ compiler's executable (if supported) compileTmpl: string, # the compile command template buildGui: string, # command to build a GUI application buildDll: string, # command to build a shared library buildLib: string, # command to build a static library - linkerExe: string, # the linker's executable + linkerExe: string, # the linker's executable (if not matching compiler's) linkTmpl: string, # command to link files to produce an exe includeCmd: string, # command to add an include dir linkDirCmd: string, # command to add a lib dir @@ -43,123 +55,170 @@ type pic: string, # command for position independent code # used on some platforms asmStmtFrmt: string, # format of ASM statement + structStmtFmt: string, # Format for struct statement + produceAsm: string, # Format how to produce assembler listings + cppXsupport: string, # what to do to enable C++X support props: TInfoCCProps] # properties of the C compiler -# Configuration settings for various compilers. +# Configuration settings for various compilers. # When adding new compilers, the cmake sources could be a good reference: # http://cmake.org/gitweb?p=cmake.git;a=tree;f=Modules/Platform; -template compiler(name: expr, settings: stmt): stmt {.immediate.} = +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", buildGui: " -mwindows", buildDll: " -shared", buildLib: "ar rcs $libfile $objfiles", - linkerExe: "gcc", + linkerExe: "", linkTmpl: "$buildgui $builddll -o $exefile $objfiles $options", includeCmd: " -I", linkDirCmd: " -L", 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", - props: {hasSwitchRange, hasComputedGoto, hasCpp, hasGcGuard}) - -compiler gpp: - result = gcc() - - result.name = "gpp" - result.compilerExe = "g++" - result.linkerExe = "g++" - - result.buildDll = " -mdll" - # XXX: Hmm, I'm keeping this from the previos version, - # but my gcc doesn't even have such an option (is this mingw?) + structStmtFmt: "$1 $3 $2 ", # struct|union [packed] $name + produceAsm: gnuAsmListing, + cppXsupport: "-std=gnu++17 -funsigned-char", + props: {hasSwitchRange, hasComputedGoto, hasCpp, hasGcGuard, hasGnuAsm, + hasAttribute, hasBuiltinUnreachable}) +# LLVM Frontend for GCC/G++ compiler llvmGcc: - result = gcc() - + result = gcc() # Uses settings from GCC + result.name = "llvm_gcc" result.compilerExe = "llvm-gcc" - result.buildLib = "llvm-ar rcs $libfile $objfiles" - result.linkerExe = "llvm-gcc" + result.cppCompiler = "llvm-g++" + when defined(macosx) or defined(openbsd): + # `llvm-ar` not available + result.buildLib = "ar rcs $libfile $objfiles" + else: + result.buildLib = "llvm-ar rcs $libfile $objfiles" +# Clang (LLVM) C/C++ Compiler compiler clang: - result = llvmGcc() + result = llvmGcc() # Uses settings from llvmGcc result.name = "clang" result.compilerExe = "clang" - result.linkerExe = "clang" + result.cppCompiler = "clang++" +# Microsoft Visual C/C++ Compiler compiler vcc: result = ( name: "vcc", objExt: "obj", - optSpeed: " /Ogityb2 /G7 /arch:SSE2 ", - optSize: " /O1 /G7 ", + optSpeed: " /Ogityb2 ", + optSize: " /O1 ", compilerExe: "cl", - compileTmpl: "/c $options $include /Fo$objfile $file", - buildGui: " /link /SUBSYSTEM:WINDOWS ", + cppCompiler: "cl", + 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", - debug: " /GZ /Zi ", + debug: " /RTC1 /Z7 ", pic: "", asmStmtFrmt: "__asm{$n$1$n}$n", - props: {hasCpp, hasAssume}) + 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: - # Intel compilers try to imitate the native ones (gcc and msvc) - when defined(windows): - result = vcc() - else: - result = gcc() - + result = vcc() result.name = "icl" result.compilerExe = "icl" result.linkerExe = "icl" -compiler lcc: - result = ( - name: "lcc", - objExt: "obj", - optSpeed: " -O -p6 ", - optSize: " -O -p6 ", - compilerExe: "lcc", - 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", - props: {}) +# Intel compilers try to imitate the native ones (gcc and msvc) +compiler icc: + result = gcc() + result.name = "icc" + result.compilerExe = "icc" + result.linkerExe = "icc" +# Borland C Compiler compiler bcc: result = ( name: "bcc", objExt: "obj", - optSpeed: " -O2 -6 ", + optSpeed: " -O3 -6 ", optSize: " -O1 -6 ", - compilerExe: "bcc32", + compilerExe: "bcc32c", + cppCompiler: "cpp32c", compileTmpl: "-c $options $include -o$objfile $file", buildGui: " -tW", buildDll: " -tWD", @@ -172,50 +231,13 @@ compiler bcc: debug: "", pic: "", asmStmtFrmt: "__asm{$n$1$n}$n", - props: {hasCpp}) - -compiler dmc: - result = ( - name: "dmc", - objExt: "obj", - optSpeed: " -ff -o -6 ", - optSize: " -ff -o -6 ", - compilerExe: "dmc", - 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", - props: {hasCpp}) - -compiler wcc: - result = ( - name: "wcc", - objExt: "obj", - optSpeed: " -ox -on -6 -d0 -fp6 -zW ", - optSize: "", - compilerExe: "wcl386", - 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", - props: {hasCpp}) + structStmtFmt: "$1 $2", + produceAsm: "", + cppXsupport: "", + props: {hasSwitchRange, hasComputedGoto, hasCpp, hasGcGuard, + hasAttribute}) +# Tiny C Compiler compiler tcc: result = ( name: "tcc", @@ -223,8 +245,9 @@ compiler tcc: optSpeed: "", optSize: "", compilerExe: "tcc", + cppCompiler: "", compileTmpl: "-c $options $include -o $objfile $file", - buildGui: "UNAVAILABLE!", + buildGui: "-Wl,-subsystem=gui", buildDll: " -shared", buildLib: "", # XXX: not supported yet linkerExe: "tcc", @@ -234,43 +257,26 @@ compiler tcc: linkLibCmd: "", # XXX: not supported yet debug: " -g ", pic: "", - asmStmtFrmt: "__asm{$n$1$n}$n", - props: {hasSwitchRange, hasComputedGoto}) - -compiler pcc: - # Pelles C - result = ( - name: "pcc", - objExt: "obj", - optSpeed: " -Ox ", - optSize: " -Os ", - compilerExe: "cc", - 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", - props: {}) + asmStmtFrmt: "asm($1);$n", + structStmtFmt: "$1 $2", + produceAsm: gnuAsmListing, + cppXsupport: "", + props: {hasSwitchRange, hasComputedGoto, hasGnuAsm}) -compiler ucc: +# Your C Compiler +compiler envcc: result = ( - name: "ucc", + name: "env", objExt: "o", optSpeed: " -O3 ", optSize: " -O1 ", - compilerExe: "cc", - compileTmpl: "-c $options $include -o $objfile $file", + compilerExe: "", + cppCompiler: "", + 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 @@ -278,380 +284,839 @@ compiler ucc: debug: "", pic: "", asmStmtFrmt: "__asm{$n$1$n}$n", - props: {}) + structStmtFmt: "$1 $2", + produceAsm: "", + cppXsupport: "", + props: {hasGnuAsm}) -const +const CC*: array[succ(low(TSystemCC))..high(TSystemCC), TInfoCC] = [ gcc(), + nintendoSwitchGCC(), llvmGcc(), clang(), - lcc(), bcc(), - dmc(), - wcc(), vcc(), tcc(), - pcc(), - ucc(), + envcc(), icl(), - gpp()] - -const - hExt* = "h" - -var - cCompiler* = ccGcc # the used compiler - - cExt* = "c" # extension of generated C/C++ files - # (can be changed to .cpp later) - - cIncludes*: seq[string] = @[] # directories to search for included files - cLibs*: seq[string] = @[] # directories to search for lib files - cLinkedLibs*: seq[string] = @[] # libraries to link - -# implementation - -proc libNameTmpl(): string {.inline.} = - result = if targetOS == osWindows: "$1.lib" else: "lib$1.a" - -var - toLink, toCompile, externalToCompile: TLinkedList - linkOptions: string = "" - compileOptions: string = "" - ccompilerpath: string = "" - -proc NameToCC*(name: string): TSystemCC = - for i in countup(succ(ccNone), high(TSystemCC)): - if cmpIgnoreStyle(name, CC[i].name) == 0: + icc(), + clangcl(), + hipcc(), + nvcc()] + + hExt* = ".h" + +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 succ(ccNone)..high(TSystemCC): + if cmpIgnoreStyle(name, CC[i].name) == 0: return i result = ccNone -proc getConfigVar(c: TSystemCC, suffix: string): string = +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 - if (platform.hostOS != targetOS or platform.hostCPU != targetCPU) and - optCompileOnly notin gGlobalOptions: - let fullCCname = platform.cpu[targetCPU].name & '.' & - platform.os[targetOS].name & '.' & - CC[c].name & suffix - result = getConfigVar(fullCCname) - if result.len == 0: - # not overriden for this cross compilation setting? - result = getConfigVar(CC[c].name & 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: + let fullCCname = platform.CPU[conf.target.targetCPU].name & '.' & + platform.OS[conf.target.targetOS].name & '.' & + CC[c].name & fullSuffix + result = getConfigVar(conf, fullCCname) + 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(CC[c].name & suffix) + result = getConfigVar(conf, CC[c].name & fullSuffix) -proc setCC*(ccname: string) = - ccompiler = nameToCC(ccname) - if ccompiler == ccNone: rawMessage(errUnknownCcompiler, ccname) - compileOptions = getConfigVar(ccompiler, ".options.always") - linkOptions = getConfigVar(ccompiler, ".options.linker") - ccompilerpath = getConfigVar(ccompiler, ".path") - for i in countup(low(CC), high(CC)): undefSymbol(CC[i].name) - defineSymbol(CC[ccompiler].name) +proc setCC*(conf: ConfigRef; ccname: string; info: TLineInfo) = + conf.cCompiler = nameToCC(ccname) + if conf.cCompiler == ccNone: + localError(conf, info, "unknown C compiler: '$1'. Available options are: $2" % [ccname, listCCnames()]) + conf.compileOptions = getConfigVar(conf, conf.cCompiler, ".options.always") + conf.linkOptions = "" + conf.cCompilerPath = getConfigVar(conf, conf.cCompiler, ".path") + for c in CC: undefSymbol(conf.symbols, c.name) + 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) +proc addOpt(dest: var string, src: string) = + if dest.len == 0 or dest[^1] != ' ': dest.add(" ") + dest.add(src) -proc addLinkOption*(option: string) = - if find(linkOptions, option, 0) < 0: addOpt(linkOptions, option) +proc addLinkOption*(conf: ConfigRef; option: string) = + addOpt(conf.linkOptions, option) -proc addCompileOption*(option: string) = - if strutils.find(compileOptions, option, 0) < 0: - addOpt(compileOptions, option) +proc addCompileOption*(conf: ConfigRef; option: string) = + if strutils.find(conf.compileOptions, option, 0) < 0: + addOpt(conf.compileOptions, option) -proc initVars*() = +proc addLinkOptionCmd*(conf: ConfigRef; option: string) = + addOpt(conf.linkOptionsCmd, option) + +proc addCompileOptionCmd*(conf: ConfigRef; option: string) = + conf.compileOptionsCmd.add(option) + +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(CC[i].name) - defineSymbol(CC[ccompiler].name) - if gCmd == cmdCompileToCpp: cExt = ".cpp" - elif gCmd == cmdCompileToOC: cExt = ".m" - addCompileOption(getConfigVar(ccompiler, ".options.always")) - addLinkOption(getConfigVar(ccompiler, ".options.linker")) - if len(ccompilerPath) == 0: - ccompilerpath = getConfigVar(ccompiler, ".path") - -proc completeCFilePath*(cfile: string, createSubDir: bool = true): string = - result = completeGeneratedFilePath(cfile, createSubDir) - -proc toObjFile*(filenameWithoutExt: string): string = + 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 conf.cCompilerPath.len == 0: + conf.cCompilerPath = getConfigVar(conf, conf.cCompiler, ".path") + +proc completeCfilePath*(conf: ConfigRef; cfile: AbsoluteFile, + createSubDir: bool = true): AbsoluteFile = + ## Generate the absolute file path to the generated modules. + result = completeGeneratedFilePath(conf, cfile, createSubDir) + +proc toObjFile*(conf: ConfigRef; filename: AbsoluteFile): AbsoluteFile = # Object file for compilation - result = changeFileExt(filenameWithoutExt, cc[ccompiler].objExt) + result = AbsoluteFile(filename.string & "." & CC[conf.cCompiler].objExt) + +proc addFileToCompile*(conf: ConfigRef; cf: Cfile) = + conf.toCompile.add(cf) -proc addFileToCompile*(filename: string) = - appendStr(toCompile, filename) +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* = - initLinkedList(toCompile) +proc resetCompilationLists*(conf: ConfigRef) = + conf.toCompile.setLen 0 ## XXX: we must associate these with their originating module # when the module is loaded/unloaded it adds/removes its items - # That's because we still need to CRC check the external files + # That's because we still need to hash check the external files # Maybe we can do that in checkDep on the other hand? - initLinkedList(externalToCompile) - initLinkedList(toLink) + conf.externalToLink.setLen 0 -proc addFileToLink*(filename: string) = - prependStr(toLink, filename) - # BUGFIX: was ``appendStr`` +proc addExternalFileToLink*(conf: ConfigRef; filename: AbsoluteFile) = + conf.externalToLink.insert(filename.string, 0) -proc execExternalProgram*(cmd: string) = - if optListCmd in gGlobalOptions or gVerbosity > 0: MsgWriteln(cmd) - if execCmd(cmd) != 0: rawMessage(errExecutionOfProgramFailed, "") +proc execWithEcho(conf: ConfigRef; cmd: string, msg = hintExecuting): int = + rawMessage(conf, msg, if msg == hintLinking and not(optListCmd in conf.globalOptions or conf.verbosity > 1): "" else: cmd) + result = execCmd(cmd) -proc generateScript(projectFile: string, script: PRope) = - let (dir, name, ext) = splitFile(projectFile) - WriteRope(script, dir / addFileExt("compile_" & name, - platform.os[targetOS].scriptExt)) +proc execExternalProgram*(conf: ConfigRef; cmd: string, msg = hintExecuting) = + if execWithEcho(conf, cmd, msg) != 0: + rawMessage(conf, errGenerated, "execution of an external program failed: '$1'" % + cmd) -proc getOptSpeed(c: TSystemCC): string = - result = getConfigVar(c, ".options.speed") +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") if result == "": - result = cc[c].optSpeed # use default settings from this file + result = CC[c].optSpeed # use default settings from this file -proc getDebug(c: TSystemCC): string = - result = getConfigVar(c, ".options.debug") +proc getDebug(conf: ConfigRef; c: TSystemCC): string = + result = getConfigVar(conf, c, ".options.debug") if result == "": - result = cc[c].debug # use default settings from this file + result = CC[c].debug # use default settings from this file -proc getOptSize(c: TSystemCC): string = - result = getConfigVar(c, ".options.size") +proc getOptSize(conf: ConfigRef; c: TSystemCC): string = + result = getConfigVar(conf, c, ".options.size") if result == "": - result = cc[c].optSize # use default settings from this file + result = CC[c].optSize # use default settings from this file -proc noAbsolutePaths: bool {.inline.} = +proc noAbsolutePaths(conf: ConfigRef): bool {.inline.} = # We used to check current OS != specified OS, but this makes no sense # really: Cross compilation from Linux to Linux for example is entirely # reasonable. # `optGenMapping` is included here for niminst. - result = gGlobalOptions * {optGenScript, optGenMapping} != {} - -const - specialFileA = 42 - specialFileB = 42 - -var fileCounter: int - -proc add(s: var string, many: openarray[string]) = - s.add many.join - -proc CFileSpecificOptions(cfilename: string): string = - result = compileOptions - var trunk = splitFile(cfilename).name - if optCDebug in gGlobalOptions: - var key = trunk & ".debug" - if existsConfigVar(key): addOpt(result, getConfigVar(key)) - else: addOpt(result, getDebug(ccompiler)) - if optOptimizeSpeed in gOptions: - var key = trunk & ".speed" - if existsConfigVar(key): addOpt(result, getConfigVar(key)) - else: addOpt(result, getOptSpeed(ccompiler)) - elif optOptimizeSize in gOptions: - var key = trunk & ".size" - if existsConfigVar(key): addOpt(result, getConfigVar(key)) - else: addOpt(result, getOptSize(ccompiler)) - var key = trunk & ".always" - if existsConfigVar(key): addOpt(result, getConfigVar(key)) - -proc getCompileOptions: string = - result = CFileSpecificOptions("__dummy__") - -proc getLinkOptions: string = - result = linkOptions - for linkedLib in items(cLinkedLibs): - result.add(cc[ccompiler].linkLibCmd % linkedLib.quoteIfContainsWhite) - for libDir in items(cLibs): - result.add([cc[ccompiler].linkDirCmd, libDir.quoteIfContainsWhite]) - -proc needsExeExt(): bool {.inline.} = - result = (optGenScript in gGlobalOptions and targetOS == osWindows) or - (platform.hostOS == osWindows) - -proc getCompileCFileCmd*(cfilename: string, isExternal = false): string = - var c = ccompiler - var options = CFileSpecificOptions(cfilename) - var exe = getConfigVar(c, ".exe") - if exe.len == 0: exe = cc[c].compilerExe - - if needsExeExt(): exe = addFileExt(exe, "exe") - if optGenDynLib in gGlobalOptions and - ospNeedsPIC in platform.OS[targetOS].props: - add(options, ' ' & cc[c].pic) - - var includeCmd, compilePattern: string - if not noAbsolutePaths(): - # compute include paths: - includeCmd = cc[c].includeCmd & quoteIfContainsWhite(libpath) - - for includeDir in items(cIncludes): - includeCmd.add([cc[c].includeCmd, includeDir.quoteIfContainsWhite]) - - compilePattern = JoinPath(ccompilerpath, exe) - else: - includeCmd = "" - compilePattern = cc[c].compilerExe - - var cfile = if noAbsolutePaths(): extractFileName(cfilename) - else: cfilename - var objfile = if not isExternal or noAbsolutePaths(): - toObjFile(cfile) - else: - completeCFilePath(toObjFile(cfile)) - cfile = quoteIfContainsWhite(AddFileExt(cfile, cExt)) - objfile = quoteIfContainsWhite(objfile) - result = quoteIfContainsWhite(compilePattern % [ - "file", cfile, "objfile", objfile, "options", options, - "include", includeCmd, "nimrod", getPrefixDir(), "lib", libpath]) - add(result, ' ') - addf(result, cc[c].compileTmpl, [ - "file", cfile, "objfile", objfile, - "options", options, "include", includeCmd, - "nimrod", quoteIfContainsWhite(getPrefixDir()), - "lib", quoteIfContainsWhite(libpath)]) - -proc footprint(filename: string): TCrc32 = - result = crcFromFile(filename) >< - platform.OS[targetOS].name >< - platform.CPU[targetCPU].name >< - extccomp.CC[extccomp.ccompiler].name >< - getCompileCFileCmd(filename, true) - -proc externalFileChanged(filename: string): bool = - var crcFile = toGeneratedFile(filename, "crc") - var currentCrc = int(footprint(filename)) - var f: TFile - if open(f, crcFile, fmRead): - var line = newStringOfCap(40) - if not f.readLine(line): line = "0" + # We use absolute paths for vcc / cl, see issue #19883. + let options = + if conf.cCompiler == ccVcc: + {optGenMapping} + else: + {optGenScript, optGenMapping} + result = conf.globalOptions * options != {} + +proc cFileSpecificOptions(conf: ConfigRef; nimname, fullNimFile: string): string = + result = conf.compileOptions + + for option in conf.compileOptionsCmd: + if strutils.find(result, option, 0) < 0: + addOpt(result, option) + + if optCDebug in conf.globalOptions: + 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 = 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 = nimname & ".size" + if existsConfigVar(conf, key): addOpt(result, getConfigVar(conf, key)) + else: addOpt(result, getOptSize(conf, conf.cCompiler)) + 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__", "__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 & " " + for linkedLib in items(conf.cLinkedLibs): + result.add(CC[conf.cCompiler].linkLibCmd % linkedLib.quoteShell) + for libDir in items(conf.cLibs): + result.add(join([CC[conf.cCompiler].linkDirCmd, libDir.quoteShell])) + +proc needsExeExt(conf: ConfigRef): bool {.inline.} = + result = (optGenScript in conf.globalOptions and conf.target.targetOS == osWindows) or + (conf.target.hostOS == osWindows) + +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 + 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 + + var exe = getConfigVar(conf, c, ".exe") + if exe.len == 0: exe = getCompilerExe(conf, c, isCpp) + + if needsExeExt(conf): exe = addFileExt(exe, "exe") + if (optGenDynLib in conf.globalOptions or (conf.hcrOn and not isMainFile)) and + ospNeedsPIC in platform.OS[conf.target.targetOS].props: + options.add(' ' & CC[c].pic) + + 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) + else: + compilePattern = exe + + includeCmd.add(join([CC[c].includeCmd, quoteShell(conf.projectPath.string)])) + + let cf = if noAbsolutePaths(conf): AbsoluteFile extractFilename(cfile.cname.string) + else: cfile.cname + + 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)).string + elif noAbsolutePaths(conf): + extractFilename(cfile.obj.string) + else: + 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 + + let cfsh = quoteShell(cf) + result = quoteShell(compilePattern % [ + "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)), + "lib", quoteShell(conf.libpath), + "vccplatform", vccplatform(conf), + "ccenvflags", envFlags(conf)]) + +proc footprint(conf: ConfigRef; cfile: Cfile): SecureHash = + result = secureHash( + $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.backend == backendJs: return false # pre-existing behavior, but not sure it's good + + 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) - var oldCrc = parseInt(line) - result = oldCrc != currentCrc + result = oldHash != currentHash else: result = true - if result: - if open(f, crcFile, fmWrite): - f.writeln($currentCrc) + if result: + if open(f, hashFile.string, fmWrite): + f.writeLine($currentHash) close(f) -proc addExternalFileToCompile*(filename: string) = - if optForceFullMake in gGlobalOptions or externalFileChanged(filename): - appendStr(externalToCompile, filename) - -proc CompileCFile(list: TLinkedList, script: var PRope, cmds: var TStringSeq, - isExternal: bool) = - var it = PStrEntry(list.head) - while it != nil: - inc(fileCounter) # call the C compiler for the .c file: - var compileCmd = getCompileCFileCmd(it.data, isExternal) - if optCompileOnly notin gGlobalOptions: - add(cmds, compileCmd) - if optGenScript in gGlobalOptions: - app(script, compileCmd) - app(script, tnl) - it = PStrEntry(it.next) - -proc CallCCompiler*(projectfile: string) = - var - linkCmd, buildgui, builddll: string - if gGlobalOptions * {optCompileOnly, optGenScript} == {optCompileOnly}: +proc addExternalFileToCompile*(conf: ConfigRef; c: var Cfile) = + # we want to generate the hash file unconditionally + let extFileChanged = externalFileChanged(conf, c) + if optForceFullMake notin conf.globalOptions and fileExists(c.obj) and + not 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: AbsoluteFile) = + var c = Cfile(nimname: splitFile(filename).name, cname: filename, + obj: toObjFile(conf, completeCfilePath(conf, filename, false)), + flags: {CfileFlag.External}) + addExternalFileToCompile(conf, c) + +proc getLinkCmd(conf: ConfigRef; output: AbsoluteFile, + objfiles: string, isDllBuild: bool, removeStaticFile: bool): string = + if optGenStaticLib in conf.globalOptions: + 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 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 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")) + + # 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).string, "lib", conf.libpath.string]) + result.add ' ' + strutils.addf(result, linkTmpl, ["builddll", builddll, + "mapfile", mapfile, + "buildgui", buildgui, "options", linkOptions, + "objfiles", objfiles, "exefile", exefile, + "nim", quoteShell(getPrefixDir(conf)), + "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: + let ose = (ref OSError)(getCurrentException()) + if errorPrefix.len > 0: + rawMessage(conf, errGenerated, errorPrefix & " " & ose.msg & " " & $ose.errorCode) + else: + rawMessage(conf, errGenerated, "execution of an external program failed: '$1'" % + (ose.msg & " " & $ose.errorCode)) + 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, 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") + if conf.numberOfProcessors == 0: conf.numberOfProcessors = countProcessors() + var res = 0 + if conf.numberOfProcessors <= 1: + for i in 0..high(cmds): + tryExceptOSErrorMessage(conf, "invocation of external compiler program failed."): + res = execWithEcho(conf, cmds[i]) + if res != 0: + rawMessage(conf, errGenerated, "execution of an external program failed: '$1'" % + cmds[i]) + else: + tryExceptOSErrorMessage(conf, "invocation of external compiler program failed."): + res = execProcesses(cmds, {poStdErrToStdOut, poUsePath, poParentStreams}, + conf.numberOfProcessors, prettyCb, afterRunEvent=runCb) + if res != 0: + if conf.numberOfProcessors <= 1: + rawMessage(conf, errGenerated, "execution of an external program failed: '$1'" % + cmds.join()) + +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 = "" + extraCmds: seq[string] + if conf.globalOptions * {optCompileOnly, optGenScript} == {optCompileOnly}: return # speed up that call if only compiling and no script shall be # generated - fileCounter = 0 - var c = ccompiler - var script: PRope = nil - var cmds: TStringSeq = @[] - CompileCFile(toCompile, script, cmds, false) - CompileCFile(externalToCompile, script, cmds, true) - if optCompileOnly notin gGlobalOptions: - if gNumberOfProcessors == 0: gNumberOfProcessors = countProcessors() - var res = 0 - if gNumberOfProcessors <= 1: - for i in countup(0, high(cmds)): res = max(execCmd(cmds[i]), res) - elif optListCmd in gGlobalOptions or gVerbosity > 0: - res = execProcesses(cmds, {poEchoCmd, poUseShell, poParentStreams}, - gNumberOfProcessors) - else: - res = execProcesses(cmds, {poUseShell, poParentStreams}, - gNumberOfProcessors) - if res != 0: - if gNumberOfProcessors <= 1: - rawMessage(errExecutionOfProgramFailed, []) - else: - rawMessage(errGenerated, " execution of an external program failed; " & - "rerun with --parallelBuild:1 to see the error message") - if optNoLinking notin gGlobalOptions and cmds.len > 0: + #var c = cCompiler + 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: # call the linker: - var it = PStrEntry(toLink.head) var objfiles = "" - while it != nil: - let objFile = if noAbsolutePaths(): it.data.extractFilename else: it.data - add(objfiles, ' ') - add(objfiles, quoteIfContainsWhite( - addFileExt(objFile, cc[ccompiler].objExt))) - it = PStrEntry(it.next) - - if optGenStaticLib in gGlobalOptions: - linkcmd = cc[c].buildLib % ["libfile", (libNameTmpl() % gProjectName), - "objfiles", objfiles] - if optCompileOnly notin gGlobalOptions: execExternalProgram(linkCmd) + for it in conf.externalToLink: + let objFile = if noAbsolutePaths(conf): it.extractFilename else: it + objfiles.add(' ') + objfiles.add(quoteShell( + addFileExt(objFile, CC[conf.cCompiler].objExt))) + + 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: - var linkerExe = getConfigVar(c, ".linkerexe") - if len(linkerExe) == 0: linkerExe = cc[c].linkerExe - if needsExeExt(): linkerExe = addFileExt(linkerExe, "exe") - if noAbsolutePaths(): linkCmd = quoteIfContainsWhite(linkerExe) - else: linkCmd = quoteIfContainsWhite(JoinPath(ccompilerpath, linkerExe)) - if optGenGuiApp in gGlobalOptions: buildGui = cc[c].buildGui - else: buildGui = "" - var exefile: string - if optGenDynLib in gGlobalOptions: - exefile = platform.os[targetOS].dllFrmt % splitFile(projectFile).name - buildDll = cc[c].buildDll - else: - exefile = splitFile(projectFile).name & platform.os[targetOS].exeExt - buildDll = "" - if options.outFile.len > 0: - exefile = options.outFile - if not noAbsolutePaths(): - exefile = joinPath(splitFile(projectFile).dir, exefile) - exefile = quoteIfContainsWhite(exefile) - let linkOptions = getLinkOptions() - linkCmd = quoteIfContainsWhite(linkCmd % ["builddll", builddll, - "buildgui", buildgui, "options", linkOptions, "objfiles", objfiles, - "exefile", exefile, "nimrod", getPrefixDir(), "lib", libpath]) - linkCmd.add ' ' - addf(linkCmd, cc[c].linkTmpl, ["builddll", builddll, - "buildgui", buildgui, "options", linkOptions, - "objfiles", objfiles, "exefile", exefile, - "nimrod", quoteIfContainsWhite(getPrefixDir()), - "lib", quoteIfContainsWhite(libpath)]) - if optCompileOnly notin gGlobalOptions: execExternalProgram(linkCmd) + 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 gGlobalOptions: - app(script, linkCmd) - app(script, tnl) - generateScript(projectFile, script) - -proc genMappingFiles(list: TLinkedList): PRope = - var it = PStrEntry(list.head) - while it != nil: - appf(result, "--file:r\"$1\"$N", [toRope(AddFileExt(it.data, cExt))]) - it = PStrEntry(it.next) - -proc writeMapping*(gSymbolMapping: PRope) = - if optGenMapping notin gGlobalOptions: return - var code = toRope("[C_Files]\n") - app(code, genMappingFiles(toCompile)) - app(code, genMappingFiles(externalToCompile)) - app(code, "\n[C_Compiler]\nFlags=") - app(code, strutils.escape(getCompileOptions())) - - app(code, "\n[Linker]\nFlags=") - app(code, strutils.escape(getLinkOptions())) - - app(code, "\n[Environment]\nlibpath=") - app(code, strutils.escape(libpath)) - - appf(code, "\n[Symbols]$n$1", [gSymbolMapping]) - WriteRope(code, joinPath(gProjectPath, "mapping.txt")) - + if optGenScript in conf.globalOptions: + 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: + 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") + code.add(genMappingFiles(conf, conf.toCompile)) + code.add("\n[C_Compiler]\nFlags=") + code.add(strutils.escape(getCompileOptions(conf))) + + code.add("\n[Linker]\nFlags=") + code.add(strutils.escape(getLinkOptions(conf) & " " & + getConfigVar(conf, conf.cCompiler, ".options.linker"))) + + code.add("\n[Environment]\nlibpath=") + code.add(strutils.escape(conf.libpath.string)) + + 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.string) diff --git a/compiler/filter_tmpl.nim b/compiler/filter_tmpl.nim index d16639d08..921a94b31 100644 --- a/compiler/filter_tmpl.nim +++ b/compiler/filter_tmpl.nim @@ -1,114 +1,115 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # -# This module implements Nimrod's standard template filter. +# This module implements Nim's standard template filter. -import - llstream, os, wordrecg, idents, strutils, ast, astalgo, msgs, options, - renderer, filters +import + llstream, ast, msgs, options, + filters, lineinfos, pathutils -proc filterTmpl*(stdin: PLLStream, filename: string, call: PNode): PLLStream - # #! template(subsChar='$', metaChar='#') | standard(version="0.7.2") -# implementation +import std/strutils -type - TParseState = enum +type + TParseState = enum psDirective, psTempl - TTmplParser{.final.} = object + TTmplParser = object inp: PLLStream state: TParseState info: TLineInfo indent, emitPar: int x: string # the current input line - outp: PLLStream # the ouput will be parsed by pnimsyn - subsChar, NimDirective: Char + outp: PLLStream # the output will be parsed by parser + subsChar, nimDirective: char emit, conc, toStr: string curly, bracket, par: int pendingExprLine: bool + config: ConfigRef - -const +const PatternChars = {'a'..'z', 'A'..'Z', '0'..'9', '\x80'..'\xFF', '.', '_'} -proc newLine(p: var TTmplParser) = - LLStreamWrite(p.outp, repeatChar(p.emitPar, ')')) +proc newLine(p: var TTmplParser) = + llStreamWrite(p.outp, repeat(')', p.emitPar)) p.emitPar = 0 - if p.info.line > int16(1): LLStreamWrite(p.outp, "\n") + if p.info.line > uint16(1): llStreamWrite(p.outp, "\n") if p.pendingExprLine: - LLStreamWrite(p.outp, repeatChar(2)) + llStreamWrite(p.outp, spaces(2)) p.pendingExprLine = false - -proc scanPar(p: var TTmplParser, d: int) = + +proc scanPar(p: var TTmplParser, d: int) = var i = d - while true: + while i < p.x.len: case p.x[i] - of '\0': break of '(': inc(p.par) of ')': dec(p.par) of '[': inc(p.bracket) of ']': dec(p.bracket) of '{': inc(p.curly) of '}': dec(p.curly) - else: nil + else: discard inc(i) -proc withInExpr(p: TTmplParser): bool {.inline.} = +proc withInExpr(p: TTmplParser): bool {.inline.} = result = p.par > 0 or p.bracket > 0 or p.curly > 0 - -proc parseLine(p: var TTmplParser) = - var - d, j, curly: int - keyw: string - j = 0 - while p.x[j] == ' ': inc(j) - if (p.x[0] == p.NimDirective) and (p.x[0 + 1] == '!'): + +const + LineContinuationOprs = {'+', '-', '*', '/', '\\', '<', '>', '^', + '|', '%', '&', '$', '@', '~', ','} + +proc parseLine(p: var TTmplParser) = + var j = 0 + let len = p.x.len + + while j < len and p.x[j] == ' ': inc(j) + + if len >= 2 and p.x[0] == p.nimDirective and p.x[1] == '?': newLine(p) - elif (p.x[j] == p.NimDirective): + elif j < len and p.x[j] == p.nimDirective: newLine(p) inc(j) - while p.x[j] == ' ': inc(j) - d = j - keyw = "" - while p.x[j] in PatternChars: - add(keyw, p.x[j]) + while j < len and p.x[j] == ' ': inc(j) + let d = j + var keyw = "" + while j < len and p.x[j] in PatternChars: + keyw.add(p.x[j]) inc(j) - + scanPar(p, j) - p.pendingExprLine = withInExpr(p) or llstream.endsWithOpr(p.x) - case whichKeyword(keyw) - of wEnd: - if p.indent >= 2: + p.pendingExprLine = withInExpr(p) or p.x.endsWith(LineContinuationOprs) + case keyw + of "end": + if p.indent >= 2: dec(p.indent, 2) - else: + else: p.info.col = int16(j) - LocalError(p.info, errXNotAllowedHere, "end") - LLStreamWrite(p.outp, repeatChar(p.indent)) - LLStreamWrite(p.outp, "#end") - of wIf, wWhen, wTry, wWhile, wFor, wBlock, wCase, wProc, wIterator, - wConverter, wMacro, wTemplate, wMethod: - LLStreamWrite(p.outp, repeatChar(p.indent)) - LLStreamWrite(p.outp, substr(p.x, d)) + localError(p.config, p.info, "'end' does not close a control flow construct") + llStreamWrite(p.outp, spaces(p.indent)) + llStreamWrite(p.outp, "#end") + of "if", "when", "try", "while", "for", "block", "case", "proc", "iterator", + "converter", "macro", "template", "method", "func": + llStreamWrite(p.outp, spaces(p.indent)) + llStreamWrite(p.outp, substr(p.x, d)) inc(p.indent, 2) - of wElif, wOf, wElse, wExcept, wFinally: - LLStreamWrite(p.outp, repeatChar(p.indent - 2)) - LLStreamWrite(p.outp, substr(p.x, d)) - of wLet, wVar, wConst, wType: - LLStreamWrite(p.outp, repeatChar(p.indent)) - LLStreamWrite(p.outp, substr(p.x, d)) + of "elif", "of", "else", "except", "finally": + llStreamWrite(p.outp, spaces(p.indent - 2)) + llStreamWrite(p.outp, substr(p.x, d)) + of "let", "var", "const", "type": + llStreamWrite(p.outp, spaces(p.indent)) + llStreamWrite(p.outp, substr(p.x, d)) if not p.x.contains({':', '='}): # no inline element --> treat as block: inc(p.indent, 2) else: - LLStreamWrite(p.outp, repeatChar(p.indent)) - LLStreamWrite(p.outp, substr(p.x, d)) + llStreamWrite(p.outp, spaces(p.indent)) + llStreamWrite(p.outp, substr(p.x, d)) p.state = psDirective - else: + else: # data line # reset counters p.par = 0 @@ -116,106 +117,107 @@ proc parseLine(p: var TTmplParser) = p.bracket = 0 j = 0 case p.state - of psTempl: + of psTempl: # next line of string literal: - LLStreamWrite(p.outp, p.conc) - LLStreamWrite(p.outp, "\n") - LLStreamWrite(p.outp, repeatChar(p.indent + 2)) - LLStreamWrite(p.outp, "\"") - of psDirective: + llStreamWrite(p.outp, p.conc) + llStreamWrite(p.outp, "\n") + llStreamWrite(p.outp, spaces(p.indent + 2)) + llStreamWrite(p.outp, "\"") + of psDirective: newLine(p) - LLStreamWrite(p.outp, repeatChar(p.indent)) - LLStreamWrite(p.outp, p.emit) - LLStreamWrite(p.outp, "(\"") + llStreamWrite(p.outp, spaces(p.indent)) + llStreamWrite(p.outp, p.emit) + llStreamWrite(p.outp, "(\"") inc(p.emitPar) p.state = psTempl - while true: + while j < len: case p.x[j] - of '\0': - break - of '\x01'..'\x1F', '\x80'..'\xFF': - LLStreamWrite(p.outp, "\\x") - LLStreamWrite(p.outp, toHex(ord(p.x[j]), 2)) + of '\x01'..'\x1F', '\x80'..'\xFF': + llStreamWrite(p.outp, "\\x") + llStreamWrite(p.outp, toHex(ord(p.x[j]), 2)) inc(j) - of '\\': - LLStreamWrite(p.outp, "\\\\") + of '\\': + llStreamWrite(p.outp, "\\\\") inc(j) - of '\'': - LLStreamWrite(p.outp, "\\\'") + of '\'': + llStreamWrite(p.outp, "\\\'") inc(j) - of '\"': - LLStreamWrite(p.outp, "\\\"") + of '\"': + llStreamWrite(p.outp, "\\\"") inc(j) - else: - if p.x[j] == p.subsChar: - # parse Nimrod expression: + else: + if p.x[j] == p.subsChar: + # parse Nim expression: inc(j) case p.x[j] - of '{': + of '{': p.info.col = int16(j) - LLStreamWrite(p.outp, '\"') - LLStreamWrite(p.outp, p.conc) - LLStreamWrite(p.outp, p.toStr) - LLStreamWrite(p.outp, '(') + llStreamWrite(p.outp, '\"') + llStreamWrite(p.outp, p.conc) + llStreamWrite(p.outp, p.toStr) + llStreamWrite(p.outp, '(') inc(j) - curly = 0 - while true: + var curly = 0 + while j < len: case p.x[j] - of '\0': - LocalError(p.info, errXExpected, "}") - break - of '{': + of '{': inc(j) inc(curly) - LLStreamWrite(p.outp, '{') - of '}': + llStreamWrite(p.outp, '{') + of '}': inc(j) - if curly == 0: break + if curly == 0: break if curly > 0: dec(curly) - LLStreamWrite(p.outp, '}') - else: - LLStreamWrite(p.outp, p.x[j]) + llStreamWrite(p.outp, '}') + else: + llStreamWrite(p.outp, p.x[j]) inc(j) - LLStreamWrite(p.outp, ')') - LLStreamWrite(p.outp, p.conc) - LLStreamWrite(p.outp, '\"') - of 'a'..'z', 'A'..'Z', '\x80'..'\xFF': - LLStreamWrite(p.outp, '\"') - LLStreamWrite(p.outp, p.conc) - LLStreamWrite(p.outp, p.toStr) - LLStreamWrite(p.outp, '(') - while p.x[j] in PatternChars: - LLStreamWrite(p.outp, p.x[j]) + if curly > 0: + localError(p.config, p.info, "expected closing '}'") + break + llStreamWrite(p.outp, ')') + llStreamWrite(p.outp, p.conc) + llStreamWrite(p.outp, '\"') + of 'a'..'z', 'A'..'Z', '\x80'..'\xFF': + llStreamWrite(p.outp, '\"') + llStreamWrite(p.outp, p.conc) + llStreamWrite(p.outp, p.toStr) + llStreamWrite(p.outp, '(') + while j < len and p.x[j] in PatternChars: + llStreamWrite(p.outp, p.x[j]) inc(j) - LLStreamWrite(p.outp, ')') - LLStreamWrite(p.outp, p.conc) - LLStreamWrite(p.outp, '\"') - else: - if p.x[j] == p.subsChar: - LLStreamWrite(p.outp, p.subsChar) + llStreamWrite(p.outp, ')') + llStreamWrite(p.outp, p.conc) + llStreamWrite(p.outp, '\"') + else: + if p.x[j] == p.subsChar: + llStreamWrite(p.outp, p.subsChar) inc(j) - else: + else: p.info.col = int16(j) - LocalError(p.info, errInvalidExpression, "$") - else: - LLStreamWrite(p.outp, p.x[j]) + localError(p.config, p.info, "invalid expression") + else: + llStreamWrite(p.outp, p.x[j]) inc(j) - LLStreamWrite(p.outp, "\\n\"") + llStreamWrite(p.outp, "\\n\"") -proc filterTmpl(stdin: PLLStream, filename: string, call: PNode): PLLStream = - var p: TTmplParser - p.info = newLineInfo(filename, 0, 0) - p.outp = LLStreamOpen("") - p.inp = stdin - p.subsChar = charArg(call, "subschar", 1, '$') - p.nimDirective = charArg(call, "metachar", 2, '#') - p.emit = strArg(call, "emit", 3, "result.add") - p.conc = strArg(call, "conc", 4, " & ") - p.toStr = strArg(call, "tostring", 5, "$") - p.x = newStringOfCap(120) - while LLStreamReadLine(p.inp, p.x): - p.info.line = p.info.line + int16(1) +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): + inc p.info.line + while llStreamReadLine(p.inp, p.x): + inc p.info.line parseLine(p) newLine(p) result = p.outp - LLStreamClose(p.inp) + llStreamClose(p.inp) diff --git a/compiler/filters.nim b/compiler/filters.nim index 19da11bca..3cd56e3be 100644 --- a/compiler/filters.nim +++ b/compiler/filters.nim @@ -1,79 +1,81 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # -# This module implements Nimrod's simple filters and helpers for filters. +# 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 -proc filterReplace*(stdin: PLLStream, filename: string, call: PNode): PLLStream -proc filterStrip*(stdin: PLLStream, filename: string, call: PNode): PLLStream - # helpers to retrieve arguments: -proc charArg*(n: PNode, name: string, pos: int, default: Char): Char -proc strArg*(n: PNode, name: string, pos: int, default: string): string -proc boolArg*(n: PNode, name: string, pos: int, default: bool): bool -# implementation +import std/strutils -proc invalidPragma(n: PNode) = - LocalError(n.info, errXNotAllowedHere, renderTree(n, {renderNoComments})) +proc invalidPragma(conf: ConfigRef; n: PNode) = + localError(conf, n.info, + "'$1' not allowed here" % renderTree(n, {renderNoComments})) -proc getArg(n: PNode, name: string, pos: int): 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(n) - if IdentEq(n.sons[i].sons[0].ident, name): - return n.sons[i].sons[1] - elif i == pos: - return n.sons[i] - -proc charArg(n: PNode, name: string, pos: int, default: Char): Char = - var x = getArg(n, name, pos) + if n.kind in {nkEmpty..nkNilLit}: return + 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[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(n) - -proc strArg(n: PNode, name: string, pos: int, default: string): string = - var x = getArg(n, name, pos) + 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(n) - -proc boolArg(n: PNode, name: string, pos: int, default: bool): bool = - var x = getArg(n, name, pos) + 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 IdentEq(x.ident, "true"): result = true - elif (x.kind == nkIdent) and IdentEq(x.ident, "false"): result = false - else: invalidPragma(n) - -proc filterStrip(stdin: PLLStream, filename: string, call: PNode): PLLStream = - var pattern = strArg(call, "startswith", 1, "") - var leading = boolArg(call, "leading", 2, true) - var trailing = boolArg(call, "trailing", 3, true) - result = LLStreamOpen("") + 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: + result = false + invalidPragma(conf, n) + +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) + result = llStreamOpen("") var line = newStringOfCap(80) - while LLStreamReadLine(stdin, line): + while llStreamReadLine(stdin, line): var stripped = strip(line, leading, trailing) - if (len(pattern) == 0) or startsWith(stripped, pattern): - LLStreamWriteln(result, stripped) - else: - LLStreamWriteln(result, line) - LLStreamClose(stdin) + if pattern.len == 0 or startsWith(stripped, pattern): + llStreamWriteln(result, stripped) + else: + llStreamWriteln(result, line) + llStreamClose(stdin) -proc filterReplace(stdin: PLLStream, filename: string, call: PNode): PLLStream = - var sub = strArg(call, "sub", 1, "") - if len(sub) == 0: invalidPragma(call) - var by = strArg(call, "by", 2, "") - result = LLStreamOpen("") +proc filterReplace*(conf: ConfigRef; stdin: PLLStream, filename: AbsoluteFile, call: PNode): PLLStream = + var sub = strArg(conf, call, "sub", 1, "") + if sub.len == 0: invalidPragma(conf, call) + var by = strArg(conf, call, "by", 2, "") + result = llStreamOpen("") var line = newStringOfCap(80) - while LLStreamReadLine(stdin, line): - LLStreamWriteln(result, replace(line, sub, by)) - LLStreamClose(stdin) + while llStreamReadLine(stdin, line): + llStreamWriteln(result, replace(line, sub, by)) + llStreamClose(stdin) diff --git a/compiler/gorgeimpl.nim b/compiler/gorgeimpl.nim new file mode 100644 index 000000000..da911c84c --- /dev/null +++ b/compiler/gorgeimpl.nim @@ -0,0 +1,74 @@ +# +# +# The Nim Compiler +# (c) Copyright 2017 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Module that implements ``gorge`` for the compiler. + +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] = "" + var output = p.outputStream + while not output.atEnd: + result[0].add(output.readLine) + result[0].add("\n") + if result[0].len > 0: + result[0].setLen(result[0].len - "\n".len) + result[1] = p.waitForExit + +proc opGorge*(cmd, input, cache: string, info: TLineInfo; conf: ConfigRef): (string, int) = + let workingDir = parentDir(toFullPath(conf, info)) + result = ("", 0) + if cache.len > 0: + let h = secureHash(cmd & "\t" & input & "\t" & cache) + let filename = toGeneratedFile(conf, AbsoluteFile("gorge_" & $h), "txt").string + var f: File = 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}) + 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: + when defined(nimLegacyGorgeErrors): + result = ("", -1) + else: + result = ("Error running startProcess: " & getCurrentExceptionMsg(), -1) + else: + try: + var p = startProcess(cmd, workingDir, + options={poEvalCommand, poStdErrToStdOut}) + if input.len != 0: + p.inputStream.write(input) + p.inputStream.close() + result = p.readOutput + p.close() + except IOError, OSError: + when defined(nimLegacyGorgeErrors): + result = ("", -1) + else: + result = ("Error running startProcess: " & getCurrentExceptionMsg(), -1) diff --git a/compiler/guards.nim b/compiler/guards.nim index f02a53684..bbb239867 100644 --- a/compiler/guards.nim +++ b/compiler/guards.nim @@ -1,7 +1,7 @@ # # -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -9,21 +9,37 @@ ## This module implements the 'implies' relation for guards. -import ast, astalgo, msgs, magicsys, nimsets, trees, types, renderer +import ast, astalgo, msgs, magicsys, nimsets, trees, types, renderer, idents, + saturate, modulegraphs, options, lineinfos, int128 + +when defined(nimPreviewSlimSystem): + import std/assertions const - someEq = {mEqI, mEqI64, mEqF64, mEqEnum, mEqCh, mEqB, mEqRef, mEqProc, - mEqUntracedRef, mEqStr, mEqSet, mEqCString} - + someEq = {mEqI, mEqF64, mEqEnum, mEqCh, mEqB, mEqRef, mEqProc, + mEqStr, mEqSet, mEqCString} + # set excluded here as the semantics are vastly different: - someLe = {mLeI, mLeI64, mLeF64, mLeU, mLeU64, mLeEnum, + someLe = {mLeI, mLeF64, mLeU, mLeEnum, mLeCh, mLeB, mLePtr, mLeStr} - someLt = {mLtI, mLtI64, mLtF64, mLtU, mLtU64, mLtEnum, + someLt = {mLtI, mLtF64, mLtU, mLtEnum, mLtCh, mLtB, mLtPtr, mLtStr} someLen = {mLengthOpenArray, mLengthStr, mLengthArray, mLengthSeq} - someIn = {mInRange, mInSet} + someIn = {mInSet} + + someHigh = {mHigh} + # we don't list unsigned here because wrap around semantics suck for + # proving anything: + someAdd = {mAddI, mAddF64, mSucc} + someSub = {mSubI, mSubF64, mPred} + someMul = {mMulI, mMulF64} + someDiv = {mDivI, mDivF64} + someMod = {mModI} + someMax = {mMaxI} + someMin = {mMinI} + someBinaryOp = someAdd+someSub+someMul+someMax+someMin proc isValue(n: PNode): bool = n.kind in {nkCharLit..nkNilLit} proc isLocation(n: PNode): bool = not n.isValue @@ -32,13 +48,17 @@ proc isLet(n: PNode): bool = if n.kind == nkSym: if n.sym.kind in {skLet, skTemp, skForVar}: result = true - elif n.sym.kind == skParam and skipTypes(n.sym.typ, - abstractInst).kind != tyVar: + elif n.sym.kind == skParam and skipTypes(n.sym.typ, + abstractInst).kind notin {tyVar}: result = true + else: + result = false + else: + result = false proc isVar(n: PNode): bool = n.kind == nkSym and n.sym.kind in {skResult, skVar} and - {sfGlobal, sfAddrTaken} * n.sym.flags == {} + {sfAddrTaken} * n.sym.flags == {} proc isLetLocation(m: PNode, isApprox: bool): bool = # consider: 'n[].kind' --> we really need to support 1 deref op even if this @@ -51,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) @@ -69,36 +92,36 @@ proc isLetLocation(m: PNode, isApprox: bool): bool = proc interestingCaseExpr*(m: PNode): bool = isLetLocation(m, true) -proc swapArgs(fact: PNode, newOp: string, m: TMagic): PNode = +proc swapArgs(fact: PNode, newOp: PSym): PNode = result = newNodeI(nkCall, fact.info, 3) - result.sons[0] = newSymNode(getSysMagic(newOp, m)) - 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): PNode = +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, "<=", mLeI) + result = swapArgs(n, o.opLe) of someLe: - result = swapArgs(n, "<", mLtI) + 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 - elif lengthOrd(t) < 1000: - result.sons[1] = complement(n.sons[1]) + if not inSet(n[1], eAsNode): s.add eAsNode + result[1] = s + #elif t.kind notin {tyString, tySequence} and lengthOrd(t) < 1000: + # result[1] = complement(n[1]) else: # not ({2, 3, 4}.contains(x)) x != 2 and x != 3 and x != 4 # XXX todo @@ -106,134 +129,365 @@ proc neg(n: PNode): PNode = of mOr: # not (a or b) --> not a and not b let - a = n.sons[1].neg - b = n.sons[2].neg + 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(getSysMagic("and", mAnd)) - 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(getSysMagic("not", mNot)) - result.sons[1] = n + result[0] = newSymNode(o.opNot) + result[1] = n + +proc buildCall*(op: PSym; a: PNode): PNode = + result = newNodeI(nkCall, a.info, 2) + result[0] = newSymNode(op) + result[1] = a + +proc buildCall*(op: PSym; a, b: PNode): PNode = + result = newNodeI(nkInfix, a.info, 3) + result[0] = newSymNode(op) + result[1] = a + result[2] = b + +proc `|+|`(a, b: PNode): PNode = + result = copyNode(a) + if a.kind in {nkCharLit..nkUInt64Lit}: result.intVal = a.intVal |+| b.intVal + else: result.floatVal = a.floatVal + b.floatVal + +proc `|-|`(a, b: PNode): PNode = + result = copyNode(a) + if a.kind in {nkCharLit..nkUInt64Lit}: result.intVal = a.intVal |-| b.intVal + else: result.floatVal = a.floatVal - b.floatVal + +proc `|*|`(a, b: PNode): PNode = + result = copyNode(a) + if a.kind in {nkCharLit..nkUInt64Lit}: result.intVal = a.intVal |*| b.intVal + else: result.floatVal = a.floatVal * b.floatVal + +proc `|div|`(a, b: PNode): PNode = + result = copyNode(a) + if a.kind in {nkCharLit..nkUInt64Lit}: result.intVal = a.intVal div b.intVal + else: result.floatVal = a.floatVal / b.floatVal + +proc negate(a, b, res: PNode; o: Operators): PNode = + if b.kind in {nkCharLit..nkUInt64Lit} and b.intVal != low(BiggestInt): + var b = copyNode(b) + b.intVal = -b.intVal + if a.kind in {nkCharLit..nkUInt64Lit}: + b.intVal = b.intVal |+| a.intVal + result = b + else: + result = buildCall(o.opAdd, a, b) + elif b.kind in {nkFloatLit..nkFloat64Lit}: + var b = copyNode(b) + b.floatVal = -b.floatVal + result = buildCall(o.opAdd, a, b) + else: + result = res + +proc zero(): PNode = nkIntLit.newIntNode(0) +proc one(): PNode = nkIntLit.newIntNode(1) +proc minusOne(): PNode = nkIntLit.newIntNode(-1) + +proc lowBound*(conf: ConfigRef; x: PNode): PNode = + result = nkIntLit.newIntNode(firstOrd(conf, x.typ)) + result.info = x.info -proc buildIsNil(arg: PNode): PNode = - result = newNodeI(nkCall, arg.info, 2) - result.sons[0] = newSymNode(getSysMagic("isNil", mIsNil)) - result.sons[1] = arg +proc highBound*(conf: ConfigRef; x: PNode; o: Operators): PNode = + let typ = x.typ.skipTypes(abstractInst) + result = if typ.kind == tyArray: + nkIntLit.newIntNode(lastOrd(conf, typ)) + elif typ.kind == tySequence and x.kind == nkSym and + x.sym.kind == skConst: + nkIntLit.newIntNode(x.sym.astdef.len-1) + else: + o.opAdd.buildCall(o.opLen.buildCall(x), minusOne()) + result.info = x.info -proc usefulFact(n: PNode): PNode = +proc reassociation(n: PNode; o: Operators): PNode = + result = n + # (foo+5)+5 --> foo+10; same for '*' + case result.getMagic + of someAdd: + if result[2].isValue and + result[1].getMagic in someAdd and result[1][2].isValue: + result = o.opAdd.buildCall(result[1][1], result[1][2] |+| result[2]) + if result[2].intVal == 0: + result = result[1] + of someMul: + if result[2].isValue and + result[1].getMagic in someMul and result[1][2].isValue: + result = o.opMul.buildCall(result[1][1], result[1][2] |*| result[2]) + if result[2].intVal == 1: + result = result[1] + elif result[2].intVal == 0: + result = zero() + else: discard + +proc pred(n: PNode): PNode = + if n.kind in {nkCharLit..nkUInt64Lit} and n.intVal != low(BiggestInt): + result = copyNode(n) + dec result.intVal + else: + result = n + +proc buildLe*(o: Operators; a, b: PNode): PNode = + result = o.opLe.buildCall(a, b) + +proc canon*(n: PNode; o: Operators): PNode = + if n.safeLen >= 1: + result = shallowCopy(n) + for i in 0..<n.len: + result[i] = canon(n[i], o) + elif n.kind == nkSym and n.sym.kind == skLet and + 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[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 someSub: + # x - 4 --> x + (-4) + result = negate(result[1], result[2], result, o) + of someLen: + 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) + let minus = if p != y: p else: o.opAdd.buildCall(y, minusOne()).canon(o) + result = o.opLe.buildCall(n[1].canon(o), minus) + else: discard + + result = skipConv(result) + result = reassociation(result, o) + # most important rule: (x-4) <= a.len --> x <= a.len+4 + case result.getMagic + of someLe: + let x = result[1] + let y = result[2] + if x.kind in nkCallKinds and x.len == 3 and x[2].isValue and + isLetLocation(x[1], true): + case x.getMagic + of someSub: + result = buildCall(result[0].sym, x[1], + reassociation(o.opAdd.buildCall(y, x[2]), o)) + of someAdd: + # Rule A: + let plus = negate(y, x[2], nil, o).reassociation(o) + if plus != nil: result = buildCall(result[0].sym, x[1], plus) + else: discard + elif y.kind in nkCallKinds and y.len == 3 and y[2].isValue and + isLetLocation(y[1], true): + # a.len < x-3 + case y.getMagic + of someSub: + result = buildCall(result[0].sym, y[1], + reassociation(o.opAdd.buildCall(x, y[2]), o)) + of someAdd: + let plus = negate(x, y[2], nil, o).reassociation(o) + # ensure that Rule A will not trigger afterwards with the + # additional 'not isLetLocation' constraint: + 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].kind == x.kind: + # 0 <= a.len + 3 + # -3 <= a.len + 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[1] = x |+| y[2] + result[2] = y[1] + else: discard + +proc buildAdd*(a: PNode; b: BiggestInt; o: Operators): PNode = + canon(if b != 0: o.opAdd.buildCall(a, nkIntLit.newIntNode(b)) else: a, o) + +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 = buildIsNil(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]) - b = usefulFact(n.sons[2]) + 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(getSysMagic("and", mAnd)) - 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]) + let a = usefulFact(n[1], o) if a != nil: - result = a.neg + result = a.neg(o) + else: + result = nil of mOr: # 'or' sucks! (p.isNil or q.isNil) --> hard to do anything # with that knowledge... - # DeMorgan helps a little though: + # DeMorgan helps a little though: # not a or not b --> not (a and b) # (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]).neg - b = usefulFact(n.sons[2]).neg + 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(getSysMagic("and", mAnd)) - result.sons[1] = a - result.sons[2] = b - result = result.neg + 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: - result = usefulFact(n.sym.ast) + if n.sym.astdef != nil: + result = usefulFact(n.sym.astdef, o) + else: + result = nil elif n.kind == nkStmtListExpr: - result = usefulFact(n.lastSon) + result = usefulFact(n.lastSon, o) + else: + result = nil type - TModel* = seq[PNode] # the "knowledge base" + TModel* = object + s*: seq[PNode] # the "knowledge base" + g*: ModuleGraph + beSmart*: bool -proc addFact*(m: var TModel, n: PNode) = - let n = usefulFact(n) - if n != nil: m.add n +proc addFact*(m: var TModel, nn: PNode) = + 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 +proc addFactNeg*(m: var TModel, n: PNode) = + let n = n.neg(m.g.operators) if n != nil: addFact(m, n) -proc sameTree(a, b: PNode): bool = +proc sameOpr(a, b: PSym): bool = + case a.magic + of someEq: result = b.magic in someEq + of someLe: result = b.magic in someLe + of someLt: result = b.magic in someLt + of someLen: result = b.magic in someLen + of someAdd: result = b.magic in someAdd + of someSub: result = b.magic in someSub + of someMul: result = b.magic in someMul + of someDiv: result = b.magic in someDiv + else: result = a == b + +proc sameTree*(a, b: PNode): bool = result = false if a == b: result = true - elif (a != nil) and (b != nil) and (a.kind == b.kind): + elif a != nil and b != nil and a.kind == b.kind: case a.kind - of nkSym: result = a.sym == b.sym + of nkSym: + result = a.sym == b.sym + 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: # Re-assignments (incl. pass to a 'var' param) trigger an invalidation - # of every fact that contains 'v'. - # + # of every fact that contains 'v'. + # # if x < 4: # if y < 5 # x = unknown() @@ -245,106 +499,132 @@ 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): - if m[i] != nil and m[i].hasSubTree(n): m[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) - -proc pred(n: PNode): PNode = - if n.kind in {nkCharLit..nkUInt64Lit} and n.intVal != low(biggestInt): - result = copyNode(n) - dec result.intVal + result = not sameValue(a, b) else: - result = n - -type - TImplication* = enum - impUnknown, impNo, impYes + result = false proc impliesEq(fact, eq: PNode): TImplication = - let (loc, val) = if isLocation(eq.sons[1]): (1, 2) else: (2, 1) - - case fact.sons[0].sym.magic + let (loc, val) = if isLocation(eq[1]): (1, 2) else: (2, 1) + + 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: internalError(eq.info, "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}: # fact: x <= 4; question x in {56}? # --> true if every value <= 4 is in the set {56} - # - var value = newIntNode(c.kind, firstOrd(x.typ)) + # + 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}: # fact: x >= 4; question x in {56}? # --> true iff every value >= 4 is in the set {56} - # + # var value = newIntNode(c.kind, c.intVal) - let max = lastOrd(x.typ) + 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(a, b): result = impYes - elif intersectSets(a, b).len == 0: result = impNo + 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: internalError(loc.info, "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 @@ -352,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: internalError(eq.info, "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 = - InternalAssert isLocation(x) - case fact.sons[0].sym.magic + assert isLocation(x) + 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: internalError(x.info, "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 - - elif sameTree(fact.sons[2], x): + else: + result = impUnknown + + 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: internalError(x.info, "impliesLe") - else: nil + 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: @@ -450,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 @@ -468,117 +808,379 @@ proc factImplies(fact, prop: PNode): TImplication = # it's provably wrong if every value > 4 is in the set {56} # That's because we compute the implication and 'a -> not b' cannot # be treated the same as 'not a -> b' - + # (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: + 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: - InternalError(fact.info, "invalid fact") + 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]) - 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]) - else: - internalError(prop.info, "invalid proposition") + + 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[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 - for f in facts: + result = impUnknown + for f in facts.s: # facts can be invalidated, in which case they are 'nil': if not f.isNil: result = f.factImplies(prop) if result != impUnknown: return -proc impliesNotNil*(facts: TModel, arg: PNode): TImplication = - result = doesImply(facts, buildIsNil(arg).neg) +proc impliesNotNil*(m: TModel, arg: PNode): TImplication = + 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 + # as if it is (i+0)..(i+0). + if guards.sameTree(a, b): + if a.getMagic in someAdd and a[2].kind in {nkCharLit..nkUInt64Lit}: + result = a[2].intVal + else: + result = 0 + else: + result = -1 + + +template isMul(x): untyped = x.getMagic in someMul +template isDiv(x): untyped = x.getMagic in someDiv +template isAdd(x): untyped = x.getMagic in someAdd +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 std/macros + +macro `=~`(x: PNode, pat: untyped): bool = + proc m(x, pat, conds: NimNode) = + case pat.kind + of nnkInfix: + case $pat[0] + of "*": conds.add getAst(isMul(x)) + of "/": conds.add getAst(isDiv(x)) + of "+": conds.add getAst(isAdd(x)) + of "-": conds.add getAst(isSub(x)) + else: + error("invalid pattern") + m(newTree(nnkBracketExpr, x, newLit(1)), pat[1], conds) + m(newTree(nnkBracketExpr, x, newLit(2)), pat[2], conds) + of nnkPar: + if pat.len == 1: + m(x, pat[0], conds) + else: + error("invalid pattern") + of nnkIdent: + let c = newTree(nnkStmtListExpr, newLetStmt(pat, x)) + conds.add c + # XXX why is this 'isVal(pat)' and not 'isVal(x)'? + if ($pat)[^1] == 'c': c.add(getAst(isVal(x))) + else: c.add bindSym"true" + of nnkIntLit: + conds.add(getAst(isIntVal(x, pat.intVal))) + else: + error("invalid pattern") + + var conds = newTree(nnkBracket) + m(x, pat, conds) + result = nestList(ident"and", conds) + +proc isMinusOne(n: PNode): bool = + n.kind in {nkCharLit..nkUInt64Lit} and n.intVal == -1 + +proc pleViaModel(model: TModel; aa, bb: PNode): TImplication + +proc ple(m: TModel; a, b: PNode): TImplication = + template `<=?`(a,b): untyped = ple(m,a,b) == impYes + template `>=?`(a,b): untyped = ple(m, nkIntLit.newIntNode(b), a) == impYes + + # 0 <= 3 + if a.isValue and b.isValue: + return if leValue(a, b): impYes else: impNo + + # use type information too: x <= 4 iff high(x) <= 4 + if b.isValue and a.typ != nil and a.typ.isOrdinalType: + 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 a.intVal <= firstOrd(nil, b.typ): return impYes + + # x <= x + if sameTree(a, b): return impYes + + # 0 <= x.len + if b.getMagic in someLen and a.isValue: + if a.intVal <= 0: return impYes + + # x <= y+c if 0 <= c and x <= y + # x <= y+(-c) if c <= 0 and y >= x + 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 + + # x <= y*c if 1 <= c and x <= y and 0 <= y + if b.getMagic in someMul: + if a <=? b[1] and one() <=? b[2] and zero() <=? b[1]: return impYes + + + 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.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.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.g.operators.opAdd.buildCall(ec, minusOne()) + if x >=? 1 and ec >=? 1 and dc >=? 1 and dc <=? ec1 and y <=? zero(): + return impYes + + # x+c <= x+d if c <= d. Same for *, - etc. + if a.getMagic in someBinaryOp and a.getMagic == b.getMagic: + if sameTree(a[1], b[1]) and a[2] <=? b[2]: return impYes + elif sameTree(a[2], b[2]) and a[1] <=? b[1]: return impYes + + # x div c <= y if 1 <= c and 0 <= y and x <= y: + if a.getMagic in someDiv: + if one() <=? a[2] and zero() <=? b and a[1] <=? b: return impYes + + # x div c <= x div d if d <= c + if b.getMagic in someDiv: + if sameTree(a[1], b[1]) and b[2] <=? a[2]: return impYes + + # x div z <= x - 1 if z <= x + if a[2].isValue and b.getMagic in someAdd and b[2].isMinusOne: + if a[2] <=? a[1] and sameTree(a[1], b[1]): return impYes + + # slightly subtle: + # x <= max(y, z) iff x <= y or x <= z + # note that 'x <= max(x, z)' is a special case of the above rule + if b.getMagic in someMax: + if a <=? b[1] or a <=? b[2]: return impYes + + # min(x, y) <= z iff x <= z or y <= z + if a.getMagic in someMin: + if a[1] <=? b or a[2] <=? b: return impYes + + # use the knowledge base: + return pleViaModel(m, a, b) + #return doesImply(m, o.opLe.buildCall(a, b)) + +type TReplacements = seq[tuple[a, b: PNode]] + +proc replaceSubTree(n, x, by: PNode): PNode = + if sameTree(n, x): + result = by + elif hasSubTree(n, x): + result = shallowCopy(n) + for i in 0..n.safeLen-1: + result[i] = replaceSubTree(n[i], x, by) + else: + result = n + +proc applyReplacements(n: PNode; rep: TReplacements): PNode = + result = n + for x in rep: result = result.replaceSubTree(x.a, x.b) + +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: + # mark as used: + m.s[i] = nil + # i <= len-100 + # i <=? len-1 + # --> true if (len-100) <= (len-1) + let x = fact[1] + let y = fact[2] + # 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: + if ple(m, y, b) == impYes: + return impYes + #if pleViaModelRec(m, y, b): return impYes + # fact: 16 <= i + # x y + # question: i <= 15? no! + result = impliesLe(fact, a, b) + if result != impUnknown: + return result + when false: + # given: x <= y; y==a; x <= a this means: a <= b if x <= b + if sameTree(y, a): + result = ple(m, b, x) + if result != impUnknown: + return result + +proc pleViaModel(model: TModel; aa, bb: PNode): TImplication = + # compute replacements: + var replacements: TReplacements = @[] + for fact in model.s: + if fact != nil and fact.getMagic in someEq: + let a = fact[1] + let b = fact[2] + if a.kind == nkSym: replacements.add((a,b)) + else: replacements.add((b,a)) + var m = TModel() + var a = aa + var b = bb + if replacements.len > 0: + m.s = @[] + 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.g.operators) + a = applyReplacements(aa, replacements) + b = applyReplacements(bb, replacements) + else: + # we have to make a copy here, because the model will be modified: + m = model + result = pleViaModelRec(m, a, b) + +proc proveLe*(m: TModel; a, b: PNode): TImplication = + 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.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.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): PNode = +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(getSysMagic("contains", mInSet)) - result.sons[1] = s - result.sons[2] = loc - -proc buildElse(n: PNode): 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]) + 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[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(getSysMagic("contains", mInSet)) - 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(getSysMagic("==", mEqI)) - fact.sons[1] = n.sons[0] - fact.sons[2] = n.sons[1] - m.add fact + 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(getSysMagic("==", mEqI)) - fact.sons[1] = key - fact.sons[2] = value - m.add fact + 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 = + # This should be used to check whether two *path expressions* refer to the + # same memory location according to 'm'. This is tricky: + # lock a[i].guard: + # ... + # access a[i].guarded + # + # Here a[i] is the same as a[i] iff 'i' and 'a' are not changed via '...'. + # 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[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.add buildOf(branch, n.sons[0]) + m.s.add buildOf(branch, n[0], m.g.operators) else: - m.add n.buildElse.neg + m.s.add n.buildElse(m.g.operators).neg(m.g.operators) -proc buildProperFieldCheck(access, check: PNode): PNode = - if check.sons[1].kind == nkCurly: +proc buildProperFieldCheck(access, check: PNode; o: Operators): PNode = + 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]).neg + result = buildProperFieldCheck(access, check[1], o).neg(o) -proc checkFieldAccess*(m: TModel, n: PNode) = - for i in 1..n.len-1: - let check = buildProperFieldCheck(n.sons[0], n.sons[i]) - if m.doesImply(check) != impYes: - Message(n.info, warnProveField, renderTree(n.sons[0])); break +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: + 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 152fd4414..9fdec38c0 100644 --- a/compiler/hlo.nim +++ b/compiler/hlo.nim @@ -1,91 +1,106 @@ # # -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2013 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # # 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 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 gOptions and hintPattern in gNotes: - 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) of skTemplate: - result = semTemplateExpr(c, n, s) + result = semTemplateExpr(c, n, s, {efFromHlo}) else: result = semDirectOp(c, n, {}) - if optHints in gOptions and hintPattern in gNotes: - Message(orig.info, hintPattern, rule & " --> '" & + if c.config.hasHint(hintPattern): + message(c.config, orig.info, hintPattern, rule & " --> '" & renderTree(result, {renderNoComments}) & "'") - # check the resulting AST for optimization rules again: - result = hlo(c, result) proc applyPatterns(c: PContext, n: PNode): PNode = result = n # we apply the last pattern first, so that pattern overriding is possible; # however the resulting AST would better not trigger the old rule then # anymore ;-) - for i in countdown(<c.patterns.len, 0): + for i in countdown(c.patterns.len-1, 0): let pattern = c.patterns[i] if not isNil(pattern): let x = applyRule(c, pattern, result) if not isNil(x): assert x.kind in {nkStmtList, nkCall} - inc(evalTemplateCounter) - if evalTemplateCounter > 100: - GlobalError(n.info, errTemplateInstantiationTooNested) + # better be safe than sorry, so check evalTemplateCounter too: + inc(c.config.evalTemplateCounter) + if c.config.evalTemplateCounter > evalTemplateLimit: + globalError(c.config, n.info, "template instantiation too nested") # deactivate this pattern: 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) - dec(evalTemplateCounter) + dec(c.config.evalTemplateCounter) # activate this pattern again: c.patterns[i] = pattern proc hlo(c: PContext, n: PNode): PNode = + inc(c.hloLoopDetector) + # simply stop and do not perform any further transformations: + if c.hloLoopDetector > 300: return n case n.kind of nkMacroDef, nkTemplateDef, procDefs: # already processed (special cases in semstmts.nim) result = n else: + 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 n.typ == nil and (result.typ == nil or - result.typ.kind in {tyStmt, tyEmpty}): - nil + if isEmptyType(n.typ) and isEmptyType(result.typ): + discard else: - result = fitNode(c, n.typ, result) + result = fitNode(c, n.typ, result, n.info) + # optimization has been applied so check again: + result = commonOptimizations(c.graph, c.idgen, c.module, result) + result = hlo(c, 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 gOptions: 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 gOptions: 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 a50c5269c..34177e76d 100644 --- a/compiler/idents.nim +++ b/compiler/idents.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -11,23 +11,29 @@ # 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 +import wordrecg +import std/hashes -type - TIdObj* = object of TObject - id*: int # unique id; use this for comparisons and not the pointers - - PIdObj* = ref TIdObj +when defined(nimPreviewSlimSystem): + import std/assertions + +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*: THash # hash value of s - -var buckets*: array[0..4096 * 2 - 1, PIdent] + h*: Hash # hash value of s + + IdentCache* = ref object + buckets: array[0..4096 * 2 - 1, PIdent] + wordCounter: int + idAnon*, idDelegator*, emptyIdent*: PIdent -proc cmpIgnoreStyle(a, b: cstring, blen: int): int = +proc resetIdentCache*() = discard + +proc cmpIgnoreStyle*(a, b: cstring, blen: int): int = + if a[0] != b[0]: return 1 var i = 0 var j = 0 result = 1 @@ -40,12 +46,12 @@ proc cmpIgnoreStyle(a, b: cstring, blen: int): int = if aa >= 'A' and aa <= 'Z': aa = chr(ord(aa) + (ord('a') - ord('A'))) if bb >= 'A' and bb <= 'Z': bb = chr(ord(bb) + (ord('a') - ord('A'))) result = ord(aa) - ord(bb) - if (result != 0) or (aa == '\0'): break + if (result != 0) or (aa == '\0'): break inc(i) inc(j) if result == 0: if a[i] != '\0': result = 1 - + proc cmpExact(a, b: cstring, blen: int): int = var i = 0 var j = 0 @@ -54,27 +60,25 @@ proc cmpExact(a, b: cstring, blen: int): int = var aa = a[i] var bb = b[j] result = ord(aa) - ord(bb) - if (result != 0) or (aa == '\0'): break + if (result != 0) or (aa == '\0'): break inc(i) inc(j) - if result == 0: + if result == 0: if a[i] != '\0': result = 1 -var wordCounter = 1 - -proc getIdent*(identifier: cstring, length: int, h: THash): 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: - if cmpExact(cstring(result.s), identifier, length) == 0: - if last != nil: + while result != nil: + if cmpExact(cstring(result.s), identifier, length) == 0: + if last != nil: # make access to last looked up identifier faster: last.next = result.next - result.next = buckets[idx] - buckets[idx] = result - return + 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)) id = result.id @@ -83,24 +87,37 @@ proc getIdent*(identifier: cstring, length: int, h: THash): PIdent = 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 - if id == 0: - inc(wordCounter) - result.id = -wordCounter - else: + for i in 0..<length: result.s[i] = identifier[i] + result.next = ic.buckets[idx] + ic.buckets[idx] = result + if id == 0: + inc(ic.wordCounter) + result.id = -ic.wordCounter + else: result.id = id -proc getIdent*(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*(identifier: string, h: THash): 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 IdentEq*(id: PIdent, name: string): bool = - result = id.id == getIdent(name).id +proc newIdentCache*(): IdentCache = + result = IdentCache() + result.idAnon = result.getIdent":anonymous" + result.wordCounter = 1 + result.idDelegator = result.getIdent":delegator" + result.emptyIdent = result.getIdent("") + # initialize the keywords: + for s in succ(low(TSpecialWord))..high(TSpecialWord): + result.getIdent($s, hashIgnoreStyle($s)).id = ord(s) -var idAnon* = getIdent":anonymous" +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 fbf450c90..000000000 --- a/compiler/idgen.nim +++ /dev/null @@ -1,65 +0,0 @@ -# -# -# The Nimrod 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, gBackendId*: 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 backendId*(): int {.inline.} = - result = gBackendId - inc(gBackendId) - -proc setId*(id: int) {.inline.} = - gFrontEndId = max(gFrontEndId, id + 1) - -proc IDsynchronizationPoint*(idRange: int) = - gFrontEndId = (gFrontEndId div IdRange + 1) * IdRange + 1 - -proc toGid(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("nimrod.gid") - -proc saveMaxIds*(project: string) = - var f = open(project.toGid, fmWrite) - f.writeln($gFrontEndId) - f.writeln($gBackEndId) - f.close() - -proc loadMaxIds*(project: string) = - var f: TFile - if open(f, project.toGid, 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) - gBackEndId = max(gBackEndId, backEndId) - f.close() diff --git a/compiler/importer.nim b/compiler/importer.nim index 7159072f7..ffb7e0305 100644 --- a/compiler/importer.nim +++ b/compiler/importer.nim @@ -1,124 +1,220 @@ # # -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2013 Andreas Rumpf # # See the file "copying.txt", included in this # 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, rodread, lookups, - semdata, passes, renderer +import + 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 getModuleName*(n: PNode): string = - # This returns a short relative module name without the nim extension - # e.g. like "system", "importer" or "somepath/module" - # The proc won't perform any checks that the path is actually valid - case n.kind - of nkStrLit, nkRStrLit, nkTripleStrLit: - result = UnixToNativePath(n.strVal) - of nkIdent: - result = n.ident.s - of nkSym: - result = n.sym.name.s - else: - # hacky way to implement 'x / y /../ z': - result = renderTree(n, {renderNoComments}).replace(" ") - #localError(n.info, errGenerated, - # "invalide module name: '$1'" % renderTree(n)) - #result = "" - -proc checkModuleName*(n: PNode): int32 = - # This returns the full canonical path for a given module import - let modulename = n.getModuleName - let fullPath = findModule(modulename) - if fullPath.len == 0: - LocalError(n.info, errCannotOpenFile, modulename) - result = InvalidFileIDX - else: - result = fullPath.fileInfoIdx +proc readExceptSet*(c: PContext, n: PNode): IntSet = + assert n.kind in {nkImportExceptStmt, nkExportExceptStmt} + result = initIntSet() + for i in 1..<n.len: + let ident = lookups.considerQuotedIdent(c, n[i]) + result.incl(ident.id) + +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: - # 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} and sfPure notin s.flags: - for j in countup(0, sonsLen(etyp.n) - 1): - var e = etyp.n.sons[j].sym - if e.Kind != skEnumField: - InternalError(s.info, "rawImportSymbol") + 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") # 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: - rawImportSymbol(c, e) + if sfPure notin s.flags: + 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 importSymbol(c: PContext, n: PNode, fromMod: PSym) = - let ident = lookups.considerAcc(n) - let s = StrTableGet(fromMod.tab, ident) +proc splitPragmas(c: PContext, n: PNode): (PNode, seq[TSpecialWord]) = + template bail = globalError(c.config, n.info, "invalid pragma") + result = (nil, @[]) + if n.kind == nkPragmaExpr: + if n.len == 2 and n[1].kind == nkPragma: + result[0] = n[0] + for ni in n[1]: + if ni.kind == nkIdent: result[1].add whichKeyword(ni.ident) + else: bail() + else: bail() + else: + result[0] = n + if result[0].safeLen > 0: + (result[0][^1], result[1]) = splitPragmas(c, result[0][^1]) + +proc importSymbol(c: PContext, n: PNode, fromMod: PSym; importSet: var IntSet) = + let (n, kws) = splitPragmas(c, n) + if kws.len > 0: + globalError(c.config, n.info, "unexpected pragma") + + let ident = lookups.considerQuotedIdent(c, n) + let s = someSym(c.graph, fromMod, ident) if s == nil: - LocalError(n.info, errUndeclaredIdentifier, ident.s) + errorUndeclaredIdentifier(c, n.info, ident.s) else: - if s.kind == skStub: loadStub(s) - if s.Kind notin ExportableSymKinds: - InternalError(n.info, "importSymbol: 2") + when false: + if s.kind == skStub: loadStub(s) + let multiImport = s.kind notin ExportableSymKinds or s.kind in skProcKinds # for an enumeration we have to add all identifiers - case s.Kind - of skProc, skMethod, skIterator, skMacro, skTemplate, skConverter: + 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(n.info, "importSymbol: 3") - rawImportSymbol(c, e) - e = NextIdentIter(it, fromMod.tab) - else: rawImportSymbol(c, s) - -proc importAllSymbolsExcept(c: PContext, fromMod: PSym, exceptSet: TIntSet) = - 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(s.info, "importAllSymbols: " & $s.kind) - if exceptSet.empty or s.name.id notin exceptSet: - rawImportSymbol(c, s) - s = NextIter(i, fromMod.tab) + if e.name.id != s.name.id: internalError(c.config, n.info, "importSymbol: 3") + if s.kind in ExportableSymKinds: + rawImportSymbol(c, e, fromMod, importSet) + e = nextModuleIter(it, c.graph) + 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) = + 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: TIntSet - 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: TIntSet) = +proc importForwarded(c: PContext, n: PNode, exceptSet: IntSet; fromMod: PSym; importSet: var IntSet) = if n.isNil: return case n.kind of nkExportStmt: @@ -127,51 +223,171 @@ proc importForwarded(c: PContext, n: PNode, exceptSet: TIntSet) = let s = a.sym if s.kind == skModule: importAllSymbolsExcept(c, s, exceptSet) - elif exceptSet.empty or s.name.id notin exceptSet: - rawImportSymbol(c, s) + elif exceptSet.isNil or s.name.id notin exceptSet: + rawImportSymbol(c, s, fromMod, importSet) of nkExportExceptStmt: - localError(n.info, errGenerated, "'export except' not implemented") + localError(c.config, n.info, "'export except' not implemented") + else: + for i in 0..n.safeLen-1: + importForwarded(c, n[i], exceptSet, fromMod, importSet) + +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[1].kind != nkIdent: + localError(c.config, n.info, "module alias must be an identifier") + elif n[1].ident.id != realModule.name.id: + # some misguided guy will write 'import abc.foo as foo' ... + result = 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: 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 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 + + 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) # 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: + 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: - for i in 0 ..safeLen(n)-1: - importForwarded(c, n.sons[i], exceptSet) - -proc evalImport(c: PContext, n: PNode): PNode = - result = n - var emptySet: TIntSet - for i in countup(0, sonsLen(n) - 1): - var f = checkModuleName(n.sons[i]) - if f != InvalidFileIDX: - var m = gImportModule(c.module, f) - if sfDeprecated in m.flags: - Message(n.sons[i].info, warnDeprecated, m.name.s) - # ``addDecl`` needs to be done before ``importAllSymbols``! - addDecl(c, m) # add symbol to symbol table of module - importAllSymbolsExcept(c, m, emptySet) - importForwarded(c, m.ast, emptySet) - -proc evalFrom(c: PContext, n: PNode): PNode = - result = n - checkMinSonsLen(n, 2) - var f = checkModuleName(n.sons[0]) - if f != InvalidFileIDX: - var m = gImportModule(c.module, f) - n.sons[0] = newSymNode(m) - addDecl(c, m) # 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) - -proc evalImportExcept*(c: PContext, n: PNode): PNode = - result = n - checkMinSonsLen(n, 2) - var f = checkModuleName(n.sons[0]) - if f != InvalidFileIDX: - var m = gImportModule(c.module, f) - n.sons[0] = newSymNode(m) - addDecl(c, m) # add symbol to symbol table of module - var exceptSet = initIntSet() - for i in countup(1, sonsLen(n) - 1): - let ident = lookups.considerAcc(n.sons[i]) - exceptSet.incl(ident.id) - importAllSymbolsExcept(c, m, exceptSet) - importForwarded(c, m.ast, exceptSet) + 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: + # ``addDecl`` needs to be done before ``importAllSymbols``! + addDecl(c, m, it.info) # add symbol to symbol table of module + importAllSymbols(c, m) + #importForwarded(c, m.ast, emptySet, m) + afterImport(c, m) + +proc evalImport*(c: PContext, n: PNode): PNode = + result = newNodeI(nkImportStmt, n.info) + for i in 0..<n.len: + let it = n[i] + if it.kind 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 = + result = newNodeI(nkImportStmt, n.info) + checkMinSonsLen(n, 2, c.config) + var m = myImportModule(c, n[0], result) + if m != nil: + n[0] = newSymNode(m) + addDecl(c, m, n.info) # add symbol to symbol table of module + + 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[0], result) + if m != nil: + n[0] = newSymNode(m) + addDecl(c, m, n.info) # add symbol to symbol table of module + importAllSymbolsExcept(c, m, readExceptSet(c, n)) + #importForwarded(c, m.ast, exceptSet, m) + afterImport(c, m) diff --git a/compiler/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 new file mode 100644 index 000000000..54a35dbee --- /dev/null +++ b/compiler/installer.ini @@ -0,0 +1,150 @@ +; This config file holds configuration information about the Nim compiler +; and project. + +[Project] +Name: "Nim" +Version: "$version" +Platforms: """ + windows: i386;amd64 + linux: i386;hppa;ia64;alpha;amd64;powerpc64;arm;sparc;sparc64;m68k;mips;mipsel;mips64;mips64el;powerpc;powerpc64el;arm64;riscv32;riscv64;loongarch64 + macosx: i386;amd64;powerpc64;arm64 + solaris: i386;amd64;sparc;sparc64 + freebsd: i386;amd64;powerpc64;arm;arm64;riscv64;sparc64;mips;mipsel;mips64;mips64el;powerpc;powerpc64el + netbsd: i386;amd64;arm64 + openbsd: i386;amd64;arm;arm64 + dragonfly: i386;amd64 + crossos: amd64 + haiku: i386;amd64 + android: i386;arm;arm64 + nintendoswitch: arm64 +""" + +Authors: "Andreas Rumpf" +Description: """This is the Nim Compiler. Nim is a new statically typed, +imperative programming language, that supports procedural, functional, object +oriented and generic programming styles while remaining simple and efficient. +A special feature that Nim inherited from Lisp is that Nim's abstract +syntax tree (AST) is part of the specification - this allows a powerful macro +system which can be used to create domain specific languages. + +Nim is a compiled, garbage-collected systems programming language +which has an excellent productivity/performance ratio. Nim's design +focuses on the 3E: efficiency, expressiveness, elegance (in the order of +priority).""" + +App: Console +License: "copying.txt" + +[Config] +Files: "config/*.cfg" +Files: "config/config.nims" + +[Documentation] +; Files: "doc/*.html" +; Files: "doc/*.cfg" +; Files: "doc/*.pdf" +; Files: "doc/*.ini" +Files: "doc/html/overview.html" +Start: "doc/html/overview.html" + + +[Other] +Files: "copying.txt" +Files: "koch.nim" + +Files: "icons/nim.ico" +Files: "icons/nim.rc" +Files: "icons/nim.res" +Files: "icons/nim_icon.o" +Files: "icons/koch.ico" +Files: "icons/koch.rc" +Files: "icons/koch.res" +Files: "icons/koch_icon.o" + +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: "changelogs/*.md" +Files: "ci/funs.sh" + +[Lib] +Files: "lib" + +[Other] +Files: "examples" +Files: "dist/nimble" +Files: "dist/checksums" + +Files: "tests" + +[Windows] +Files: "bin/nim.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" +; Files: "bin/downloader.exe" + +; Files: "dist/mingw" +Files: r"tools\start.bat" +BinPath: r"bin;dist\mingw\bin;dist" + +; Section | dir | zipFile | size hint (in KB) | url | exe start menu entry +Download: r"Documentation|doc|docs.zip|13824|https://nim-lang.org/download/docs-${version}.zip|overview.html" +Download: r"C Compiler (MingW)|dist|mingw.zip|82944|https://nim-lang.org/download/${mingw}.zip" +Download: r"Support DLLs|bin|nim_dlls.zip|479|https://nim-lang.org/download/dlls.zip" +Download: r"Aporia Text Editor|dist|aporia.zip|97997|https://nim-lang.org/download/aporia-0.4.0.zip|aporia-0.4.0\bin\aporia.exe" +; for now only NSIS supports optional downloads + +[WinBin] +Files: "bin/makelink.exe" +Files: "bin/7zG.exe" +Files: "bin/*.dll" +Files: "bin/cacert.pem" + +[UnixBin] +Files: "bin/nim" + + +[Unix] +InstallScript: "yes" +UninstallScript: "yes" +Files: "bin/nim-gdb" +Files: "build_all.sh" + + +[InnoSetup] +path = r"c:\Program Files (x86)\Inno Setup 5\iscc.exe" +flags = "/Q" + +[NSIS] +flags = "/V0" + +[C_Compiler] +path = r"" +flags = "-w" + + +[deb] +buildDepends: "gcc (>= 4:4.3.2)" +pkgDepends: "gcc (>= 4:4.3.2)" +shortDesc: "The Nim Compiler" +licenses: "bin/nim,MIT;lib/*,MIT;" + +[nimble] +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 8e84f7b6b..713944def 100644 --- a/compiler/jsgen.nim +++ b/compiler/jsgen.nim @@ -1,26 +1,58 @@ # # -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # # This is the JavaScript code generator. -# Soon also a Luajit code generator. ;-) + +discard """ +The JS code generator contains only 2 tricks: + +Trick 1 +------- +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. + +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` +implements the required case distinction. +""" + import - ast, astalgo, strutils, hashes, trees, platform, magicsys, extccomp, - options, nversion, nimsets, msgs, crc, bitsets, idents, lists, types, os, - times, ropes, math, passes, ccgutils, wordrecg, renderer, rodread, rodutils, - intsets, cgmeth + ast, trees, magicsys, options, + nversion, msgs, idents, types, + ropes, wordrecg, renderer, + cgmeth, lowerings, sighashes, modulegraphs, lineinfos, + transf, injectdestructors, sourcemap, astmsgs, pushpoppragmas, + mangleutils + +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 - TTarget = enum - targetJS, targetLua - 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" @@ -28,6 +60,7 @@ type etyNull, # null type etyProc, # proc type etyBool, # bool type + etySeq, # Nim seq or string type etyInt, # JavaScript's int etyFloat, # JavaScript's float etyString, # JavaScript's string @@ -36,172 +69,306 @@ type TResKind = enum resNone, # not set resExpr, # is some complex expression - resVal # is a temporary/value/l-value + resVal, # is a temporary/value/l-value + resCallee # expression is callee TCompRes = object kind: TResKind typ: TJSTypeKind - res: PRope # result part; index if this is an + res: Rope # result part; index if this is an # (address, index)-tuple - address: PRope # address of an (address, index)-tuple - - TBlock = object + 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 # has been used (i.e. the label should be emitted) isLoop: bool # whether it's a 'block' or 'while' - - TGlobals = object - typeInfo, code: PRope + + PGlobals = ref object of RootObj + typeInfo, constants, code: Rope forwarded: seq[PSym] - generatedSyms: TIntSet - typeInfoGenerated: TIntSet + generatedSyms: IntSet + typeInfoGenerated: IntSet + unique: int # for temp identifier generation + inSystem: bool - PGlobals = ref TGlobals PProc = ref TProc TProc = object procDef: PNode prc: PSym - locals, body: PRope + globals, locals, body: Rope options: TOptions + optionsStack: seq[(TOptions, TNoteKinds)] module: BModule g: PGlobals - BeforeRetNeeded: bool - target: TTarget # duplicated here for faster dispatching + 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 -template `|`(a, b: expr): expr {.immediate, dirty.} = - (if p.target == targetJS: a else: b) +template config*(p: PProc): ConfigRef = p.module.config + +proc indentLine(p: PProc, r: Rope): Rope = + var p = p + if jsNoLambdaLifting in p.config.legacyFeatures: + var ind = 0 + while true: + inc ind, p.blocks.len + p.extraIndent + if p.up == nil or p.up.prc != p.prc.owner: + break + p = p.up + result = repeat(' ', ind*2) & r + else: + let ind = p.blocks.len + p.extraIndent + result = repeat(' ', ind*2) & r + +template line(p: PProc, added: string) = + p.body.add(indentLine(p, rope(added))) -proc newGlobals(): PGlobals = - new(result) - result.forwarded = @[] - result.generatedSyms = initIntSet() - result.typeInfoGenerated = initIntSet() - -proc initCompRes(r: var TCompRes) = - r.address = nil - r.res = nil - r.typ = etyNone - r.kind = resNone +template lineF(p: PProc, frmt: FormatStr, args: varargs[Rope]) = + p.body.add(indentLine(p, ropes.`%`(frmt, args))) -proc rdLoc(a: TCompRes): PRope {.inline.} = - result = a.res - when false: - if a.typ != etyBaseIndex: - result = a.res - else: - result = ropef("$1[$2]", a.address, a.res) +template nested(p, body) = + inc p.extraIndent + body + dec p.extraIndent -proc newProc(globals: PGlobals, module: BModule, procDef: PNode, - options: TOptions): PProc = +proc newGlobals(): PGlobals = + result = PGlobals(forwarded: @[], + generatedSyms: initIntSet(), + typeInfoGenerated: initIntSet() + ) + +proc initCompRes(): TCompRes = + result = TCompRes(address: "", res: "", + tmpLoc: "", typ: etyNone, kind: resNone + ) + +proc rdLoc(a: TCompRes): Rope {.inline.} = + if a.typ != etyBaseIndex: + 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) - if procDef != nil: result.prc = procDef.sons[namePos].sym - -const - MappedToObject = {tyObject, tyArray, tyArrayConstr, tyTuple, tyOpenArray, - tySet, tyVar, tyRef, tyPtr, tyBigNum, tyVarargs} - -proc mapType(typ: PType): TJSTypeKind = + g: globals, + extraIndent: int(procDef != nil)) + if procDef != nil: result.prc = procDef[namePos].sym + +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, + tySet, tyVarargs} + +proc mapType(typ: PType): TJSTypeKind = let t = skipTypes(typ, abstractInst) case t.kind - of tyVar, tyRef, tyPtr: - if skipTypes(t.sons[0], abstractInst).kind in mappedToObject: + of tyVar, tyRef, tyPtr: + if skipTypes(t.elementType, abstractInst).kind in MappedToObject: result = etyObject - else: + else: result = etyBaseIndex of tyPointer: # treat a tyPointer like a typed pointer to an array of bytes - result = etyInt - of tyRange, tyDistinct, tyOrdinal, tyConst, tyMutable, tyIter, - tyProxy: - result = mapType(t.sons[0]) + result = etyBaseIndex + 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: result = etyInt # little hack to get right semantics - of tyObject, tyArray, tyArrayConstr, tyTuple, tyOpenArray, tyBigNum, - tyVarargs: + of tyString, tySequence: result = etySeq + of tyObject, tyArray, tyTuple, tyOpenArray, tyVarargs, tyUncheckedArray: result = etyObject of tyNil: result = etyNull - of tyGenericInst, tyGenericParam, tyGenericBody, tyGenericInvokation, tyNone, - tyForward, tyEmpty, tyExpr, tyStmt, tyTypeDesc, tyTypeClass: + of tyGenericParam, tyGenericBody, tyGenericInvocation, + tyNone, tyFromExpr, tyForward, tyEmpty, + tyUntyped, tyTyped, tyTypeDesc, tyBuiltInTypeClass, tyCompositeTypeClass, + tyAnd, tyOr, tyNot, tyAnything, tyVoid: result = etyNone + of tyGenericInst, tyInferred, tyAlias, tyUserTypeClass, tyUserTypeClassInst, + tySink, tyOwned: + result = mapType(typ.skipModifier) + of tyStatic: + if t.n != nil: result = mapType(skipModifier t) + else: result = etyNone of tyProc: result = etyProc - of tyCString: result = etyString - -proc mangle(name: string): string = - result = "" - for i in countup(0, len(name) - 1): - case name[i] - of 'A'..'Z': - add(result, chr(ord(name[i]) - ord('A') + ord('a'))) - of '_': - nil - of 'a'..'z', '0'..'9': - add(result, name[i]) - else: add(result, 'X' & toHex(ord(name[i]), 2)) - -proc mangleName(s: PSym): PRope = - result = s.loc.r - if result == nil: - result = toRope(mangle(s.name.s)) - app(result, "_") - app(result, toRope(s.id)) - s.loc.r = result - -proc makeJSString(s: string): PRope = strutils.escape(s).toRope + of tyCstring: result = etyString + of tyConcept, tyIterable: + raiseAssert "unreachable" + +proc mapType(p: PProc; typ: PType): TJSTypeKind = + result = mapType(typ) + +proc mangleName(m: BModule, s: PSym): Rope = + proc validJsName(name: string): bool = + result = true + const reservedWords = ["abstract", "await", "boolean", "break", "byte", + "case", "catch", "char", "class", "const", "continue", "debugger", + "default", "delete", "do", "double", "else", "enum", "export", "extends", + "false", "final", "finally", "float", "for", "function", "goto", "if", + "implements", "import", "in", "instanceof", "int", "interface", "let", + "long", "native", "new", "null", "package", "private", "protected", + "public", "return", "short", "static", "super", "switch", "synchronized", + "this", "throw", "throws", "transient", "true", "try", "typeof", "var", + "void", "volatile", "while", "with", "yield"] + case name + of reservedWords: + return false + else: + discard + if name[0] in {'0'..'9'}: return false + for chr in name: + if chr notin {'A'..'Z','a'..'z','_','$','0'..'9'}: + return false + result = s.loc.snippet + if result == "": + if s.kind == skField and s.name.s.validJsName: + result = rope(s.name.s) + elif s.kind == skTemp: + result = rope(mangle(s.name.s)) + else: + var x = newStringOfCap(s.name.s.len) + var i = 0 + while i < s.name.s.len: + let c = s.name.s[i] + case c + of 'A'..'Z', 'a'..'z', '_', '0'..'9': + x.add c + else: + x.add("HEX" & toHex(ord(c), 2)) + inc i + result = rope(x) + # 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: + result.add(idOrSig(s, m.module.name.s, m.sigConflicts, m.config)) + elif s.kind == skParam: + result.add mangleParamExt(s) + elif s.kind in routineKinds: + result.add mangleProcNameExt(m.graph, s) + else: + result.add("_") + result.add(rope(s.id)) + s.loc.snippet = result + +proc escapeJSString(s: string): string = + result = newStringOfCap(s.len + s.len shr 2) + result.add("\"") + for c in items(s): + case c + of '\l': result.add("\\n") + of '\r': result.add("\\r") + of '\t': result.add("\\t") + of '\b': result.add("\\b") + of '\a': result.add("\\a") + of '\e': result.add("\\e") + of '\v': result.add("\\v") + of '\\': result.add("\\\\") + of '\"': result.add("\\\"") + else: result.add(c) + result.add("\"") + +proc makeJSString(s: string, escapeNonAscii = true): Rope = + 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) proc genStmt(p: PProc, n: PNode) -proc genProc(oldProc: PProc, prc: PSym): PRope +proc genProc(oldProc: PProc, prc: PSym): Rope proc genConstant(p: PProc, c: PSym) proc useMagic(p: PProc, name: string) = if name.len == 0: return - var s = magicsys.getCompilerProc(name) + var s = magicsys.getCompilerProc(p.module.graph, name) if s != nil: - internalAssert s.kind in {skProc, skMethod, skConverter} + internalAssert p.config, s.kind in {skProc, skFunc, skMethod, skConverter} if not p.g.generatedSyms.containsOrIncl(s.id): - app(p.g.code, genProc(p, s)) + let code = genProc(p, s) + p.g.constants.add(code) 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: - if p.prc != nil: GlobalError(p.prc.info, errSystemNeeds, name) - else: rawMessage(errSystemNeeds, name) + if p.prc != nil: + globalError(p.config, p.prc.info, "system module needs: " & name) + else: + rawMessage(p.config, errGenerated, "system module needs: " & name) -proc isSimpleExpr(n: PNode): bool = +proc isSimpleExpr(p: PProc; n: PNode): bool = # calls all the way down --> can stay expression based - if n.kind in nkCallKinds+{nkBracketExpr, nkBracket, nkCurly, nkDotExpr, nkPar, - nkObjConstr}: + 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 c.isSimpleExpr: return false - result = true - elif n.isAtom: + if not p.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(p, n.lastSon) + else: + result = n.isAtom -proc getTemp(p: PProc): PRope = +proc getTemp(p: PProc, defineInLocals: bool = true): Rope = inc(p.unique) - result = ropef("Tmp$1", [toRope(p.unique)]) - appf(p.locals, "var $1;$n" | "local $1;$n", [result]) + result = "Temporary$1" % [rope(p.unique)] + if defineInLocals: + p.locals.add(p.indentLine("var $1;$n" % [result])) proc genAnd(p: PProc, a, b: PNode, r: var TCompRes) = assert r.kind == resNone - var x, y: TCompRes - if a.isSimpleExpr and b.isSimpleExpr: + var x, y: TCompRes = default(TCompRes) + if p.isSimpleExpr(a) and p.isSimpleExpr(b): gen(p, a, x) gen(p, b, y) r.kind = resExpr - r.res = ropef("($1 && $2)" | "($1 and $2)", [x.rdLoc, y.rdLoc]) + r.res = "($1 && $2)" % [x.rdLoc, y.rdLoc] else: r.res = p.getTemp r.kind = resVal @@ -215,317 +382,549 @@ proc genAnd(p: PProc, a, b: PNode, r: var TCompRes) = # tmp = b # tmp gen(p, a, x) - p.body.appf("if (!$1) $2 = false; else {" | - "if not $1 then $2 = false; else", x.rdLoc, r.rdLoc) - gen(p, b, y) - p.body.appf("$2 = $1; }" | - "$2 = $1 end", y.rdLoc, r.rdLoc) + lineF(p, "if (!$1) $2 = false; else {", [x.rdLoc, r.rdLoc]) + p.nested: + gen(p, b, y) + lineF(p, "$2 = $1;", [y.rdLoc, r.rdLoc]) + line(p, "}") proc genOr(p: PProc, a, b: PNode, r: var TCompRes) = assert r.kind == resNone - var x, y: TCompRes - if a.isSimpleExpr and b.isSimpleExpr: + var x, y: TCompRes = default(TCompRes) + if p.isSimpleExpr(a) and p.isSimpleExpr(b): gen(p, a, x) gen(p, b, y) r.kind = resExpr - r.res = ropef("($1 || $2)" | "($1 or $2)", [x.rdLoc, y.rdLoc]) + r.res = "($1 || $2)" % [x.rdLoc, y.rdLoc] else: r.res = p.getTemp r.kind = resVal gen(p, a, x) - p.body.appf("if ($1) $2 = true; else {" | - "if $1 then $2 = true; else", x.rdLoc, r.rdLoc) - gen(p, b, y) - p.body.appf("$2 = $1; }" | - "$2 = $1 end", y.rdLoc, r.rdLoc) + lineF(p, "if ($1) $2 = true; else {", [x.rdLoc, r.rdLoc]) + p.nested: + gen(p, b, y) + lineF(p, "$2 = $1;", [y.rdLoc, r.rdLoc]) + line(p, "}") type - TMagicFrmt = array[0..3, 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.floor($1 / $2)"], # DivI - ["modInt", "", "modInt($1, $2)", "Math.floor($1 % $2)"], # ModI - ["addInt64", "", "addInt64($1, $2)", "($1 + $2)"], # AddI64 - ["subInt64", "", "subInt64($1, $2)", "($1 - $2)"], # SubI64 - ["mulInt64", "", "mulInt64($1, $2)", "($1 * $2)"], # MulI64 - ["divInt64", "", "divInt64($1, $2)", "Math.floor($1 / $2)"], # DivI64 - ["modInt64", "", "modInt64($1, $2)", "Math.floor($1 % $2)"], # ModI64 - ["", "", "($1 + $2)", "($1 + $2)"], # AddF64 - ["", "", "($1 - $2)", "($1 - $2)"], # SubF64 - ["", "", "($1 * $2)", "($1 * $2)"], # MulF64 - ["", "", "($1 / $2)", "($1 / $2)"], # DivF64 - ["", "", "($1 >>> $2)", "($1 >>> $2)"], # 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 - ["", "", "($1 >>> $2)", "($1 >>> $2)"], # ShrI64 - ["", "", "($1 << $2)", "($1 << $2)"], # ShlI64 - ["", "", "($1 & $2)", "($1 & $2)"], # BitandI64 - ["", "", "($1 | $2)", "($1 | $2)"], # BitorI64 - ["", "", "($1 ^ $2)", "($1 ^ $2)"], # BitxorI64 - ["nimMin", "nimMin", "nimMin($1, $2)", "nimMin($1, $2)"], # MinI64 - ["nimMax", "nimMax", "nimMax($1, $2)", "nimMax($1, $2)"], # MaxI64 - ["nimMin", "nimMin", "nimMin($1, $2)", "nimMin($1, $2)"], # MinF64 - ["nimMax", "nimMax", "nimMax($1, $2)", "nimMax($1, $2)"], # MaxF64 - ["AddU", "AddU", "AddU($1, $2)", "AddU($1, $2)"], # AddU - ["SubU", "SubU", "SubU($1, $2)", "SubU($1, $2)"], # SubU - ["MulU", "MulU", "MulU($1, $2)", "MulU($1, $2)"], # MulU - ["DivU", "DivU", "DivU($1, $2)", "DivU($1, $2)"], # DivU - ["ModU", "ModU", "ModU($1, $2)", "ModU($1, $2)"], # ModU - ["", "", "($1 == $2)", "($1 == $2)"], # EqI - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeI - ["", "", "($1 < $2)", "($1 < $2)"], # LtI - ["", "", "($1 == $2)", "($1 == $2)"], # EqI64 - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeI64 - ["", "", "($1 < $2)", "($1 < $2)"], # LtI64 - ["", "", "($1 == $2)", "($1 == $2)"], # EqF64 - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeF64 - ["", "", "($1 < $2)", "($1 < $2)"], # LtF64 - ["LeU", "LeU", "LeU($1, $2)", "LeU($1, $2)"], # LeU - ["LtU", "LtU", "LtU($1, $2)", "LtU($1, $2)"], # LtU - ["LeU64", "LeU64", "LeU64($1, $2)", "LeU64($1, $2)"], # LeU64 - ["LtU64", "LtU64", "LtU64($1, $2)", "LtU64($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)"], # EqProc - ["", "", "($1 == $2)", "($1 == $2)"], # EqUntracedRef - ["", "", "($1 <= $2)", "($1 <= $2)"], # LePtr - ["", "", "($1 < $2)", "($1 < $2)"], # LtPtr - ["", "", "($1 == $2)", "($1 == $2)"], # EqCString - ["", "", "($1 != $2)", "($1 != $2)"], # Xor - ["NegInt", "", "NegInt($1)", "-($1)"], # UnaryMinusI - ["NegInt64", "", "NegInt64($1)", "-($1)"], # UnaryMinusI64 - ["AbsInt", "", "AbsInt($1)", "Math.abs($1)"], # AbsI - ["AbsInt64", "", "AbsInt64($1)", "Math.abs($1)"], # AbsI64 - ["", "", "!($1)", "!($1)"], # Not - ["", "", "+($1)", "+($1)"], # UnaryPlusI - ["", "", "~($1)", "~($1)"], # BitnotI - ["", "", "+($1)", "+($1)"], # UnaryPlusI64 - ["", "", "~($1)", "~($1)"], # BitnotI64 - ["", "", "+($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.floor($1)", "Math.floor($1)"], # ToInt - ["", "", "Math.floor($1)", "Math.floor($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"]] - - luaOps: 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.floor($1 / $2)"], # DivI - ["modInt", "", "modInt($1, $2)", "Math.floor($1 % $2)"], # ModI - ["addInt64", "", "addInt64($1, $2)", "($1 + $2)"], # AddI64 - ["subInt64", "", "subInt64($1, $2)", "($1 - $2)"], # SubI64 - ["mulInt64", "", "mulInt64($1, $2)", "($1 * $2)"], # MulI64 - ["divInt64", "", "divInt64($1, $2)", "Math.floor($1 / $2)"], # DivI64 - ["modInt64", "", "modInt64($1, $2)", "Math.floor($1 % $2)"], # ModI64 - ["", "", "($1 + $2)", "($1 + $2)"], # AddF64 - ["", "", "($1 - $2)", "($1 - $2)"], # SubF64 - ["", "", "($1 * $2)", "($1 * $2)"], # MulF64 - ["", "", "($1 / $2)", "($1 / $2)"], # DivF64 - ["", "", "($1 >>> $2)", "($1 >>> $2)"], # 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 - ["", "", "($1 >>> $2)", "($1 >>> $2)"], # ShrI64 - ["", "", "($1 << $2)", "($1 << $2)"], # ShlI64 - ["", "", "($1 & $2)", "($1 & $2)"], # BitandI64 - ["", "", "($1 | $2)", "($1 | $2)"], # BitorI64 - ["", "", "($1 ^ $2)", "($1 ^ $2)"], # BitxorI64 - ["nimMin", "nimMin", "nimMin($1, $2)", "nimMin($1, $2)"], # MinI64 - ["nimMax", "nimMax", "nimMax($1, $2)", "nimMax($1, $2)"], # MaxI64 - ["nimMin", "nimMin", "nimMin($1, $2)", "nimMin($1, $2)"], # MinF64 - ["nimMax", "nimMax", "nimMax($1, $2)", "nimMax($1, $2)"], # MaxF64 - ["AddU", "AddU", "AddU($1, $2)", "AddU($1, $2)"], # AddU - ["SubU", "SubU", "SubU($1, $2)", "SubU($1, $2)"], # SubU - ["MulU", "MulU", "MulU($1, $2)", "MulU($1, $2)"], # MulU - ["DivU", "DivU", "DivU($1, $2)", "DivU($1, $2)"], # DivU - ["ModU", "ModU", "ModU($1, $2)", "ModU($1, $2)"], # ModU - ["", "", "($1 == $2)", "($1 == $2)"], # EqI - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeI - ["", "", "($1 < $2)", "($1 < $2)"], # LtI - ["", "", "($1 == $2)", "($1 == $2)"], # EqI64 - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeI64 - ["", "", "($1 < $2)", "($1 < $2)"], # LtI64 - ["", "", "($1 == $2)", "($1 == $2)"], # EqF64 - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeF64 - ["", "", "($1 < $2)", "($1 < $2)"], # LtF64 - ["LeU", "LeU", "LeU($1, $2)", "LeU($1, $2)"], # LeU - ["LtU", "LtU", "LtU($1, $2)", "LtU($1, $2)"], # LtU - ["LeU64", "LeU64", "LeU64($1, $2)", "LeU64($1, $2)"], # LeU64 - ["LtU64", "LtU64", "LtU64($1, $2)", "LtU64($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)"], # EqProc - ["", "", "($1 == $2)", "($1 == $2)"], # EqUntracedRef - ["", "", "($1 <= $2)", "($1 <= $2)"], # LePtr - ["", "", "($1 < $2)", "($1 < $2)"], # LtPtr - ["", "", "($1 == $2)", "($1 == $2)"], # EqCString - ["", "", "($1 != $2)", "($1 != $2)"], # Xor - ["NegInt", "", "NegInt($1)", "-($1)"], # UnaryMinusI - ["NegInt64", "", "NegInt64($1)", "-($1)"], # UnaryMinusI64 - ["AbsInt", "", "AbsInt($1)", "Math.abs($1)"], # AbsI - ["AbsInt64", "", "AbsInt64($1)", "Math.abs($1)"], # AbsI64 - ["", "", "not ($1)", "not ($1)"], # Not - ["", "", "+($1)", "+($1)"], # UnaryPlusI - ["", "", "~($1)", "~($1)"], # BitnotI - ["", "", "+($1)", "+($1)"], # UnaryPlusI64 - ["", "", "~($1)", "~($1)"], # BitnotI64 - ["", "", "+($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.floor($1)", "Math.floor($1)"], # ToInt - ["", "", "Math.floor($1)", "Math.floor($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 + TMagicFrmt = array[0..1, string] + TMagicOps = array[mAddI..mStrToStr, TMagicFrmt] + +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[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 unsignedTrimmer(size: BiggestInt): string = + case size + of 1: "& 0xff" + of 2: "& 0xffff" + of 4: ">>> 0" + else: "" + +proc signedTrimmer(size: BiggestInt): string = + # sign extension is done by shifting to the left and then back to the right + "<< $1 >> $1" % [$(32 - size * 8)] + +proc binaryUintExpr(p: PProc, n: PNode, r: var TCompRes, op: string, + reassign: static[bool] = false) = + var x, y: TCompRes = 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: + if size == 8 and optJsBigInt64 in p.config.globalOptions: + r.res = "BigInt.asUintN(64, ($1 $2 $3))" % [x.rdLoc, rope op, y.rdLoc] + else: + let trimmer = unsignedTrimmer(size) + r.res = "(($1 $2 $3) $4)" % [x.rdLoc, rope op, y.rdLoc, trimmer] + r.kind = resExpr + +template ternaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string) = + var x, y, z: TCompRes useMagic(p, magic) - gen(p, n.sons[1], x) - gen(p, n.sons[2], y) - r.res = ropef(frmt, [x.rdLoc, y.rdLoc]) + 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 = ropef(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 arithAux(p: PProc, n: PNode, r: var TCompRes, op: TMagic, ops: TMagicOps) = +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, ops[op][i]) - if sonsLen(n) > 2: - gen(p, n.sons[1], x) - gen(p, n.sons[2], y) - r.res = ropef(ops[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 = ropef(ops[op][i + 2], [r.rdLoc]) - r.kind = resExpr + 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) = - arithAux(p, n, r, op, jsOps | luaOps) + 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, "/") + 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 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 + +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: - appf(p.body, "// line $2 \"$1\"$n" | "-- line $2 \"$1\"$n", - [toRope(toFilename(n.info)), toRope(line)]) - if {optStackTrace, optEndb} * p.Options == {optStackTrace, optEndb} and - ((p.prc == nil) or sfPure notin p.prc.flags): - useMagic(p, "endb") - appf(p.body, "endb($1);$n", [toRope(line)]) - elif ({optLineTrace, optStackTrace} * p.Options == - {optLineTrace, optStackTrace}) and - ((p.prc == nil) or not (sfPure in p.prc.flags)): - appf(p.body, "F.line = $1;$n", [toRope(line)]) - + 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 - internalAssert isEmptyType(n.typ) + 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 - let labl = p.unique.toRope - appf(p.body, "L$1: while (true) {$n" | "while true do$n", labl) - gen(p, n.sons[0], cond) - appf(p.body, "if (!$1) break L$2;$n" | "if not $1 then goto ::L$2:: end;$n", + 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, "Label$1: while (true) {$n", [labl]) + p.nested: gen(p, n[0], cond) + lineF(p, "if (!$1) break Label$2;$n", [cond.res, labl]) - genStmt(p, n.sons[1]) - appf(p.body, "}$n" | "end ::L$#::$n", [labl]) - setlen(p.blocks, length) + p.nested: genStmt(p, n[1]) + lineF(p, "}$n", [labl]) + setLen(p.blocks, p.blocks.len - 1) proc moveInto(p: PProc, src: var TCompRes, dest: TCompRes) = if src.kind != resNone: if dest.kind != resNone: - p.body.appf("$1 = $2;$n", dest.rdLoc, src.rdLoc) + lineF(p, "$1 = $2;$n", [dest.rdLoc, src.rdLoc]) else: - p.body.appf("$1;$n", src.rdLoc) + lineF(p, "$1;$n", [src.rdLoc]) src.kind = resNone - src.res = nil + src.res = "" -proc genTry(p: PProc, n: PNode, r: var TCompRes) = +proc genTry(p: PProc, n: PNode, r: var TCompRes) = # code to generate: # - # var sp = {prev: excHandler, exc: null}; - # excHandler = sp; + # ++excHandler; + # var tmpFramePtr = framePtr; # try { # stmts; - # TMP = e - # } catch (e) { + # --excHandler; + # } catch (EXCEPTION) { + # var prevJSError = lastJSError; lastJSError = EXCEPTION; + # framePtr = tmpFramePtr; + # --excHandler; # if (e.typ && e.typ == NTI433 || e.typ == NTI2321) { # stmts; # } else if (e.typ && e.typ == NTI32342) { @@ -533,806 +932,1525 @@ proc genTry(p: PProc, n: PNode, r: var TCompRes) = # } else { # stmts; # } + # lastJSError = prevJSError; # } finally { + # framePtr = tmpFramePtr; # stmts; - # excHandler = excHandler.prev; # } genLineDir(p, n) if not isEmptyType(n.typ): r.kind = resVal r.res = getTemp(p) inc(p.unique) - var safePoint = ropef("Tmp$1", [toRope(p.unique)]) - appf(p.body, - "var $1 = {prev: excHandler, exc: null};$nexcHandler = $1;$n" | - "local $1 = pcall(", - [safePoint]) - if optStackTrace in p.Options: app(p.body, "framePtr = F;" & tnl) - appf(p.body, "try {$n" | "function()$n") - var length = sonsLen(n) - var a: TCompRes - gen(p, n.sons[0], a) - moveInto(p, a, r) var i = 1 - if p.target == targetJS and length > 1 and n.sons[i].kind == nkExceptBranch: - appf(p.body, "} catch (EXC) {$n") - elif p.target == targetLua: - appf(p.body, "end)$n") - while i < length and n.sons[i].kind == nkExceptBranch: - let blen = sonsLen(n.sons[i]) - if blen == 1: + var catchBranchesExist = n.len > 1 and n[i].kind == nkExceptBranch + if catchBranchesExist: + p.body.add("++excHandler;\L") + var tmpFramePtr = rope"F" + lineF(p, "try {$n", []) + var a: TCompRes = default(TCompRes) + gen(p, n[0], a) + moveInto(p, a, r) + var generalCatchBranchExists = false + if catchBranchesExist: + p.body.addf("--excHandler;$n} catch (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: - if i > 1: appf(p.body, "else {$n" | "else$n") - gen(p, n.sons[i].sons[0], a) + generalCatchBranchExists = true + if i > 1: lineF(p, "else {$n", []) + gen(p, n[i][0], a) moveInto(p, a, r) - if i > 1: appf(p.body, "}$n" | "end$n") + if i > 1: lineF(p, "}$n", []) else: - var orExpr: PRope = 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: - InternalError(n.info, "genTryStmt") - if orExpr != nil: app(orExpr, "||" | " or ") - appf(orExpr, "isObj($1.exc.m_type, $2)", - [safePoint, genTypeInfo(p, n.sons[i].sons[j].typ)]) - if i > 1: app(p.body, "else ") - appf(p.body, "if ($1.exc && ($2)) {$n" | "if $1.exc and ($2) then$n", - [safePoint, orExpr]) - gen(p, n.sons[i].sons[blen - 1], a) + 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 != "": 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 (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) - appf(p.body, "}$n" | "end$n") + lineF(p, "}$n", []) inc(i) - if p.target == targetJS: - app(p.body, "} finally {" & tnl & "excHandler = excHandler.prev;" & tnl) - if i < length and n.sons[i].kind == nkFinally: - gen(p, n.sons[i].sons[0], a) - moveInto(p, a, r) - if p.target == targetJS: - app(p.body, "}" & tnl) - if p.target == targetLua: - # we need to repeat the finally block for Lua ... - if i < length and n.sons[i].kind == nkFinally: - gen(p, n.sons[i].sons[0], a) - moveInto(p, a, r) + if catchBranchesExist: + if not generalCatchBranchExists: + useMagic(p, "reraiseException") + line(p, "else {\L") + line(p, "\treraiseException();\L") + line(p, "}\L") + lineF(p, "lastJSError = prevJSError;$n") + line(p, "} finally {\L") + 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") - appf(p.body, "raiseException($1, $2);$n", - [a.rdLoc, makeJSString(typ.sym.name.s)]) + lineF(p, "raiseException($1, $2);$n", + [a.rdLoc, makeJSString(typ.sym.name.s)]) else: + genLineDir(p, n) useMagic(p, "reraiseException") - app(p.body, "reraiseException();" & tnl) + line(p, "reraiseException();\L") -proc genCaseJS(p: PProc, n: PNode, r: var TCompRes) = +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") - appf(p.body, "switch (toJSStr($1)) {$n", [cond.rdLoc]) + lineF(p, "switch (toJSStr($1)) {$n", [cond.rdLoc]) + of tyFloat..tyFloat128, tyInt..tyInt64, tyUInt..tyUInt64: + transferRange = true else: - appf(p.body, "switch ($1) {$n", [cond.rdLoc]) + 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] - case it.kind - of nkOfBranch: - for j in countup(0, sonsLen(it) - 2): - let e = it.sons[j] - if e.kind == nkRange: - var v = copyNode(e.sons[0]) - while v.intVal <= e.sons[1].intVal: - gen(p, v, cond) - appf(p.body, "case $1: ", [cond.rdLoc]) - Inc(v.intVal) - else: - if stringSwitch: - case e.kind - of nkStrLit..nkTripleStrLit: appf(p.body, "case $1: ", - [makeJSString(e.strVal)]) - else: InternalError(e.info, "jsgen.genCaseStmt: 2") - else: - gen(p, e, cond) - appf(p.body, "case $1: ", [cond.rdLoc]) - gen(p, lastSon(it), stmt) - moveInto(p, stmt, r) - appf(p.body, "$nbreak;$n") - of nkElse: - appf(p.body, "default: $n") - gen(p, it.sons[0], stmt) - moveInto(p, stmt, r) - appf(p.body, "break;$n") - else: internalError(it.info, "jsgen.genCaseStmt") - appf(p.body, "}$n") - -proc genCaseLua(p: PProc, n: PNode, r: var TCompRes) = - var - cond, stmt: TCompRes - genLineDir(p, n) - gen(p, n.sons[0], cond) - let stringSwitch = skipTypes(n.sons[0].typ, abstractVar).kind == tyString - if stringSwitch: - useMagic(p, "eqStr") - let tmp = getTemp(p) - appf(p.body, "$1 = $2;$n", [tmp, 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: - if i != 1: appf(p.body, "$nelsif ") - else: appf(p.body, "if ") - for j in countup(0, sonsLen(it) - 2): - if j != 0: app(p.body, " or ") - 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 ia, ib: TCompRes - gen(p, e.sons[0], ia) - gen(p, e.sons[1], ib) - appf(p.body, "$1 >= $2 and $1 <= $3", [tmp, ia.rdLoc, ib.rdLoc]) + 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: appf(p.body, "eqStr($1, $2)", - [tmp, makeJSString(e.strVal)]) - else: InternalError(e.info, "jsgen.genCaseStmt: 2") + 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) - appf(p.body, "$1 == $2", [tmp, cond.rdLoc]) - appf(p.body, " then$n") - gen(p, lastSon(it), stmt) - moveInto(p, stmt, r) + 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) + if transferRange: + lineF(p, "}$n", []) + else: + lineF(p, "break;$n", []) of nkElse: - appf(p.body, "else$n") - gen(p, it.sons[0], stmt) - moveInto(p, stmt, r) - else: internalError(it.info, "jsgen.genCaseStmt") - appf(p.body, "$nend$n") - + if transferRange: + if n.len == 2: # a dangling else for a case statement + transferRange = false + lineF(p, "switch ($1) {$n", [cond.rdLoc]) + lineF(p, "default: $n", []) + else: + lineF(p, "else{$n", []) + else: + lineF(p, "default: $n", []) + p.nested: + gen(p, it[0], stmt) + moveInto(p, stmt, r) + if transferRange: + lineF(p, "}$n", []) + else: + lineF(p, "break;$n", []) + else: internalError(p.config, it.info, "jsgen.genCaseStmt") + 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(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.loc.a = idx - setlen(p.blocks, idx + 1) - p.blocks[idx].id = - p.unique # negative because it isn't used yet + sym.position = idx+1 let labl = p.unique - appf(p.body, "L$1: do {$n" | "", labl.toRope) - gen(p, n.sons[1], r) - appf(p.body, "} while(false);$n" | "$n::L$#::$n", labl.toRope) - setlen(p.blocks, idx) + lineF(p, "Label$1: {$n", [labl.rope]) + setLen(p.blocks, idx + 1) + p.blocks[idx].id = - p.unique # negative because it isn't used yet + gen(p, n[1], r) + setLen(p.blocks, idx) + lineF(p, "};$n", [labl.rope]) -proc genBreakStmt(p: PProc, n: PNode) = +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.loc.a + 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(n.info, "no loop to break") + internalError(p.config, n.info, "no loop to break") p.blocks[idx].id = abs(p.blocks[idx].id) # label is used - appf(p.body, "break L$1;$n" | "goto ::L$1::;$n", [toRope(p.blocks[idx].id)]) + lineF(p, "break Label$1;$n", [rope(p.blocks[idx].id)]) -proc genAsmStmt(p: PProc, n: PNode) = +proc genAsmOrEmitStmt(p: PProc, n: PNode; isAsmStmt = false) = genLineDir(p, n) - assert(n.kind == nkAsmStmt) - for i in countup(0, sonsLen(n) - 1): - case n.sons[i].Kind - of nkStrLit..nkTripleStrLit: app(p.body, n.sons[i].strVal) - of nkSym: app(p.body, mangleName(n.sons[i].sym)) - else: InternalError(n.sons[i].info, "jsgen: genAsmStmt()") - -proc genIf(p: PProc, n: PNode, r: var TCompRes) = - var cond, stmt: TCompRes + 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: + p.body.add(it.strVal) + of nkSym: + let v = it.sym + # for backwards compatibility we don't deref syms here :-( + if false: + discard + else: + 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 = 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 = 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: - appf(p.body, "else {$n" | "else$n", []) + lineF(p, "else {$n", []) inc(toClose) - gen(p, it.sons[0], cond) - appf(p.body, "if ($1) {$n" | "if $# then$n", cond.rdLoc) - gen(p, it.sons[1], stmt) + p.nested: gen(p, it[0], cond) + lineF(p, "if ($1) {$n", [cond.rdLoc]) + gen(p, it[1], stmt) else: # else part: - appf(p.body, "else {$n" | "else$n") - gen(p, it.sons[0], stmt) + lineF(p, "else {$n", []) + p.nested: gen(p, it[0], stmt) moveInto(p, stmt, r) - appf(p.body, "}$n" | "end$n") - if p.target == targetJS: - app(p.body, repeatChar(toClose, '}') & tnl) - else: - for i in 1..toClose: appf(p.body, "end$n") - -proc generateHeader(p: PProc, typ: PType): PRope = - result = nil - for i in countup(1, sonsLen(typ.n) - 1): - if result != nil: app(result, ", ") - assert(typ.n.sons[i].kind == nkSym) - var param = typ.n.sons[i].sym + lineF(p, "}$n", []) + line(p, repeat('}', toClose) & "\L") + +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 - var name = mangleName(param) - app(result, name) - if mapType(param.typ) == etyBaseIndex: - app(result, ", ") - app(result, name) - app(result, "_Idx") - -const - nodeKindsNeedNoCopy = {nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, - nkFloatLit..nkFloat64Lit, nkCurly, nkPar, nkObjConstr, nkStringToCString, - nkCStringToString, nkCall, nkPrefix, nkPostfix, nkInfix, + if result != "": result.add(", ") + var name = mangleName(p.module, param) + result.add(name) + if mapType(param.typ) == etyBaseIndex: + result.add(", ") + result.add(name) + result.add("_Idx") + +proc countJsParams(typ: PType): int = + result = 0 + for i in 1..<typ.n.len: + assert(typ.n[i].kind == nkSym) + var param = typ.n[i].sym + if isCompileTimeOnly(param.typ): continue + if mapType(param.typ) == etyBaseIndex: + inc result, 2 + else: + inc result + +const + nodeKindsNeedNoCopy = {nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, + nkFloatLit..nkFloat64Lit, nkPar, nkStringToCString, + nkObjConstr, nkTupleConstr, nkBracket, + nkCStringToString, nkCall, nkPrefix, nkPostfix, nkInfix, nkCommand, nkHiddenCallConv, nkCallStrLit} -proc needsNoCopy(y: PNode): bool = - result = (y.kind in nodeKindsNeedNoCopy) or - (skipTypes(y.typ, abstractInst).kind in {tyRef, tyPtr, tyVar}) +proc needsNoCopy(p: PProc; y: PNode): bool = + 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 - gen(p, x, a) - gen(p, y, b) - case mapType(x.typ) - of etyObject: - if needsNoCopy(y) or noCopyNeeded: - appf(p.body, "$1 = $2;$n", [a.rdLoc, b.rdLoc]) - else: - useMagic(p, "NimCopy") - appf(p.body, "$1 = NimCopy($2, $3);$n", - [a.res, b.res, genTypeInfo(p, y.typ)]) - of etyBaseIndex: - if a.typ != etyBaseIndex or b.typ != etyBaseIndex: - internalError(x.info, "genAsgn") - appf(p.body, "$1 = $2; $3 = $4;$n", [a.address, b.address, a.res, b.res]) - else: - appf(p.body, "$1 = $2;$n", [a.res, b.res]) + var a, b: TCompRes = default(TCompRes) + var xtyp = mapType(p, x.typ) -proc genAsgn(p: PProc, n: PNode) = - genLineDir(p, n) - genAsgnAux(p, n.sons[0], n.sons[1], noCopyNeeded=false) + # 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") -proc genFastAsgn(p: PProc, n: PNode) = - genLineDir(p, n) - genAsgnAux(p, n.sons[0], n.sons[1], noCopyNeeded=true) + gen(p, x, a) + genLineDir(p, y) + gen(p, y, b) -proc genSwap(p: PProc, n: PNode) = - var a, b: TCompRes - gen(p, n.sons[1], a) - gen(p, n.sons[2], b) - inc(p.unique) - let tmp = ropef("Tmp$1", [toRope(p.unique)]) - case mapType(skipTypes(n.sons[1].typ, abstractVar)) - of etyBaseIndex: - inc(p.unique) - let tmp2 = ropef("Tmp$1", [toRope(p.unique)]) - if a.typ != etyBaseIndex or b.typ != etyBaseIndex: - internalError(n.info, "genSwap") - appf(p.body, "var $1 = $2; $2 = $3; $3 = $1;$n", [tmp, a.address, b.address]) - appf(p.body, "var $1 = $2; $2 = $3; $3 = $1", [tmp2, a.res, b.res]) + # 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, tyString}: + xtyp = etySeq + case xtyp + of etySeq: + if x.typ.kind in {tyVar, tyLent} or (needsNoCopy(p, y) and needsNoCopy(p, x)) or noCopyNeeded: + lineF(p, "$1 = $2;$n", [a.rdLoc, b.rdLoc]) + else: + useMagic(p, "nimCopy") + lineF(p, "$1 = nimCopy(null, $2, $3);$n", + [a.rdLoc, b.res, genTypeInfo(p, y.typ)]) + of etyObject: + if x.typ.kind in {tyVar, 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") + # 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.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", 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: - appf(p.body, "var $1 = $2; $2 = $3; $3 = $1", [tmp, a.res, b.res]) - -proc getFieldPosition(f: PNode): int = + lineF(p, "$1 = $2;$n", [a.rdLoc, b.rdLoc]) + +proc genAsgn(p: PProc, n: PNode) = + genAsgnAux(p, n[0], n[1], noCopyNeeded=false) + +proc genFastAsgn(p: PProc, n: PNode) = + # 'shallowCopy' always produced 'noCopyNeeded = true' here but this is wrong + # for code like + # while j >= pos: + # dest[i].shallowCopy(dest[j]) + # 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, tyString} + genAsgnAux(p, n[0], n[1], noCopyNeeded=noCopy) + +proc genSwap(p: PProc, n: PNode) = + 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(f.info, "genFieldPosition") + else: + result = 0 + internalError(p.config, f.info, "genFieldPosition") -proc genFieldAddr(p: PProc, n: PNode, r: var TCompRes) = - var a: TCompRes +proc genFieldAddr(p: PProc, n: PNode, r: var 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(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(b.sons[1].info, "genFieldAddr") - var f = b.sons[1].sym - if f.loc.r == nil: f.loc.r = mangleName(f) - r.res = makeJSString(ropeToStr(f.loc.r)) - InternalAssert a.typ != etyBaseIndex + 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) - if skipTypes(n.sons[0].typ, abstractVarRange).kind == tyTuple: - r.res = ropef("$1.Field$2", [r.res, getFieldPosition(n.sons[1]).toRope]) +proc genFieldAccess(p: PProc, n: PNode, r: var TCompRes) = + 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[1]).rope] + mkTemp(0) else: - if n.sons[1].kind != nkSym: InternalError(n.sons[1].info, "genFieldAddr") - var f = n.sons[1].sym - if f.loc.r == nil: f.loc.r = mangleName(f) - r.res = ropef("$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 genCheckedFieldAddr(p: PProc, n: PNode, r: var TCompRes) = - genFieldAddr(p, n.sons[0], r) # XXX - -proc genCheckedFieldAccess(p: PProc, n: PNode, r: var TCompRes) = - genFieldAccess(p, n.sons[0], r) # XXX - -proc genArrayAddr(p: PProc, n: PNode, r: var TCompRes) = - var - a, b: TCompRes - first: biggestInt +proc genAddr(p: PProc, n: PNode, r: var TCompRes) + +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 = default(TCompRes) + first: Int128 = Zero r.typ = etyBaseIndex - gen(p, n.sons[0], a) - gen(p, n.sons[1], b) - InternalAssert a.typ != etyBaseIndex and b.typ != etyBaseIndex - r.address = a.res - var typ = skipTypes(n.sons[0].typ, abstractPtrs) - if typ.kind in {tyArray, tyArrayConstr}: first = FirstOrd(typ.sons[0]) - else: first = 0 - if optBoundsCheck in p.options and not isConstExpr(n.sons[1]): + 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 = ropef("chckIndx($1, $2, $3.length)-$2", - [b.res, toRope(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 = ropef("($1)-$2", [b.res, toRope(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}: ty = skipTypes(ty.sons[0], abstractVarRange) +proc genArrayAccess(p: PProc, n: PNode, r: var TCompRes) = + 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, tyArrayConstr, tyOpenArray, tySequence, tyString, tyCString, - tyVarargs: + of tyArray, tyOpenArray, tySequence, tyString, tyCstring, tyVarargs: genArrayAddr(p, n, r) - of tyTuple: + of tyTuple: genFieldAddr(p, n, r) - else: InternalError(n.info, "expr(nkBracketExpr, " & $ty.kind & ')') - r.typ = etyNone - if r.res == nil: InternalError(n.info, "genArrayAccess") - r.res = ropef("$1[$2]", [r.address, r.res]) - r.address = nil + else: internalError(p.config, n.info, "expr(nkBracketExpr, " & $ty.kind & ')') + 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.kind = resExpr +template isIndirect(x: PSym): bool = + let v = x + ({sfAddrTaken, sfGlobal} * v.flags != {} and + #(mapType(v.typ) != etyObject) 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(n.info, "genAddr: 3") - case s.kind - of skVar, skLet, skResult: - r.kind = resExpr - if mapType(n.typ) == etyObject: - # make addr() a no-op: - r.typ = etyNone - r.res = s.loc.r - r.address = nil - elif sfGlobal in s.flags: - # globals are always indirect accessible - r.typ = etyBaseIndex - r.address = toRope("Globals") - r.res = makeJSString(ropeToStr(s.loc.r)) - elif sfAddrTaken in s.flags: - r.typ = etyBaseIndex - r.address = s.loc.r - r.res = toRope("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: - InternalError(n.info, "genAddr: 4") - else: InternalError(n.info, "genAddr: 2") - of nkCheckedFieldExpr: - genCheckedFieldAddr(p, n, r) - of nkDotExpr: - genFieldAddr(p, n, r) - of nkBracketExpr: - var ty = skipTypes(n.sons[0].typ, abstractVarRange) - if ty.kind in {tyRef, tyPtr}: ty = skipTypes(ty.sons[0], abstractVarRange) - case ty.kind - of tyArray, tyArrayConstr, tyOpenArray, tySequence, tyString, tyCString, - tyVarargs: - genArrayAddr(p, n, r) - of tyTuple: - genFieldAddr(p, n, r) - else: InternalError(n.info, "expr(nkBracketExpr, " & $ty.kind & ')') - else: InternalError(n.info, "genAddr") - -proc genSym(p: PProc, n: PNode, r: var TCompRes) = + genFieldAccess(p, n[0], r) + of nkBracketExpr: + var ty = skipTypes(n[0].typ, abstractVarRange) + if ty.kind in MappedToObject: + gen(p, n[0], r) + else: + let kindOfIndexedExpr = skipTypes(n[0][0].typ, abstractVarRange+tyUserTypeClasses).kind + case kindOfIndexedExpr + of tyArray, tyOpenArray, tySequence, tyString, tyCstring, tyVarargs: + genArrayAddr(p, n[0], r) + of tyTuple: + genFieldAddr(p, n[0], r) + of tyGenericBody: + genAddr(p, n[^1], r) + else: internalError(p.config, n[0].info, "expr(nkBracketExpr, " & $kindOfIndexedExpr & ')') + of nkObjDownConv: + gen(p, n[0], r) + of nkHiddenDeref: + gen(p, n[0], r) + of nkDerefExpr: + var x = n[0] + if n.kind == nkHiddenAddr: + x = n[0][0] + if n.typ.skipTypes(abstractVar).kind != tyOpenArray: + x.typ = n.typ + gen(p, x, r) + of nkHiddenAddr: + gen(p, n[0], r) + of nkConv: + genAddr(p, n[0], r) + of nkStmtListExpr: + if n.len == 1: gen(p, n[0], r) + else: internalError(p.config, n[0].info, "genAddr for complex nkStmtListExpr") + of nkCallKinds: + if n[0].typ.kind == tyOpenArray: + # 'var openArray' for instance produces an 'addr' but this is harmless: + # namely toOpenArray(a, 1, 3) + gen(p, n[0], r) + else: + internalError(p.config, n[0].info, "genAddr: " & $n[0].kind) + else: + internalError(p.config, n[0].info, "genAddr: " & $n[0].kind) + +proc attachProc(p: PProc; content: Rope; s: PSym) = + p.g.code.add(content) + +proc attachProc(p: PProc; s: PSym) = + let newp = genProc(p, s) + attachProc(p, newp, s) + +proc genProcForSymIfNeeded(p: PProc, s: PSym) = + if not p.g.generatedSyms.containsOrIncl(s.id): + 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: - if s.loc.r == nil: - InternalError(n.info, "symbol has no generated name: " & s.name.s) - var k = mapType(s.typ) + of skVar, skLet, skParam, skTemp, skResult, skForVar: + 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 = ropef("$1[0]", [s.loc.r]) - r.res = ropef("$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 = con(s.loc.r, "_Idx") - elif k != etyObject and sfAddrTaken in s.flags: - r.res = ropef("$1[0]", [s.loc.r]) + r.address = s.loc.snippet + r.res = s.loc.snippet & "_Idx" + elif isIndirect(s): + 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: - InternalError(n.info, "symbol has no generated name: " & s.name.s) - r.res = s.loc.r - of skProc, skConverter, skMethod: - discard mangleName(s) - r.res = s.loc.r - if lfNoDecl in s.loc.flags or s.magic != mNone or isGenericRoutine(s) or + if s.loc.snippet == "": + internalError(p.config, n.info, "symbol has no generated name: " & s.name.s) + 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.snippet + if lfNoDecl in s.loc.flags or s.magic notin generatedMagics or {sfImportc, sfInfixCall} * s.flags != {}: - nil - elif s.kind == skMethod and s.getBody.kind == nkEmpty: + discard + elif s.kind == skMethod and getBody(p.module.graph, s).kind == nkEmpty: # we cannot produce code for the dispatcher yet: - nil + discard elif sfForward in s.flags: p.g.forwarded.add(s) - elif 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: app(owner.locals, newp) - else: app(p.g.code, newp) + else: + genProcForSymIfNeeded(p, s) else: - if s.loc.r == nil: - InternalError(n.info, "symbol has no generated name: " & s.name.s) - r.res = s.loc.r + if s.loc.snippet == "": + internalError(p.config, n.info, "symbol has no generated name: " & s.name.s) + 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) = - if mapType(n.sons[0].typ) == etyObject: - gen(p, n.sons[0], r) + +proc genDeref(p: PProc, n: PNode, r: var TCompRes) = + let it = n[0] + let t = mapType(p, it.typ) + if t == etyObject or it.typ.kind == tyLent: + gen(p, it, r) else: - var a: TCompRes - gen(p, n.sons[0], a) - if a.typ != etyBaseIndex: InternalError(n.info, "genDeref") - r.res = ropef("$1[$2]", [a.address, a.res]) + var a: TCompRes = default(TCompRes) + gen(p, it, a) + r.kind = a.kind + r.typ = mapType(p, n.typ) + if r.typ == etyBaseIndex: + let tmp = p.getTemp + 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 genArg(p: PProc, n: PNode, r: var TCompRes) = - var a: TCompRes +proc genArgNoParam(p: PProc, n: PNode, r: var TCompRes) = + var a: TCompRes = default(TCompRes) gen(p, n, a) if a.typ == etyBaseIndex: - app(r.res, a.address) - app(r.res, ", ") - app(r.res, a.res) + r.res.add(a.address) + r.res.add(", ") + r.res.add(a.res) + else: + r.res.add(a.res) + +proc genArg(p: PProc, n: PNode, param: PSym, r: var TCompRes; emitted: ptr int = nil) = + var a: TCompRes = default(TCompRes) + gen(p, n, a) + if skipTypes(param.typ, abstractVar).kind in {tyOpenArray, tyVarargs} and + a.typ == etyBaseIndex: + r.res.add("$1[$2]" % [a.address, a.res]) + elif a.typ == etyBaseIndex: + r.res.add(a.address) + r.res.add(", ") + r.res.add(a.res) + if emitted != nil: inc emitted[] + 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) + r.res.add("($1 = $2, $1[0]), $1[1]" % [tmp, a.rdLoc]) + if emitted != nil: inc emitted[] else: - app(r.res, a.res) - -proc genArgs(p: PProc, n: PNode, r: var TCompRes) = - app(r.res, "(") - for i in countup(1, sonsLen(n) - 1): - let it = n.sons[i] - if it.typ.isCompileTimeOnly: continue - if i > 1: app(r.res, ", ") - genArg(p, it, r) - app(r.res, ")") + r.res.add(a.res) + +proc genArgs(p: PProc, n: PNode, r: var TCompRes; start=1) = + r.res.add("(") + var hasArgs = false + + var typ = skipTypes(n[0].typ, abstractInst) + assert(typ.kind == tyProc) + assert(typ.len == typ.n.len) + var emitted = start-1 + + for i in start..<n.len: + let it = n[i] + var paramType: PNode = nil + if i < typ.len: + assert(typ.n[i].kind == nkSym) + paramType = typ.n[i] + if paramType.typ.isCompileTimeOnly: continue + + 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 + r.res.add(")") + when false: + # XXX look into this: + let jsp = countJsParams(typ) + if emitted != jsp and tfVarargs notin typ.flags: + localError(p.config, n.info, "wrong number of parameters emitted; expected: " & $jsp & + " but got: " & $emitted) r.kind = resExpr -proc genCall(p: PProc, n: PNode, r: var TCompRes) = - gen(p, n.sons[0], r) - genArgs(p, n, r) +proc genOtherArg(p: PProc; n: PNode; i: int; typ: PType; + generated: var int; r: var TCompRes) = + if i >= n.len: + globalError(p.config, n.info, "wrong importcpp pattern; expected parameter at position " & $i & + " but got only: " & $(n.len-1)) + let it = n[i] + var paramType: PNode = nil + 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) + else: + genArg(p, it, paramType.sym, r) + inc generated -proc genInfixCall(p: PProc, n: PNode, r: var TCompRes) = - gen(p, n.sons[1], r) - if r.typ == etyBaseIndex: - if r.address == nil: - GlobalError(n.info, "cannot invoke with infix syntax") - r.res = ropef("$1[$2]", [r.address, r.res]) - r.address = nil - r.typ = etyNone - app(r.res, ".") - var op: TCompRes - gen(p, n.sons[0], op) - app(r.res, op.res) - - app(r.res, "(") - for i in countup(2, sonsLen(n) - 1): - if i > 2: app(r.res, ", ") - genArg(p, n.sons[i], r) - app(r.res, ")") +proc genPatternCall(p: PProc; n: PNode; pat: string; typ: PType; + r: var TCompRes) = + var i = 0 + var j = 1 r.kind = resExpr + while i < pat.len: + case pat[i] + of '@': + var generated = 0 + for k in j..<n.len: + if generated > 0: r.res.add(", ") + genOtherArg(p, n, k, typ, generated, r) + inc i + of '#': + var generated = 0 + genOtherArg(p, n, j, typ, generated, r) + inc j + inc i + of '\31': + # unit separator + r.res.add("#") + inc i + of '\29': + # group separator + r.res.add("@") + inc i + else: + let start = i + while i < pat.len: + if pat[i] notin {'@', '#', '\31', '\29'}: inc(i) + else: break + if i - 1 >= start: + 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.snippet == "": f.loc.snippet = mangleName(p.module, f) + if sfInfixCall in f.flags: + let pat = $n[0].sym.loc.snippet + internalAssert p.config, pat.len > 0 + if pat.contains({'#', '(', '@'}): + 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[1], r) + if r.typ == etyBaseIndex: + if r.address == "": + globalError(p.config, n.info, "cannot invoke with infix syntax") + r.res = "$1[$2]" % [r.address, r.res] + r.address = "" + r.typ = etyNone + 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) = + 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") - app(r.res, "rawEcho") - genArgs(p, n, r) + r.res.add("rawEcho(") + for i in 0..<n.len: + let it = n[i] + if it.typ.isCompileTimeOnly: continue + if i > 0: r.res.add(", ") + genArgNoParam(p, it, r) + r.res.add(")") + r.kind = resExpr + +proc putToSeq(s: string, indirect: bool): Rope = + result = rope(s) + if indirect: result = "[$1]" % [result] -proc putToSeq(s: string, indirect: bool): PRope = - result = toRope(s) - if indirect: result = ropef("[$1]", [result]) - -proc createVar(p: PProc, typ: PType, indirect: bool): PRope -proc createRecordVarAux(p: PProc, rec: PNode, c: var int): PRope = - result = nil +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): - app(result, createRecordVarAux(p, rec.sons[i], c)) - of nkRecCase: - app(result, createRecordVarAux(p, rec.sons[0], c)) - for i in countup(1, sonsLen(rec) - 1): - app(result, createRecordVarAux(p, lastSon(rec.sons[i]), c)) - of nkSym: - if c > 0: app(result, ", ") - app(result, mangleName(rec.sym)) - app(result, ": ") - app(result, createVar(p, rec.sym.typ, false)) - inc(c) - else: InternalError(rec.info, "createRecordVarAux") - -proc createVar(p: PProc, typ: PType, indirect: bool): PRope = + of nkRecList: + for i in 0..<rec.len: + createRecordVarAux(p, rec[i], excludedFieldIDs, output) + of nkRecCase: + 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)]) + output.add(createVar(p, rec.sym.typ, false)) + else: internalError(p.config, rec.info, "createRecordVarAux") + +proc createObjInitList(p: PProc, typ: PType, excludedFieldIDs: IntSet, output: var Rope) = + var t = typ + if objHasTypeField(t): + if output.len > 0: output.add(", ") + output.addf("m_type: $1", [genTypeInfo(p, t)]) + while t != nil: + t = t.skipTypes(skipPtrs) + createRecordVarAux(p, t.n, excludedFieldIDs, output) + t = t.baseClass + +proc arrayTypeForElemType(conf: ConfigRef; typ: PType): string = + let typ = typ.skipTypes(abstractRange) + case typ.kind + of tyInt, tyInt32: "Int32Array" + of tyInt16: "Int16Array" + of tyInt8: "Int8Array" + of tyInt64: + if optJsBigInt64 in conf.globalOptions: + "BigInt64Array" + else: + "" + of tyUInt, tyUInt32: "Uint32Array" + of tyUInt16: "Uint16Array" + of tyUInt8, tyChar, tyBool: "Uint8Array" + of tyUInt64: + if optJsBigInt64 in conf.globalOptions: + "BigUint64Array" + else: + "" + of tyFloat32: "Float32Array" + of tyFloat64, tyFloat: "Float64Array" + of tyEnum: + case typ.size + of 1: "Uint8Array" + of 2: "Uint16Array" + of 4: "Uint32Array" + else: "" + else: "" + +proc createVar(p: PProc, typ: PType, indirect: bool): Rope = var t = skipTypes(typ, abstractInst) case t.kind - of tyInt..tyInt64, tyEnum, tyChar: + of tyInt8..tyInt32, tyUInt8..tyUInt32, tyEnum, tyChar: result = putToSeq("0", indirect) - of tyFloat..tyFloat128: + 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: - result = createVar(p, lastSon(typ), indirect) - of tySet: - result = toRope("{}") - of tyBool: + 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 tyArray, tyArrayConstr: - var length = int(lengthOrd(t)) - var e = elemType(t) - if length > 32: - useMagic(p, "ArrayConstr") - result = ropef("ArrayConstr($1, $2, $3)", [toRope(length), - createVar(p, e, false), genTypeInfo(p, e)]) - else: - result = toRope("[") + of tyNil: + result = putToSeq("null", indirect) + of tyArray: + let length = toInt(lengthOrd(p.config, t)) + let e = elemType(t) + let jsTyp = arrayTypeForElemType(p.config, e) + if jsTyp.len > 0: + result = "new $1($2)" % [rope(jsTyp), rope(length)] + elif length > 32: + useMagic(p, "arrayConstr") + # XXX: arrayConstr depends on nimCopy. This line shouldn't be necessary. + useMagic(p, "nimCopy") + result = "arrayConstr($1, $2, $3)" % [rope(length), + createVar(p, e, false), genTypeInfo(p, e)] + else: + result = rope("[") var i = 0 - while i < length: - if i > 0: app(result, ", ") - app(result, createVar(p, e, false)) + while i < length: + if i > 0: result.add(", ") + result.add(createVar(p, e, false)) inc(i) - app(result, "]") - of tyTuple: - result = toRope("{") - for i in 0.. <t.sonslen: - if i > 0: app(result, ", ") - appf(result, "Field$1: $2" | "Field$# = $#", i.toRope, - createVar(p, t.sons[i], false)) - app(result, "}") - of tyObject: - result = toRope("{") - var c = 0 - if tfFinal notin t.flags or t.sons[0] != nil: - inc(c) - appf(result, "m_type: $1" | "m_type = $#", [genTypeInfo(p, t)]) - while t != nil: - app(result, createRecordVarAux(p, t.n, c)) - t = t.sons[0] - app(result, "}") - of tyVar, tyPtr, tyRef: - if mapType(t) == etyBaseIndex: - result = putToSeq("[null, 0]" | "{nil, 0}", indirect) - else: - result = putToSeq("null" | "nil", indirect) - of tySequence, tyString, tyCString, tyPointer, tyProc: - result = putToSeq("null" | "nil", indirect) + result.add("]") + if indirect: result = "[$1]" % [result] + of tyTuple: + result = rope("{") + 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 = "" + createObjInitList(p, t, initIntSet(), initList) + result = ("({$1})") % [initList] + if indirect: result = "[$1]" % [result] + of tyVar, tyPtr, tyRef, tyPointer: + if mapType(p, t) == etyBaseIndex: + result = putToSeq("[null, 0]", indirect) + else: + result = putToSeq("null", indirect) + of tySequence, tyString: + result = putToSeq("[]", indirect) + of tyCstring, tyProc, tyOpenArray: + result = putToSeq("null", indirect) + of tyStatic: + if t.n != nil: + result = createVar(p, skipModifier t, indirect) + else: + internalError(p.config, "createVar: " & $t.kind) + result = "" else: - internalError("createVar: " & $t.kind) - result = nil + internalError(p.config, "createVar: " & $t.kind) + result = "" -proc isIndirect(v: PSym): bool = - result = (sfAddrTaken in v.flags) and (mapType(v.typ) != etyObject) and - v.kind notin {skProc, skConverter, skMethod, skIterator} +template returnType: untyped = "" -proc genVarInit(p: PProc, v: PSym, n: PNode) = - var - a: TCompRes - s: PRope - if n.kind == nkEmpty: - appf(p.body, "var $1 = $2;$n" | "local $1 = $2;$n", - [mangleName(v), createVar(p, v.typ, isIndirect(v))]) - else: - discard mangleName(v) +proc genVarInit(p: PProc, v: PSym, n: PNode) = + var + a: TCompRes = default(TCompRes) + s: Rope + varCode: string + varName = mangleName(p.module, v) + 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: + 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(v.typ) - of etyObject: - if needsNoCopy(n): + case mapType(p, v.typ) + of etyObject, etySeq: + if v.typ.kind in {tyOpenArray, tyVarargs} or needsNoCopy(p, n): s = a.res - else: - useMagic(p, "NimCopy") - s = ropef("NimCopy($1, $2)", [a.res, genTypeInfo(p, n.typ)]) - of etyBaseIndex: - if (a.typ != etyBaseIndex): InternalError(n.info, "genVarInit") - if {sfAddrTaken, sfGlobal} * v.flags != {}: - appf(p.body, "var $1 = [$2, $3];$n" | "local $1 = {$2, $3};$n", - [v.loc.r, a.address, a.res]) else: - appf(p.body, "var $1 = $2; var $1_Idx = $3;$n" | - "local $1 = $2; local $1_Idx = $3;$n", [ - v.loc.r, a.address, a.res]) + useMagic(p, "nimCopy") + s = "nimCopy(null, $1, $2)" % [a.res, genTypeInfo(p, n.typ)] + of etyBaseIndex: + let targetBaseIndex = {sfAddrTaken, sfGlobal} * v.flags == {} + if a.typ == etyBaseIndex: + if targetBaseIndex: + line(p, runtimeFormat(varCode & " = $3, $2_Idx = $4;$n", + [returnType, v.loc.snippet, a.address, a.res])) + else: + 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.snippet]) + else: + line(p, runtimeFormat(varCode & " = $3;$n", [returnType, v.loc.snippet, a.res])) return else: s = a.res - if isIndirect(v): - appf(p.body, "var $1 = [$2];$n" | "local $1 = {$2};$n", [v.loc.r, s]) - else: - appf(p.body, "var $1 = $2;$n" | "local $1 = $2;$n", [v.loc.r, s]) - -proc genVarStmt(p: PProc, n: PNode) = - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - assert(a.kind == nkIdentDefs) - assert(a.sons[0].kind == nkSym) - var v = a.sons[0].sym - if lfNoDecl in v.loc.flags: continue - genLineDir(p, a) - genVarInit(p, v, a.sons[2]) + if isIndirect(v): + line(p, runtimeFormat(varCode & " = [$3];$n", [returnType, v.loc.snippet, s])) + else: + line(p, runtimeFormat(varCode & " = $3;$n", [returnType, v.loc.snippet, s])) + + if useReloadingGuard or useGlobalPragmas: + dec p.extraIndent + lineF(p, "}$n") + +proc genClosureVar(p: PProc, n: PNode) = + # assert n[2].kind != nkEmpty + # TODO: fixme transform `var env.x` into `var env.x = default()` after + # the order of transf and lambdalifting is fixed + if n[2].kind != nkEmpty: + genAsgnAux(p, n[0], n[2], false) + else: + var a: TCompRes = default(TCompRes) + gen(p, n[0], a) + line(p, runtimeFormat("$1 = $2;$n", [rdLoc(a), createVar(p, n[0].typ, false)])) + +proc genVarStmt(p: PProc, n: PNode) = + for i in 0..<n.len: + var a = n[i] + if a.kind != nkCommentStmt: + if a.kind == nkVarTuple: + let unpacked = lowerTupleUnpacking(p.module.graph, a, p.module.idgen, p.prc) + genStmt(p, unpacked) + else: + assert(a.kind == nkIdentDefs) + 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) - app(p.g.code, 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] - appf(p.body, "$1 = $2;$n", [a.res, createVar(p, t, true)]) + 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] - appf(p.body, "$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..tyInt64, tyChar: gen(p, n.sons[1], r) - of tyBool: unaryExpr(p, n, r, "", "($1 ? 1:0)" | "toBool($#)") - else: InternalError(n.info, "genOrd") - + 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: - r.res.app(ropef("[$1].concat(", [a.res])) + if skipTypes(n[1].typ, abstractVarRange).kind == tyChar: + r.res.add("[$1].concat(" % [a.res]) else: - r.res.app(ropef("($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: - r.res.app(ropef("[$1],", [a.res])) + for i in 2..<n.len - 1: + gen(p, n[i], a) + if skipTypes(n[i].typ, abstractVarRange).kind == tyChar: + r.res.add("[$1]," % [a.res]) else: - r.res.app(ropef("$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.app(ropef("[$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.app(ropef("$1)", [a.res])) + r.res.add("$1)" % [a.res]) + +proc genReprAux(p: PProc, n: PNode, r: var TCompRes, magic: string, typ: Rope = "") = + useMagic(p, magic) + r.res.add(magic & "(") + var a: TCompRes = default(TCompRes) + + gen(p, n[1], a) + if magic == "reprAny": + # the pointer argument in reprAny is expandend to + # (pointedto, pointer), so we need to fill it + if a.address.len == 0: + r.res.add(a.res) + r.res.add(", null") + else: + r.res.add("$1, $2" % [a.address, a.res]) + else: + r.res.add(a.res) + + if typ != "": + r.res.add(", ") + r.res.add(typ) + r.res.add(")") proc genRepr(p: PProc, n: PNode, r: var TCompRes) = - var t = skipTypes(n.sons[1].typ, abstractVarRange) + let t = skipTypes(n[1].typ, abstractVarRange) case t.kind - of tyInt..tyUInt64: - unaryExpr(p, n, r, "", "(\"\"+ ($1))") + of tyInt..tyInt64, tyUInt..tyUInt64: + genReprAux(p, n, r, "reprInt") + of tyChar: + genReprAux(p, n, r, "reprChar") + of tyBool: + genReprAux(p, n, r, "reprBool") + of tyFloat..tyFloat128: + genReprAux(p, n, r, "reprFloat") + of tyString: + genReprAux(p, n, r, "reprStr") of tyEnum, tyOrdinal: - gen(p, n.sons[1], r) - useMagic(p, "cstrToNimstr") - r.kind = resExpr - r.res = ropef("cstrToNimstr($1.node.sons[$2].name)", - [genTypeInfo(p, t), r.res]) + genReprAux(p, n, r, "reprEnum", genTypeInfo(p, t)) + of tySet: + genReprAux(p, n, r, "reprSet", genTypeInfo(p, t)) + of tyEmpty, tyVoid: + localError(p.config, n.info, "'repr' doesn't support 'void' type") + of tyPointer: + genReprAux(p, n, r, "reprPointer") + of tyOpenArray, tyVarargs: + genReprAux(p, n, r, "reprJSONStringify") else: - # XXX: - internalError(n.info, "genRepr: Not implemented") + 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, 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 = ropef("($1.m_type == $2)", [x.res, genTypeInfo(p, t)]) + r.res = "($1.m_type == $2)" % [x.res, genTypeInfo(p, t)] else: useMagic(p, "isObj") - r.res = ropef("isObj($1.m_type, $2)", [x.res, genTypeInfo(p, t)]) + 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) - appf(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 + var a: TCompRes - line, filen: PRope - var op = n.sons[0].sym.magic + line, filen: Rope + 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 mAddi..mStrToStr: arith(p, n, r, op) + 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 mPred: - # XXX: range checking? - if not (optOverflowCheck in p.Options): binaryExpr(p, n, r, "", "$1 - $2") - else: binaryExpr(p, n, r, "subInt", "subInt($1, $2)") - of mSucc: - # XXX: range checking? - if not (optOverflowCheck in p.Options): binaryExpr(p, n, r, "", "$1 - $2") - else: binaryExpr(p, n, r, "addInt", "addInt($1, $2)") - of mAppendStrCh: binaryExpr(p, n, r, "addChar", "addChar($1, $2)") + of mAppendStrCh: + binaryExpr(p, n, r, "addChar", + "addChar($1, $2);") of mAppendStrStr: - if skipTypes(n.sons[1].typ, abstractVarRange).kind == tyCString: - binaryExpr(p, n, r, "", "$1 += $2") - else: - binaryExpr(p, n, r, "", "$1 = ($1.slice(0,-1)).concat($2)") - # XXX: make a copy of $2, because of Javascript's sucking semantics - of mAppendSeqElem: binaryExpr(p, n, r, "", "$1.push($2)") - of mConStrStr: genConStrStr(p, n, r) - of mEqStr: binaryExpr(p, n, r, "eqStrings", "eqStrings($1, $2)") - of mLeStr: 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") + 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: + 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 = 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 = "$1.push($2);" % [x.rdLoc, c] + r.kind = resExpr + of mConStrStr: + genConStrStr(p, n, r) + of mEqStr: + binaryExpr(p, n, r, "eqStrings", "eqStrings($1, $2)") + of mLeStr: + binaryExpr(p, n, r, "cmpStrings", "(cmpStrings($1, $2) <= 0)") + of mLtStr: + binaryExpr(p, n, r, "cmpStrings", "(cmpStrings($1, $2) < 0)") + 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 = toRope(getSize(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: unaryExpr(p, n, r, "", "($1.length-1)") - of mLengthSeq, mLengthOpenArray, mLengthArray: - 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[0].typ, abstractVar).kind == tyString: - unaryExpr(p, n, r, "", "($1.length-2)") + 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.length-1)") + r.res = "($1).length - 1" % [x.rdLoc] + r.kind = resExpr of mInc: - if not (optOverflowCheck in p.Options): binaryExpr(p, n, r, "", "$1 += $2") - else: binaryExpr(p, n, r, "addInt", "$1 = addInt($1, $2)") + let typ = n[1].typ.skipTypes(abstractVarRange) + case typ.kind + of tyUInt..tyUInt32: + binaryUintExpr(p, n, r, "+", true) + of tyUInt64: + if optJsBigInt64 in p.config.globalOptions: + binaryExpr(p, n, r, "", "$1 = BigInt.asUintN(64, $3 + BigInt($2))", true) + else: binaryUintExpr(p, n, r, "+", true) + elif typ.kind == tyInt64 and optJsBigInt64 in p.config.globalOptions: + if optOverflowCheck notin p.options: + binaryExpr(p, n, r, "", "$1 = BigInt.asIntN(64, $3 + BigInt($2))", true) + else: binaryExpr(p, n, r, "addInt64", "$1 = addInt64($3, BigInt($2))", true) + else: + if optOverflowCheck notin p.options: binaryExpr(p, n, r, "", "$1 += $2") + else: binaryExpr(p, n, r, "addInt", "$1 = addInt($3, $2)", true) of ast.mDec: - if not (optOverflowCheck in p.Options): binaryExpr(p, n, r, "", "$1 -= $2") - else: binaryExpr(p, n, r, "subInt", "$1 = subInt($1, $2)") - of mSetLengthStr: binaryExpr(p, n, r, "", "$1.length = ($2)-1") - of mSetLengthSeq: binaryExpr(p, n, r, "", "$1.length = $2") + let typ = n[1].typ.skipTypes(abstractVarRange) + case typ.kind + of tyUInt..tyUInt32: + binaryUintExpr(p, n, r, "-", true) + of tyUInt64: + if optJsBigInt64 in p.config.globalOptions: + binaryExpr(p, n, r, "", "$1 = BigInt.asUintN(64, $3 - BigInt($2))", true) + else: binaryUintExpr(p, n, r, "-", true) + elif typ.kind == tyInt64 and optJsBigInt64 in p.config.globalOptions: + if optOverflowCheck notin p.options: + binaryExpr(p, n, r, "", "$1 = BigInt.asIntN(64, $3 - BigInt($2))", true) + else: binaryExpr(p, n, r, "subInt64", "$1 = subInt64($3, BigInt($2))", true) + else: + if optOverflowCheck notin p.options: binaryExpr(p, n, r, "", "$1 -= $2") + else: binaryExpr(p, n, r, "subInt", "$1 = subInt($3, $2)", true) + of mSetLengthStr: + binaryExpr(p, n, r, "mnewString", + """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 = 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)") of mLeSet: binaryExpr(p, n, r, "SetLe", "SetLe($1, $2)") @@ -1342,355 +2460,753 @@ proc genMagic(p: PProc, n: PNode, r: var TCompRes) = of mMinusSet: binaryExpr(p, n, r, "SetMinus", "SetMinus($1, $2)") of mIncl: binaryExpr(p, n, r, "", "$1[$2] = true") of mExcl: binaryExpr(p, n, r, "", "delete $1[$2]") - of mInSet: binaryExpr(p, n, r, "", "($1[$2] != undefined)") - of mNLen..mNError: - localError(n.info, errCannotGenerateCodeForX, n.sons[0].sym.name.s) + of mInSet: + binaryExpr(p, n, r, "", "($1[$2] != undefined)") 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 mSlurp, mStaticExec: - localError(n.info, errXMustBeCompileTime, n.sons[0].sym.name.s) + of mNLen..mNError, mSlurp, mStaticExec: + 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[0].sym) + genCall(p, n, r) + of mParseBiggestFloat: + useMagic(p, "nimParseBiggestFloat") + 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(e.info, 'genMagic: ' + magicToStr[op]); - -proc genSetConstr(p: PProc, n: PNode, r: var TCompRes) = + #else internalError(p.config, e.info, 'genMagic: ' + magicToStr[op]); + +proc genSetConstr(p: PProc, n: PNode, r: var TCompRes) = var - a, b: TCompRes - useMagic(p, "SetConstr") - r.res = toRope("SetConstr(") + 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: app(r.res, ", ") - var it = n.sons[i] - if it.kind == nkRange: - gen(p, it.sons[0], a) - gen(p, it.sons[1], b) - appf(r.res, "[$1, $2]", [a.res, b.res]) - else: + for i in 0..<n.len: + if i > 0: r.res.add(", ") + var it = n[i] + if it.kind == nkRange: + 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) - app(r.res, a.res) - app(r.res, ")") - -proc genArrayConstr(p: PProc, n: PNode, r: var TCompRes) = - var a: TCompRes - r.res = toRope("[") - r.kind = resExpr - for i in countup(0, sonsLen(n) - 1): - if i > 0: app(r.res, ", ") - gen(p, n.sons[i], a) - app(r.res, a.res) - app(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) + p.g.constants.addf("var $1 = $2;$n", [tmp, r.res]) + r.res = tmp + +proc genArrayConstr(p: PProc, n: PNode, r: var TCompRes) = + ## 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 - r.res = toRope("{") + var a: TCompRes = default(TCompRes) + r.res = rope("{") r.kind = resExpr - for i in countup(0, sonsLen(n) - 1): - if i > 0: app(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) - appf(r.res, "Field$#: $#" | "Field$# = $#", [i.toRope, a.res]) - r.res.app("}") + 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) = - # XXX inheritance? - var a: TCompRes - r.res = toRope("{") + var a: TCompRes = default(TCompRes) r.kind = resExpr - for i in countup(0, sonsLen(n) - 1): - if i > 0: app(r.res, ", ") - var it = n.sons[i] - InternalAssert it.kind == nkExprColonExpr - gen(p, it.sons[1], a) - var f = it.sons[0].sym - if f.loc.r == nil: f.loc.r = mangleName(f) - appf(r.res, "$#: $#" | "$# = $#" , [f.loc.r, a.res]) - r.res.app("}") - -proc genConv(p: PProc, n: PNode, r: var TCompRes) = + var initList : Rope = "" + var fieldIDs = initIntSet() + let nTyp = n.typ.skipTypes(abstractInst) + for i in 1..<n.len: + if i > 1: initList.add(", ") + var it = n[i] + internalAssert p.config, it.kind == nkExprColonExpr + let val = it[1] + gen(p, val, a) + 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 a.typ == etyBaseIndex: + initList.addf("$#: [$#, $#]", [f.loc.snippet, a.address, a.res]) + else: + if not needsNoCopy(p, val): + useMagic(p, "nimCopy") + a.res = "nimCopy(null, $1, $2)" % [a.rdLoc, genTypeInfo(p, typ)] + initList.addf("$#: $#", [f.loc.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) - if (dest.kind != src.kind) and (src.kind == tyBool): - r.res = ropef("(($1)? 1:0)" | "toBool($#)", [r.res]) + var src = skipTypes(n[1].typ, abstractVarRange) + gen(p, n[1], r) + if dest.kind == src.kind: + # no-op conversion + return + 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 - -proc upConv(p: PProc, n: PNode, r: var TCompRes) = - gen(p, n.sons[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) + 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[0], r) # XXX + +proc genRangeChck(p: PProc, n: PNode, r: var TCompRes, magic: string) = + 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 = ropef("chckRange($1, $2, $3)", [r.res, a.res, b.res]) + r.res = "chckRange($1, $2, $3)" % [r.res, a.res, b.res] r.kind = resExpr -proc convStrToCStr(p: PProc, n: PNode, r: var TCompRes) = +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(n.info, "convStrToCStr") + gen(p, n[0], r) + if r.res == "": internalError(p.config, n.info, "convStrToCStr") useMagic(p, "toJSStr") - r.res = ropef("toJSStr($1)", [r.res]) + r.res = "toJSStr($1)" % [r.res] r.kind = resExpr -proc convCStrToStr(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) - else: - gen(p, n.sons[0], r) - if r.res == nil: InternalError(n.info, "convCStrToStr") + if n[0].kind == nkStringToCString: + gen(p, n[0][0], r) + else: + gen(p, n[0], r) + if r.res == "": internalError(p.config, n.info, "convCStrToStr") useMagic(p, "cstrToNimstr") - r.res = ropef("cstrToNimstr($1)", [r.res]) + r.res = "cstrToNimstr($1)" % [r.res] r.kind = resExpr -proc genReturnStmt(p: PProc, n: PNode) = - if p.procDef == nil: InternalError(n.info, "genReturnStmt") - p.BeforeRetNeeded = true - if (n.sons[0].kind != nkEmpty): - genStmt(p, n.sons[0]) +proc genReturnStmt(p: PProc, n: PNode) = + if p.procDef == nil: internalError(p.config, n.info, "genReturnStmt") + p.beforeRetNeeded = true + if n[0].kind != nkEmpty: + genStmt(p, n[0]) else: genLineDir(p, n) - appf(p.body, "break BeforeRet;$n" | "goto ::BeforeRet::;$n") - -proc genProcBody(p: PProc, prc: PSym): PRope = - if optStackTrace in prc.options: - result = ropef(("var F={procname:$1,prev:framePtr,filename:$2,line:0};$n" | - "local F={procname=$#,prev=framePtr,filename=$#,line=0};$n") & - "framePtr = F;$n", [ - makeJSString(prc.owner.name.s & '.' & prc.name.s), - makeJSString(toFilename(prc.info))]) + lineF(p, "break BeforeRet;$n", []) + +proc frameCreate(p: PProc; procname, filename: Rope): Rope = + 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", [])) + +proc frameDestroy(p: PProc): Rope = + result = p.indentLine rope(("framePtr = F.prev;") & "\L") + +proc genProcBody(p: PProc, prc: PSym): Rope = + if hasFrameInfo(p): + result = frameCreate(p, + makeJSString(prc.owner.name.s & '.' & prc.name.s), + makeJSString(toFilenameOption(p.config, prc.info.fileIndex, foStacktrace))) else: - result = nil + result = "" if p.beforeRetNeeded: - appf(result, "BeforeRet: do {$n$1} while (false); $n" | - "$#;::BeforeRet::$n", [p.body]) + result.add p.indentLine("BeforeRet: {\n") + result.add p.body + result.add p.indentLine("};\n") + else: + 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): + result.add(frameDestroy(p)) + +proc optionalLine(p: Rope): Rope = + if p == "": + return "" else: - app(result, p.body) - if prc.typ.callConv == ccSysCall and p.target == targetJS: - result = ropef("try {$n$1} catch (e) {$n" & - " alert(\"Unhandled exception:\\n\" + e.message + \"\\n\"$n}", [result]) - if optStackTrace in prc.options: - app(result, "framePtr = framePtr.prev;" & tnl) - -proc genProc(oldProc: PProc, prc: PSym): PRope = + return p & "\L" + +proc genProc(oldProc: PProc, prc: PSym): Rope = + ## Generate a JS procedure ('function'). + result = "" var resultSym: PSym - name, returnStmt, resultAsgn, header: PRope - a: TCompRes - #if gVerbosity >= 3: + 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.target = oldProc.target p.up = oldProc - returnStmt = nil - resultAsgn = nil - name = mangleName(prc) - header = generateHeader(p, prc.typ) - if prc.typ.sons[0] != nil and sfPure notin prc.flags: - resultSym = prc.ast.sons[resultPos].sym - resultAsgn = ropef("var $# = $#;$n" | "local $# = $#;$n", [ - mangleName(resultSym), - createVar(p, resultSym.typ, isIndirect(resultSym))]) - gen(p, prc.ast.sons[resultPos], a) - returnStmt = ropef("return $#;$n", [a.res]) - genStmt(p, prc.getBody) - result = ropef("function $#($#) {$n$#$#$#$#}$n" | - "function $#($#) $n$#$#$#$#$nend$n", - [name, header, p.locals, resultAsgn, - genProcBody(p, prc), returnStmt]) + var returnStmt: Rope = "" + var resultAsgn: Rope = "" + var name = mangleName(p.module, prc) + 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) + # 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]) + 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] + + 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 = runtimeFormat(prc.constraint.strVal & " {$n$#$#$#$#$#", + [ returnType, + name, + header, + optionalLine(p.globals), + optionalLine(p.locals), + optionalLine(resultAsgn), + optionalLine(genProcBody(p, prc)), + optionalLine(p.indentLine(returnStmt))]) + else: + # if optLineDir in p.config.options: + # result.add("\L") + + 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("\Lfunction $#() { return $#.apply(this, arguments); }$n" % + [thunkName, name]) + + def = "\Lfunction $#($#) {$n$#$#$#$#$#" % + [ name, + header, + 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") + #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: appf(p.body, "$#;$n", r.res) + if r.res != "": lineF(p, "$#;$n", [r.res]) + +proc genPragma(p: PProc, n: PNode) = + for i in 0..<n.len: + let it = n[i] + case whichPragma(it) + of wEmit: genAsmOrEmitStmt(p, it[1]) + of wPush: + processPushBackendOption(p.config, p.optionsStack, p.options, n, i+1) + of wPop: + processPopBackendOption(p.config, p.optionsStack, p.options) + else: discard + +proc genCast(p: PProc, n: PNode, r: var TCompRes) = + var dest = skipTypes(n.typ, abstractVarRange) + var src = skipTypes(n[1].typ, abstractVarRange) + gen(p, n[1], r) + if dest.kind == src.kind: + # no-op conversion + return + let toInt = (dest.kind in tyInt..tyInt32) + let toUint = (dest.kind in tyUInt..tyUInt32) + let fromInt = (src.kind in tyInt..tyInt32) + let fromUint = (src.kind in tyUInt..tyUInt32) + + 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 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 - r.kind = resNone - #r.address = nil - r.res = nil + if r.kind != resCallee: r.kind = resNone + #r.address = "" + r.res = "" + case n.kind of nkSym: genSym(p, n, r) - of nkCharLit..nkInt64Lit: - r.res = toRope(n.intVal) + of nkCharLit..nkUInt64Lit: + 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: + 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): - nil - elif mapType(n.typ) == etyBaseIndex: + discard + elif mapType(p, n.typ) == etyBaseIndex: r.typ = etyBaseIndex - r.address = toRope"null" | toRope"nil" - r.res = toRope"0" + r.address = rope"null" + r.res = rope"0" + r.kind = resExpr else: - r.res = toRope"null" | toRope"nil" + r.res = rope"null" + r.kind = resExpr of nkStrLit..nkTripleStrLit: - if skipTypes(n.typ, abstractVarRange).kind == tyString: - useMagic(p, "cstrToNimstr") - r.res = ropef("cstrToNimstr($1)", [makeJSString(n.strVal)]) - else: - r.res = makeJSString(n.strVal) + if skipTypes(n.typ, abstractVarRange).kind == tyString: + 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: + of nkFloatLit..nkFloat64Lit: let f = n.floatVal - if f != f: r.res = toRope"NaN" - elif f == 0.0: r.res = toRope"0.0" - elif f == 0.5 * f: - if f > 0.0: r.res = toRope"Infinity" - else: r.res = toRope"-Infinity" - else: r.res = toRope(f.ToStrMaxPrecision) + case classify(f) + of fcNan: + if signbit(f): + r.res = rope"-NaN" + else: + r.res = rope"NaN" + of fcNegZero: + r.res = rope"-0.0" + of fcZero: + r.res = rope"0.0" + of fcInf: + r.res = rope"Infinity" + of fcNegInf: + r.res = rope"-Infinity" + else: + if n.typ.skipTypes(abstractVarRange).kind == tyFloat32: + r.res.addFloatRoundtrip(f.float32) + else: + r.res.addFloatRoundtrip(f) + r.kind = resExpr of nkCallKinds: - 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 - n.len >= 2: + elif n[0].kind == nkSym and sfInfixCall in n[0].sym.flags and + n.len >= 1: genInfixCall(p, n, r) - else: + else: genCall(p, n, 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: genTupleConstr(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) + of nkAddr, nkHiddenAddr: + 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: gen(p, n.sons[1], r) + of nkCast: genCast(p, n, r) of nkChckRangeF: genRangeChck(p, n, r, "chckRangeF") of nkChckRange64: genRangeChck(p, n, r, "chckRange64") of nkChckRange: genRangeChck(p, n, r, "chckRange") of nkStringToCString: convStrToCStr(p, n, r) of nkCStringToString: convCStrToStr(p, n, r) - of nkEmpty: nil - of nkLambdaKinds: - let s = n.sons[namePos].sym - discard mangleName(s) - r.res = s.loc.r - if lfNoDecl in s.loc.flags or s.magic != mNone or isGenericRoutine(s): nil + of nkEmpty: discard + of nkLambdaKinds: + let s = n[namePos].sym + discard mangleName(p.module, s) + 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): - app(p.locals, genProc(p, s)) - of nkMetaNode: gen(p, n.sons[0], r) + 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[1][0], r) of nkWhileStmt: genWhileStmt(p, n) of nkVarSection, nkLetSection: genVarStmt(p, n) - of nkConstSection: nil - of nkForStmt, nkParForStmt: - internalError(n.info, "for statement not eliminated") - of nkCaseStmt: - if p.target == targetJS: genCaseJS(p, n, r) - else: genCaseLua(p, n, r) + of nkConstSection: discard + of nkForStmt, nkParForStmt: + internalError(p.config, n.info, "for statement not eliminated") + of nkCaseStmt: genCaseJS(p, n, r) 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: genAsmStmt(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, - nkImportStmt, nkImportExceptStmt, nkExportStmt, nkExportExceptStmt, - nkFromStmt, nkTemplateDef, nkMacroDef, nkPragma: nil - of nkProcDef, nkMethodDef, nkConverterDef: - var s = n.sons[namePos].sym + of nkTypeSection, nkCommentStmt, nkIncludeStmt, + nkImportStmt, nkImportExceptStmt, nkExportStmt, nkExportExceptStmt, + nkFromStmt, nkTemplateDef, nkMacroDef, nkIteratorDef, nkStaticStmt, + nkMixinStmt, nkBindStmt: discard + of nkPragma: genPragma(p, n) + of nkProcDef, nkFuncDef, nkMethodDef, nkConverterDef: + 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(n.info, "first class iterators not implemented") - else: InternalError(n.info, "gen: unknown node type: " & $n.kind) - -var globals: PGlobals - -proc newModule(module: PSym): BModule = - new(result) - result.module = module - if globals == nil: globals = newGlobals() - -proc genHeader(): PRope = - result = ropef("/* Generated by the Nimrod Compiler v$1 */$n" & - "/* (c) 2013 Andreas Rumpf */$n$n" & - "$nvar Globals = this;$n" & - "var framePtr = null;$n" & - "var excHandler = null;$n", - [toRope(versionAsString)]) - -proc genModule(p: PProc, n: PNode) = + 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 = + ## Create a new JS backend module node. + if g.backend == nil: + g.backend = newGlobals() + result = BModule(module: module, sigConflicts: initCountTable[SigHash](), + graph: g, config: g.config + ) + if sfSystemModule in module.flags: + PGlobals(g.backend).inSystem = true + +proc genHeader(): Rope = + ## Generate the JS header. + result = rope("""/* Generated by the Nim Compiler v$1 */ + var framePtr = null; + var excHandler = 0; + 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: - appf(p.body, "var F = {procname:$1,prev:framePtr,filename:$2,line:0};$n" & - "framePtr = F;$n", [ - makeJSString("module " & p.module.module.name.s), - makeJSString(toFilename(p.module.module.info))]) - genStmt(p, n) + p.body.add(frameCreate(p, + makeJSString("module " & p.module.module.name.s), + 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: - appf(p.body, "framePtr = framePtr.prev;$n") + p.body.add(frameDestroy(p)) -proc myProcess(b: PPassContext, n: PNode): PNode = - if passes.skipCodegen(n): return n +proc processJSCodeGen*(b: PPassContext, n: PNode): PNode = + ## Generate JS code for a node. result = n - var m = BModule(b) - if m.module == nil: InternalError(n.info, "myProcess") - var p = newProc(globals, m, nil, m.module.options) + let m = BModule(b) + if pipelineutils.skipCodegen(m.config, n): return n + if m.module == nil: internalError(m.config, n.info, "myProcess") + let globals = PGlobals(m.graph.backend) + var p = newInitProc(globals, m) + m.initProc = p + p.unique = globals.unique genModule(p, n) - app(p.g.code, p.locals) - app(p.g.code, p.body) - -proc myClose(b: PPassContext, n: PNode): PNode = - if passes.skipCodegen(n): return n - result = myProcess(b, n) + p.g.code.add(p.locals) + p.g.code.add(p.body) + +proc wholeCode(graph: ModuleGraph; m: BModule): Rope = + ## Combine source code from all nodes. + let globals = PGlobals(graph.backend) + for prc in globals.forwarded: + if not globals.generatedSyms.containsOrIncl(prc.id): + var p = newInitProc(globals, m) + attachProc(p, prc) + + generateIfMethodDispatchers(graph, m.idgen) + for prc in getDispatchers(graph): + if not globals.generatedSyms.containsOrIncl(prc.id): + var p = newInitProc(globals, m) + attachProc(p, prc) + + result = globals.typeInfo & globals.constants & globals.code + +proc finalJSCodeGen*(graph: ModuleGraph; b: PPassContext, n: PNode): PNode = + ## Finalize JS code generation of a Nim module. + ## Param `n` may contain nodes returned from the last module close call. var m = BModule(b) if sfMainModule in m.module.flags: - for prc in globals.forwarded: - if not globals.generatedSyms.containsOrIncl(prc.id): - var p = newProc(globals, m, nil, m.module.options) - app(p.g.code, genProc(p, prc)) - - var disp = generateMethodDispatchers() - for i in 0..sonsLen(disp)-1: - let prc = disp.sons[i].sym - if not globals.generatedSyms.containsOrIncl(prc.id): - var p = newProc(globals, m, nil, m.module.options) - app(p.g.code, genProc(p, prc)) - - # write the file: - var code = con(globals.typeInfo, globals.code) - var outfile = changeFileExt(completeCFilePath(m.module.filename), "js") - discard writeRopeIfNotEqual(con(genHeader(), code), outfile) - -proc myOpenCached(s: PSym, rd: PRodReader): PPassContext = - InternalError("symbol files are not possible with the JS code generator") - result = nil - -proc myOpen(s: PSym): PPassContext = - result = newModule(s) - -const JSgenPass* = makePass(myOpen, myOpenCached, myProcess, myClose) + # 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) + result.idgen = idgen diff --git a/compiler/jstypes.nim b/compiler/jstypes.nim index 0be1e99dc..d980f9989 100644 --- a/compiler/jstypes.nim +++ b/compiler/jstypes.nim @@ -1,148 +1,156 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2013 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # +# included from jsgen.nim + ## Type info generation for the JS backend. -proc genTypeInfo(p: PProc, typ: PType): PRope -proc genObjectFields(p: PProc, typ: PType, n: PNode): PRope = - var - s, u: PRope - length: int +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 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]) - else: - s = nil - for i in countup(0, length - 1): - if i > 0: app(s, ", " & tnl) - app(s, genObjectFields(p, typ, n.sons[i])) - result = ropef("{kind: 2, len: $1, offset: 0, " & - "typ: null, name: null, sons: [$2]}", [toRope(length), s]) - of nkSym: + of nkRecList: + if n.len == 1: + result = genObjectFields(p, typ, n[0]) + else: + 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(n.len), s] + of nkSym: field = n.sym s = genTypeInfo(p, field.typ) - result = ropef("{kind: 1, offset: \"$1\", len: 0, " & - "typ: $2, name: $3, sons: null}", - [mangleName(field), s, makeJSString(field.name.s)]) - of nkRecCase: - length = sonsLen(n) - if (n.sons[0].kind != nkSym): InternalError(n.info, "genObjectFields") - field = n.sons[0].sym + result = ("{kind: 1, offset: \"$1\", len: 0, " & + "typ: $2, name: $3, sons: null}") % + [mangleName(p.module, field), s, + makeJSString(field.name.s)] + of nkRecCase: + 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: - internalError(b.info, "genObjectFields; nkOfBranch broken") - for j in countup(0, sonsLen(b) - 2): - if u != nil: app(u, ", ") - if b.sons[j].kind == nkRange: - appf(u, "[$1, $2]", [toRope(getOrdValue(b.sons[j].sons[0])), - toRope(getOrdValue(b.sons[j].sons[1]))]) - else: - app(u, toRope(getOrdValue(b.sons[j]))) - of nkElse: - u = toRope(lengthOrd(field.typ)) - else: internalError(n.info, "genObjectFields(nkRecCase)") - if result != nil: app(result, ", " & tnl) - appf(result, "[SetConstr($1), $2]", + of nkOfBranch: + if b.len < 2: + internalError(p.config, b.info, "genObjectFields; nkOfBranch broken") + 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: + 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 != "": result.add(", \L") + result.addf("[setConstr($1), $2]", [u, genObjectFields(p, typ, lastSon(b))]) - result = ropef("{kind: 3, offset: \"$1\", len: $3, " & - "typ: $2, name: $4, sons: [$5]}", [mangleName(field), s, - toRope(lengthOrd(field.typ)), makeJSString(field.name.s), result]) - else: internalError(n.info, "genObjectFields") - -proc genObjectInfo(p: PProc, typ: PType, name: PRope) = - var s = ropef("var $1 = {size: 0, kind: $2, base: null, node: null, " & - "finalizer: null};$n", [name, toRope(ord(typ.kind))]) + result = ("{kind: 3, offset: \"$1\", len: $3, " & + "typ: $2, name: $4, sons: [$5]}") % [ + mangleName(p.module, field), s, + rope(lengthOrd(p.config, field.typ)), makeJSString(field.name.s), result] + else: internalError(p.config, n.info, "genObjectFields") + +proc objHasTypeField(t: PType): bool {.inline.} = + 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) - appf(p.g.typeInfo, "var NNI$1 = $2;$n", - [toRope(typ.id), genObjectFields(p, typ, typ.n)]) - appf(p.g.typeInfo, "$1.node = NNI$2;$n", [name, toRope(typ.id)]) - if (typ.kind == tyObject) and (typ.sons[0] != nil): - appf(p.g.typeInfo, "$1.base = $2;$n", - [name, genTypeInfo(p, typ.sons[0])]) + p.g.typeInfo.addf("var NNI$1 = $2;$n", + [rope(typ.id), genObjectFields(p, typ, typ.n)]) + p.g.typeInfo.addf("$1.node = NNI$2;$n", [name, rope(typ.id)]) + if (typ.kind == tyObject) and (typ.baseClass != nil): + p.g.typeInfo.addf("$1.base = $2;$n", + [name, genTypeInfo(p, typ.baseClass.skipTypes(skipPtrs))]) -proc genTupleFields(p: PProc, typ: PType): PRope = - var s: PRope = nil - for i in 0 .. <typ.len: - if i > 0: app(s, ", " & tnl) - s.appf("{kind: 1, offset: \"Field$1\", len: 0, " & +proc genTupleFields(p: PProc, typ: PType): Rope = + 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.toRope, genTypeInfo(p, typ.sons[i])]) - result = ropef("{kind: 2, len: $1, offset: 0, " & - "typ: null, name: null, sons: [$2]}", [toRope(typ.len), s]) + [i.rope, genTypeInfo(p, typ[i])]) + result = ("{kind: 2, len: $1, offset: 0, " & + "typ: null, name: null, sons: [$2]}") % [rope(typ.len), s] -proc genTupleInfo(p: PProc, typ: PType, name: PRope) = - var s = ropef("var $1 = {size: 0, kind: $2, base: null, node: null, " & - "finalizer: null};$n", [name, toRope(ord(typ.kind))]) +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) - appf(p.g.typeInfo, "var NNI$1 = $2;$n", - [toRope(typ.id), genTupleFields(p, typ)]) - appf(p.g.typeInfo, "$1.node = NNI$2;$n", [name, toRope(typ.id)]) + p.g.typeInfo.addf("var NNI$1 = $2;$n", + [rope(typ.id), genTupleFields(p, typ)]) + p.g.typeInfo.addf("$1.node = NNI$2;$n", [name, rope(typ.id)]) -proc genEnumInfo(p: PProc, typ: PType, name: PRope) = - let length = sonsLen(typ.n) - var s: PRope = nil - for i in countup(0, length - 1): - if (typ.n.sons[i].kind != nkSym): InternalError(typ.n.info, "genEnumInfo") - let field = typ.n.sons[i].sym - if i > 0: app(s, ", " & tnl) +proc genEnumInfo(p: PProc, typ: PType, name: Rope) = + 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 - appf(s, "{kind: 1, offset: $1, typ: $2, name: $3, len: 0, sons: null}", - [toRope(field.position), name, makeJSString(extName)]) - var n = ropef("var NNI$1 = {kind: 2, offset: 0, typ: null, " & - "name: null, len: $2, sons: [$3]};$n", [toRope(typ.id), toRope(length), s]) - s = ropef("var $1 = {size: 0, kind: $2, base: null, node: null, " & - "finalizer: null};$n", [name, toRope(ord(typ.kind))]) + 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(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) - app(p.g.typeInfo, n) - appf(p.g.typeInfo, "$1.node = NNI$2;$n", [name, toRope(typ.id)]) - if typ.sons[0] != nil: - appf(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): PRope = - var t = typ - if t.kind == tyGenericInst: t = lastSon(t) - result = ropef("NTI$1", [toRope(t.id)]) - if ContainsOrIncl(p.g.TypeInfoGenerated, t.id): return +proc genTypeInfo(p: PProc, typ: PType): Rope = + 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, typ.sons[0]) - of tyPointer, tyProc, tyBool, tyChar, tyCString, tyString, tyInt..tyFloat128: - var s = ropef( - "var $1 = {size: 0,kind: $2,base: null,node: null,finalizer: null};$n", - [result, toRope(ord(t.kind))]) + of tyDistinct: + 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, tyRef, tyPtr, tySequence, tyRange, tySet: - var s = ropef( - "var $1 = {size: 0,kind: $2,base: null,node: null,finalizer: null};$n", - [result, toRope(ord(t.kind))]) + of tyVar, tyLent, tyRef, tyPtr, tySequence, tyRange, tySet, tyOpenArray: + 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) - appf(p.g.typeInfo, "$1.base = $2;$n", - [result, genTypeInfo(p, typ.sons[0])]) - of tyArrayConstr, tyArray: - var s = ropef( - "var $1 = {size: 0,kind: $2,base: null,node: null,finalizer: null};$n", - [result, toRope(ord(t.kind))]) + 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" % + [result, rope(ord(t.kind))] prepend(p.g.typeInfo, s) - appf(p.g.typeInfo, "$1.base = $2;$n", - [result, genTypeInfo(p, typ.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) - else: InternalError("genTypeInfo(" & $t.kind & ')') + of tyStatic: + 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 8d4946ab5..54cdfc5bc 100644 --- a/compiler/lambdalifting.nim +++ b/compiler/lambdalifting.nim @@ -1,100 +1,106 @@ # # -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # -# This include file implements lambda lifting for the transformator. +# This file implements lambda lifting for the transformator. -import - intsets, strutils, lists, options, ast, astalgo, trees, treetab, msgs, os, - idents, renderer, types, magicsys, rodread +import + 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 - that the calling chain needs to be explicitely modelled. Things to consider: - + that the calling chain needs to be explicitly modelled. Things to consider: + proc a = var v = 0 proc b = var w = 2 - + for x in 0..3: proc c = capture v, w, x c() b() - + for x in 0..4: proc d = capture x d() - + Needs to be translated into: - + proc a = var cl: * new cl cl.v = 0 - + proc b(cl) = var bcl: * new bcl bcl.w = 2 bcl.up = cl - + for x in 0..3: var bcl2: * new bcl2 bcl2.up = bcl bcl2.up2 = cl bcl2.x = x - + proc c(cl) = capture cl.up2.v, cl.up.w, cl.x c(bcl2) - + c(bcl) - + b(cl) - + for x in 0..4: var acl2: * new acl2 acl2.x = x proc d(cl) = capture cl.x d(acl2) - + Closures as interfaces: - + proc outer: T = var captureMe: TObject # value type required for efficiency proc getter(): int = result = captureMe.x proc setter(x: int) = captureMe.x = x - + result = (getter, setter) - + Is translated to: - + proc outer: T = var cl: * new cl - + proc getter(cl): int = result = cl.captureMe.x proc setter(cl: *, x: int) = cl.captureMe.x = x - + result = ((cl, getter), (cl, setter)) - - + + For 'byref' capture, the outer proc needs to access the captured var through the indirection too. For 'bycopy' capture, the outer proc accesses the var not through the indirection. - - Possible optimizations: - + + Possible optimizations: + 1) If the closure contains a single 'ref' and this reference is not re-assigned (check ``sfAddrTaken`` flag) make this the - closure. This is an important optimization if closures are used as + closure. This is an important optimization if closures are used as interfaces. 2) If the closure does not escape, put it onto the stack, not on the heap. 3) Dataflow analysis would help to eliminate the 'up' indirections. @@ -103,700 +109,918 @@ discard """ """ +# Important things to keep in mind: +# * Don't base the analysis on nkProcDef et al. This doesn't work for +# instantiated (formerly generic) procs. The analysis has to look at nkSym. +# This also means we need to prevent the same proc is processed multiple +# times via the 'processed' set. +# * Keep in mind that the owner of some temporaries used to be unreliable. +# * For closure iterators we merge the "real" potential closure with the +# local storage requirements for efficiency. This means closure iterators +# have slightly different semantics from ordinary closures. + +# ---------------- essential helpers ------------------------------------- + const upName* = ":up" # field name for the 'up' reference - paramName* = ":env" + paramName* = ":envP" envName* = ":env" -type - PInnerContext = ref TInnerContext - POuterContext = ref TOuterContext - - PEnv = ref TEnv - TDep = tuple[e: PEnv, field: PSym] - TEnv {.final.} = object of TObject - attachedNode: PNode - closure: PSym # if != nil it is a used environment - capturedVars: seq[PSym] # captured variables in this environment - deps: seq[TDep] # dependencies - up: PEnv - tup: PType - - TInnerContext {.final.} = object - fn: PSym - closureParam: PSym - localsToAccess: TIdNodeTable - - TOuterContext {.final.} = object - fn: PSym # may also be a module! - currentEnv: PEnv - capturedVars, processed: TIntSet - localsToEnv: TIdTable # PSym->PEnv mapping - localsToAccess: TIdNodeTable - lambdasToEnv: TIdTable # PSym->PEnv mapping - up: POuterContext - -proc newOuterContext(fn: PSym, up: POuterContext = nil): POuterContext = - new(result) - result.fn = fn - result.capturedVars = initIntSet() - result.processed = initIntSet() - initIdNodeTable(result.localsToAccess) - initIdTable(result.localsToEnv) - initIdTable(result.lambdasToEnv) - -proc newInnerContext(fn: PSym): PInnerContext = - new(result) - result.fn = fn - initIdNodeTable(result.localsToAccess) - -proc newEnv(outerProc: PSym, up: PEnv, n: PNode): PEnv = - new(result) - result.deps = @[] - result.capturedVars = @[] - result.tup = newType(tyTuple, outerProc) - result.tup.n = newNodeI(nkRecList, outerProc.info) - result.up = up - result.attachedNode = n - -proc addField(tup: PType, s: PSym) = - var field = newSym(skField, s.name, s.owner, s.info) - let t = skipIntLit(s.typ) - field.typ = t - field.position = sonsLen(tup) - addSon(tup.n, newSymNode(field)) - rawAddSon(tup, t) - -proc addCapturedVar(e: PEnv, v: PSym) = - for x in e.capturedVars: - if x == v: return - e.capturedVars.add(v) - addField(e.tup, v) - -proc addDep(e, d: PEnv, owner: PSym): PSym = - for x, field in items(e.deps): - if x == d: return field - var pos = sonsLen(e.tup) - result = newSym(skField, getIdent(upName & $pos), owner, owner.info) - result.typ = newType(tyRef, owner) - result.position = pos - assert d.tup != nil - rawAddSon(result.typ, d.tup) - addField(e.tup, result) - e.deps.add((d, result)) - -proc indirectAccess(a: PNode, b: PSym, info: TLineInfo): PNode = - # returns a[].b as a node - var deref = newNodeI(nkHiddenDeref, info) - deref.typ = a.typ.sons[0] - let field = getSymFromList(deref.typ.n, b.name) - assert field != nil, b.name.s - addSon(deref, a) - result = newNodeI(nkDotExpr, info) - addSon(result, deref) - addSon(result, newSymNode(field)) - result.typ = field.typ - -proc indirectAccess(a, b: PSym, info: TLineInfo): PNode = - result = indirectAccess(newSymNode(a), b, info) - -proc newCall(a, b: PSym): PNode = +proc newCall(a: PSym, b: PNode): PNode = result = newNodeI(nkCall, a.info) result.add newSymNode(a) - result.add newSymNode(b) + result.add b + +proc createClosureIterStateType*(g: ModuleGraph; iter: PSym; idgen: IdGenerator): PType = + var n = newNodeI(nkRange, iter.info) + 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, idgen, iter) + rawAddSon(result, intType) + +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; 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; idgen: IdGenerator): PSym = + if resultPos < iter.ast.len: + result = iter.ast[resultPos].sym + else: + # XXX a bit hacky: + result = newSym(skResult, getIdent(g.cache, ":result"), idgen, iter, iter.info, {}) + result.typ = iter.typ.returnType + incl(result.flags, sfUsed) + iter.ast.add newSymNode(result) proc addHiddenParam(routine: PSym, param: PSym) = - var params = routine.ast.sons[paramsPos] - param.position = params.len - addSon(params, newSymNode(param)) - incl(routine.typ.flags, tfCapturesEnv) - #echo "produced environment: ", param.id, " for ", routine.name.s - -proc getHiddenParam(routine: PSym): PSym = - let params = routine.ast.sons[paramsPos] - let hidden = lastSon(params) - assert hidden.kind == nkSym - result = hidden.sym - -proc isInnerProc(s, outerProc: PSym): bool {.inline.} = - result = s.kind in {skProc, skMethod, skConverter} and - s.owner == outerProc and not isGenericRoutine(s) - #s.typ.callConv == ccClosure - -proc addClosureParam(i: PInnerContext, e: PEnv) = - var cp = newSym(skParam, getIdent(paramname), i.fn, i.fn.info) - incl(cp.flags, sfFromGeneric) - cp.typ = newType(tyRef, i.fn) - rawAddSon(cp.typ, e.tup) - i.closureParam = cp - addHiddenParam(i.fn, i.closureParam) - #echo "closure param added for ", i.fn.name.s, " ", i.fn.id - -proc dummyClosureParam(o: POuterContext, i: PInnerContext) = - var e = o.currentEnv - if IdTableGet(o.lambdasToEnv, i.fn) == nil: - IdTablePut(o.lambdasToEnv, i.fn, e) - if i.closureParam == nil: addClosureParam(i, e) + assert param.kind == skParam + 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 + params.add newSymNode(param) + #incl(routine.typ.flags, tfCapturesEnv) + assert sfFromGeneric in param.flags + #echo "produced environment: ", param.id, " for ", routine.id -proc illegalCapture(s: PSym): bool {.inline.} = - result = skipTypes(s.typ, abstractInst).kind in - {tyVar, tyOpenArray, tyVarargs} or - s.kind == skResult - -proc captureVar(o: POuterContext, i: PInnerContext, local: PSym, - info: TLineInfo) = - # for inlined variables the owner is still wrong, so it can happen that it's - # not a captured variable at all ... *sigh* - var it = PEnv(IdTableGet(o.localsToEnv, local)) - if it == nil: return - - if illegalCapture(local) or o.fn.id != local.owner.id or - i.fn.typ.callConv notin {ccClosure, ccDefault}: - # Currently captures are restricted to a single level of nesting: - LocalError(info, errIllegalCaptureX, local.name.s) - i.fn.typ.callConv = ccClosure - #echo "captureVar ", i.fn.name.s, i.fn.id, " ", local.name.s, local.id - - incl(i.fn.typ.flags, tfCapturesEnv) - - # we need to remember which inner most closure belongs to this lambda: - var e = o.currentEnv - if IdTableGet(o.lambdasToEnv, i.fn) == nil: - IdTablePut(o.lambdasToEnv, i.fn, e) - - # variable already captured: - if IdNodeTableGet(i.localsToAccess, local) != nil: return - if i.closureParam == nil: addClosureParam(i, e) - - # check which environment `local` belongs to: - var access = newSymNode(i.closureParam) - addCapturedVar(it, local) - if it == e: - # common case: local directly in current environment: - nil +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: - # it's in some upper environment: - access = indirectAccess(access, addDep(e, it, i.fn), info) - access = indirectAccess(access, local, info) - incl(o.capturedVars, local.id) - IdNodeTablePut(i.localsToAccess, local, access) + 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 interestingVar(s: PSym): bool {.inline.} = result = s.kind in {skVar, skLet, skTemp, skForVar, skParam, skResult} and - sfGlobal notin s.flags + sfGlobal notin s.flags and + s.typ.kind notin {tyStatic, tyTypeDesc} -proc semCaptureSym*(s, owner: PSym) = - if interestingVar(s) and owner.id != s.owner.id and s.kind != skResult: - if owner.typ != nil and not isGenericRoutine(owner): - owner.typ.callConv = ccClosure - #echo "semCaptureSym ", owner.name.s, owner.id, " ", s.name.s, s.id - # since the analysis is not entirely correct, we don't set 'tfCapturesEnv' - # here +proc illegalCapture(s: PSym): bool {.inline.} = + result = classifyViewType(s.typ) != noView or s.kind == skResult -proc gatherVars(o: POuterContext, i: PInnerContext, n: PNode) = - # gather used vars for closure generation - if n == nil: return - case n.kind - of nkSym: - var s = n.sym - if interestingVar(s) and i.fn.id != s.owner.id: - captureVar(o, i, s, n.info) - elif isInnerProc(s, o.fn) and tfCapturesEnv in s.typ.flags and s != i.fn: - # call to some other inner proc; we need to track the dependencies for - # this: - let env = PEnv(IdTableGet(o.lambdasToEnv, i.fn)) - if env == nil: InternalError(n.info, "no environment computed") - if o.currentEnv != env: - discard addDep(o.currentEnv, env, i.fn) - InternalError(n.info, "too complex environment handling required") - of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit: nil +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: - for k in countup(0, sonsLen(n) - 1): - gatherVars(o, i, n.sons[k]) - -proc generateThunk(prc: PNode, dest: PType): PNode = - ## Converts 'prc' into '(thunk, nil)' so that it's compatible with - ## a closure. - - # we cannot generate a proper thunk here for GC-safety reasons (see internal - # documentation): - if gCmd == cmdCompileToJS: return prc - result = newNodeIT(nkClosure, prc.info, dest) - var conv = newNodeIT(nkHiddenStdConv, prc.info, dest) - conv.add(emptyNode) - conv.add(prc) - result.add(conv) - result.add(newNodeIT(nkNilLit, prc.info, getSysType(tyNil))) - -proc transformOuterConv(n: PNode): PNode = - # numeric types need range checks: - var dest = skipTypes(n.typ, abstractVarRange) - var source = skipTypes(n.sons[1].typ, abstractVarRange) - if dest.kind == tyProc: - if dest.callConv == ccClosure and source.callConv == ccDefault: - result = generateThunk(n.sons[1], dest) - -proc makeClosure(prc, env: PSym, info: TLineInfo): PNode = + result = false + +proc newAsgnStmt(le, ri: PNode, info: TLineInfo): PNode = + # Bugfix: unfortunately we cannot use 'nkFastAsgn' here as that would + # mean to be able to capture string literals which have no GC header. + # However this can only happen if the capture happens through a parameter, + # which is however the only case when we generate an assignment in the first + # place. + result = newNodeI(nkAsgn, info, 2) + result[0] = le + result[1] = ri + +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: - result.add(newNodeIT(nkNilLit, info, getSysType(tyNil))) + result.add(newNodeIT(nkNilLit, info, getSysType(g, info, tyNil))) else: - result.add(newSymNode(env)) + 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 transformInnerProc(o: POuterContext, i: PInnerContext, n: PNode): PNode = - case n.kind - of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit: nil - of nkSym: - let s = n.sym - if s == i.fn: - # recursive calls go through (lambda, hiddenParam): - assert i.closureParam != nil, i.fn.name.s - result = makeClosure(s, i.closureParam, n.info) - elif isInnerProc(s, o.fn) and s.typ.callConv == ccClosure: - # ugh: call to some other inner proc; - assert i.closureParam != nil - # XXX this is not correct in general! may also be some 'closure.upval' - result = makeClosure(s, i.closureParam, n.info) - else: - # captured symbol? - result = IdNodeTableGet(i.localsToAccess, n.sym) - of nkLambdaKinds: - result = transformInnerProc(o, i, n.sons[namePos]) - of nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef, nkTemplateDef, - nkIteratorDef: - # don't recurse here: - nil +proc interestingIterVar(s: PSym): bool {.inline.} = + # unused with -d:nimOptIters + # XXX optimization: Only lift the variable if it lives across + # yield/return boundaries! This can potentially speed up + # closure iterators quite a bit. + result = s.kind in {skResult, skVar, skLet, skTemp, skForVar} and sfGlobal notin s.flags + +template 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 + 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, iter.typ) + let hp = getHiddenParam(g, iter) + var env: PNode + if owner.isIterator: + let it = getHiddenParam(g, owner) + addUniqueField(it.typ.skipTypes({tyOwned})[0], hp, g.cache, idgen) + env = indirectAccess(newSymNode(it), hp, hp.info) else: - for j in countup(0, sonsLen(n) - 1): - let x = transformInnerProc(o, i, n.sons[j]) - if x != nil: n.sons[j] = x + let e = newSym(skLet, iter.name, idgen, owner, n.info) + e.typ = hp.typ + e.flags = hp.flags + env = newSymNode(e) + var v = newNodeI(nkVarSection, n.info) + addVar(v, env) + result.add(v) + # add 'new' statement: + #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 closureCreationPoint(n: PNode): PNode = - result = newNodeI(nkStmtList, n.info) - result.add(emptyNode) - result.add(n) +proc freshVarForClosureIter*(g: ModuleGraph; s: PSym; idgen: IdGenerator; owner: PSym): PNode = + # unused with -d:nimOptIters + let envParam = getHiddenParam(g, owner) + let obj = envParam.typ.skipTypes({tyOwned, tyRef, tyPtr}) + let field = addField(obj, s, g.cache, idgen) -proc searchForInnerProcs(o: POuterContext, n: PNode) = - if n == nil: return - case n.kind - of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit: - nil - of nkSym: - if isInnerProc(n.sym, o.fn) and not containsOrIncl(o.processed, n.sym.id): - var inner = newInnerContext(n.sym) - let body = n.sym.getBody - gatherVars(o, inner, body) - # dummy closure param needed? - if inner.closureParam == nil and n.sym.typ.callConv == ccClosure: - #assert tfCapturesEnv notin n.sym.typ.flags - dummyClosureParam(o, inner) - # only transform if it really needs a closure: - if inner.closureParam != nil: - let ti = transformInnerProc(o, inner, body) - if ti != nil: n.sym.ast.sons[bodyPos] = ti - of nkLambdaKinds: - searchForInnerProcs(o, n.sons[namePos]) - of nkWhileStmt, nkForStmt, nkParForStmt, nkBlockStmt: - # some nodes open a new scope, so they are candidates for the insertion - # of closure creation; however for simplicity we merge closures between - # branches, in fact, only loop bodies are of interest here as only they - # yield observable changes in semantics. For Zahary we also - # include ``nkBlock``. - var body = n.len-1 - for i in countup(0, body - 1): searchForInnerProcs(o, n.sons[i]) - # special handling for the loop body: - let oldEnv = o.currentEnv - let ex = closureCreationPoint(n.sons[body]) - o.currentEnv = newEnv(o.fn, oldEnv, ex) - searchForInnerProcs(o, n.sons[body]) - n.sons[body] = ex - o.currentEnv = oldEnv - of nkVarSection, nkLetSection: - # we need to compute a mapping var->declaredBlock. Note: The definition - # counts, not the block where it is captured! - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - if it.kind == nkCommentStmt: nil - elif it.kind == nkIdentDefs: - var L = sonsLen(it) - if it.sons[0].kind != nkSym: InternalError(it.info, "transformOuter") - #echo "set: ", it.sons[0].sym.name.s, " ", o.currentBlock == nil - IdTablePut(o.localsToEnv, it.sons[0].sym, o.currentEnv) - searchForInnerProcs(o, it.sons[L-1]) - elif it.kind == nkVarTuple: - var L = sonsLen(it) - for j in countup(0, L-3): - #echo "set: ", it.sons[j].sym.name.s, " ", o.currentBlock == nil - IdTablePut(o.localsToEnv, it.sons[j].sym, o.currentEnv) - searchForInnerProcs(o, it.sons[L-1]) - else: - InternalError(it.info, "transformOuter") - of nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef, nkTemplateDef, - nkIteratorDef: - # don't recurse here: - # XXX recurse here and setup 'up' pointers - nil + var access = newSymNode(envParam) + assert obj.kind == tyObject + result = rawIndirectAccess(access, field, s.info) + +# ------------------ new stuff ------------------------------------------- + +proc markAsClosure(g: ModuleGraph; owner: PSym; n: PNode) = + let s = n.sym + let isEnv = s.name.id == getIdent(g.cache, ":env").id + if illegalCapture(s): + localError(g.config, n.info, + ("'$1' is of type <$2> which cannot be captured as it would violate memory" & + " safety, declared here: $3; using '-d:nimNoLentIterators' helps in some cases." & + " Consider using a <ref T> which can be captured.") % + [s.name.s, typeToString(s.typ.skipTypes({tyVar})), g.config$s.info]) + elif not (owner.typ.isClosure or owner.isNimcall and not owner.isExplicitCallConv or isEnv): + localError(g.config, n.info, "illegal capture '$1' because '$2' has the calling convention: <$3>" % + [s.name.s, owner.name.s, $owner.typ.callConv]) + incl(owner.typ.flags, tfCapturesEnv) + if not isEnv: + owner.typ.callConv = ccClosure + +type + DetectionPass = object + processed, capturedVars: IntSet + ownerToType: Table[int, PType] + somethingToDo: bool + inTypeOf: bool + graph: ModuleGraph + idgen: IdGenerator + +proc initDetectionPass(g: ModuleGraph; fn: PSym; idgen: IdGenerator): DetectionPass = + result = DetectionPass(processed: toIntSet([fn.id]), + capturedVars: initIntSet(), ownerToType: initTable[int, PType](), + graph: g, idgen: idgen + ) + +discard """ +proc outer = + var a, b: int + proc innerA = use(a) + proc innerB = use(b); innerA() +# --> innerA and innerB need to *share* the closure type! +This is why need to store the 'ownerToType' table and use it +during .closure'fication. +""" + +proc getEnvTypeForOwner(c: var DetectionPass; owner: PSym; + info: TLineInfo): PType = + result = c.ownerToType.getOrDefault(owner.id) + if result.isNil: + 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: - for i in countup(0, sonsLen(n) - 1): - searchForInnerProcs(o, n.sons[i]) + result = t -proc newAsgnStmt(le, ri: PNode, info: TLineInfo): PNode = - # Bugfix: unfortunately we cannot use 'nkFastAsgn' here as that would - # mean to be able to capture string literals which have no GC header. - # However this can only happen if the capture happens through a parameter, - # 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 - -proc addVar*(father, v: PNode) = - var vpart = newNodeI(nkIdentDefs, v.info) - addSon(vpart, v) - addSon(vpart, ast.emptyNode) - addSon(vpart, ast.emptyNode) - addSon(father, vpart) - -proc getClosureVar(o: POuterContext, e: PEnv): PSym = - if e.closure == nil: - result = newSym(skVar, getIdent(envName), o.fn, e.attachedNode.info) - incl(result.flags, sfShadowed) - result.typ = newType(tyRef, o.fn) - result.typ.rawAddSon(e.tup) - e.closure = result +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.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.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: - result = e.closure + 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) -proc generateClosureCreation(o: POuterContext, scope: PEnv): PNode = - var env = getClosureVar(o, scope) +discard """ +There are a couple of possibilities of how to implement closure +iterators that capture outer variables in a traditional sense +(aka closure closure iterators). - result = newNodeI(nkStmtList, env.info) - var v = newNodeI(nkVarSection, env.info) - addVar(v, newSymNode(env)) - result.add(v) - # add 'new' statement: - result.add(newCall(getSysSym"internalNew", env)) - - # add assignment statements: - for local in scope.capturedVars: - let fieldAccess = indirectAccess(env, local, env.info) - if local.kind == skParam: - # maybe later: (sfByCopy in local.flags) - # add ``env.param = param`` - result.add(newAsgnStmt(fieldAccess, newSymNode(local), env.info)) - IdNodeTablePut(o.localsToAccess, local, fieldAccess) - # add support for 'up' references: - for e, field in items(scope.deps): - # add ``env.up = env2`` - result.add(newAsgnStmt(indirectAccess(env, field, env.info), - newSymNode(getClosureVar(o, e)), env.info)) - -proc transformOuterProc(o: POuterContext, n: PNode): PNode = - if n == nil: return nil +1. Transform iter() to iter(state, capturedEnv). So use 2 hidden + parameters. +2. Add the captured vars directly to 'state'. +3. Make capturedEnv an up-reference of 'state'. + +We do (3) here because (2) is obviously wrong and (1) is wrong too. +Consider: + + proc outer = + var xx = 9 + + iterator foo() = + var someState = 3 + + proc bar = echo someState + proc baz = someState = 0 + baz() + bar() + +""" + +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), c.idgen, fn, fn.info) + incl(cp.flags, sfFromGeneric) + cp.typ = t + addHiddenParam(fn, cp) + elif cp.typ != t and fn.kind != skIterator: + localError(c.graph.config, fn.info, "internal error: inconsistent environment type") + #echo "adding closure to ", fn.name.s + +proc detectCapturedVars(n: PNode; owner: PSym; c: var DetectionPass) = case n.kind - of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit: nil of nkSym: - var local = n.sym - var closure = PEnv(IdTableGet(o.lambdasToEnv, local)) - if closure != nil: - # we need to replace the lambda with '(lambda, env)': - let a = closure.closure - if a != nil: - return makeClosure(local, a, n.info) - else: - # can happen for dummy closures: - var scope = closure.attachedNode - assert scope.kind == nkStmtList - if scope.sons[0].kind == nkEmpty: - # change the empty node to contain the closure construction: - scope.sons[0] = generateClosureCreation(o, closure) - let x = closure.closure - assert x != nil - return makeClosure(local, x, n.info) - - if not contains(o.capturedVars, local.id): return - var env = PEnv(IdTableGet(o.localsToEnv, local)) - if env == nil: return - var scope = env.attachedNode - assert scope.kind == nkStmtList - if scope.sons[0].kind == nkEmpty: - # change the empty node to contain the closure construction: - scope.sons[0] = generateClosureCreation(o, env) - - # change 'local' to 'closure.local', unless it's a 'byCopy' variable: - # if sfByCopy notin local.flags: - result = IdNodeTableGet(o.localsToAccess, local) - assert result != nil, "cannot find: " & local.name.s - # else it is captured by copy and this means that 'outer' should continue - # to access the local as a local. - of nkLambdaKinds: - result = transformOuterProc(o, n.sons[namePos]) - of nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef, nkTemplateDef, - nkIteratorDef: - # don't recurse here: - nil - of nkHiddenStdConv, nkHiddenSubConv, nkConv: - let x = transformOuterProc(o, n.sons[1]) - if x != nil: n.sons[1] = x - result = transformOuterConv(n) + let s = n.sym + if s.kind in {skProc, skFunc, skMethod, skConverter, skIterator} and + s.typ != nil and s.typ.callConv == ccClosure: + # this handles the case that the inner proc was declared as + # .closure but does not actually capture anything: + addClosureParam(c, s, n.info) + c.somethingToDo = true + + let innerProc = isInnerProc(s) + if innerProc: + if s.isIterator: c.somethingToDo = true + if not c.processed.containsOrIncl(s.id): + 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 not isDefined(c.graph.config, "nimOptIters") and interestingIterVar(s): + if not c.capturedVars.contains(s.id): + if not c.inTypeOf: c.capturedVars.incl(s.id) + let obj = getHiddenParam(c.graph, owner).typ.skipTypes({tyOwned, tyRef, tyPtr}) + #let obj = c.getEnvTypeForOwner(s.owner).skipTypes({tyOwned, tyRef, tyPtr}) + + if s.name.id == getIdent(c.graph.cache, ":state").id: + obj.n[0].sym.flags.incl sfNoInit + obj.n[0].sym.itemId = ItemId(module: s.itemId.module, item: -s.itemId.item) + else: + discard addField(obj, s, c.graph.cache, c.idgen) + # direct or indirect dependency: + elif innerClosure or interested: + discard """ + proc outer() = + var x: int + proc inner() = + proc innerInner() = + echo x + innerInner() + inner() + # inner() takes a closure too! + """ + # mark 'owner' as taking a closure: + c.somethingToDo = true + markAsClosure(c.graph, owner, n) + addClosureParam(c, owner, n.info) + #echo "capturing ", n.info + # variable 's' is actually captured: + 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: + if owner.isIterator: w = owner + let last = if ow.isIterator: ow.skipGenericOwner else: ow + while w != nil and w.kind != skModule and last != w: + discard """ + proc outer = + var a, b: int + proc outerB = + proc innerA = use(a) + proc innerB = use(b); innerA() + # --> make outerB of calling convention .closure and + # give it the same env type that outer's env var gets: + """ + let up = w.skipGenericOwner + #echo "up for ", w.name.s, " up ", up.name.s + markAsClosure(c.graph, w, n) + addClosureParam(c, w, n.info) # , ow + createUpField(c, w, up, n.info) + w = up + of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit, + nkTemplateDef, nkTypeSection, nkProcDef, nkMethodDef, + nkConverterDef, nkMacroDef, nkFuncDef, nkCommentStmt, + nkTypeOfExpr, nkMixinStmt, nkBindStmt: + discard + 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: - for i in countup(0, sonsLen(n) - 1): - let x = transformOuterProc(o, n.sons[i]) - if x != nil: n.sons[i] = x + if n.isCallExpr and n[0].isTypeOf: + c.inTypeOf = true + for i in 0..<n.len: + detectCapturedVars(n[i], owner, c) + c.inTypeOf = false -proc liftLambdas*(fn: PSym, body: PNode): PNode = - if body.kind == nkEmpty or gCmd == cmdCompileToJS: - # ignore forward declaration: - result = body +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 = LiftingPass(processed: toIntSet([fn.id]), + envVars: initTable[int, PNode]()) + +proc accessViaEnvParam(g: ModuleGraph; n: PNode; owner: PSym): PNode = + let s = n.sym + # Type based expression construction for simplicity: + let envParam = getHiddenParam(g, owner) + if not envParam.isNil: + var access = newSymNode(envParam) + var obj = access.typ.elementType + while true: + assert obj.kind == tyObject + let field = getFieldFromObj(obj, s) + if field != nil: + return rawIndirectAccess(access, field, n.info) + let upField = lookupInRecord(obj.n, getIdent(g.cache, upName)) + if upField == nil: break + access = rawIndirectAccess(access, upField, n.info) + obj = access.typ.baseClass + localError(g.config, n.info, "internal error: environment misses: " & s.name.s) + result = n + +proc newEnvVar(cache: IdentCache; owner: PSym; typ: PType; info: TLineInfo; idgen: IdGenerator): PNode = + var v = newSym(skVar, getIdent(cache, envName), 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.elementType, v) + result = indirectAccess(newSymNode(it), v, v.info) + else: + result = newSymNode(v) + +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) + 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, 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.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: 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: - var o = newOuterContext(fn) - let ex = closureCreationPoint(body) - o.currentEnv = newEnv(fn, nil, ex) - # put all params into the environment so they can be captured: - let params = fn.typ.n - for i in 1.. <params.len: - if params.sons[i].kind != nkSym: - InternalError(params.info, "liftLambdas: strange params") - let param = params.sons[i].sym - IdTablePut(o.localsToEnv, param, o.currentEnv) - # put the 'result' into the environment so it can be captured: - let ast = fn.ast - if resultPos < sonsLen(ast) and ast.sons[resultPos].kind == nkSym: - IdTablePut(o.localsToEnv, ast.sons[resultPos].sym, o.currentEnv) - searchForInnerProcs(o, body) - discard transformOuterProc(o, body) - result = ex + 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) -proc liftLambdasForTopLevel*(module: PSym, body: PNode): PNode = - if body.kind == nkEmpty or gCmd == cmdCompileToJS: - result = body + # add 'new' statement: + 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 + if local.id in d.capturedVars: + 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.skipTypes({tyOwned, tyRef, tyPtr}).n, getIdent(d.graph.cache, upName)) + if upField != nil: + let up = getUpViaParam(d.graph, owner) + if up != nil and upField.typ.skipTypes({tyOwned, tyRef, tyPtr}) == up.typ.skipTypes({tyOwned, tyRef, tyPtr}): + result.add(newAsgnStmt(rawIndirectAccess(env, upField, env.info), + up, env.info)) + #elif oldenv != nil and oldenv.typ == upField.typ: + # result.add(newAsgnStmt(rawIndirectAccess(env, upField, env.info), + # oldenv, env.info)) + else: + localError(d.graph.config, env.info, "internal error: cannot create up reference") + # 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: 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), d.idgen, owner, iter.info) + incl(v.flags, sfShadowed) + 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.skipTypes({tyOwned, tyRef, tyPtr}), v, d.graph.cache, d.idgen) + vnode = indirectAccess(newSymNode(it), v, v.info) else: - var o = newOuterContext(module) - let ex = closureCreationPoint(body) - o.currentEnv = newEnv(module, nil, ex) - searchForInnerProcs(o, body) - discard transformOuterProc(o, body) - result = ex + vnode = v.newSymNode + var vs = newNodeI(nkVarSection, iter.info) + addVar(vs, vnode) + result.add(vs) + result.add genCreateEnv(vnode) + createTypeBoundOpsLL(d.graph, vnode.typ, iter.info, d.idgen, owner) -# ------------------- iterator transformation -------------------------------- + let upField = lookupInRecord(v.typ.skipTypes({tyOwned, tyRef, tyPtr}).n, getIdent(d.graph.cache, upName)) + if upField != nil: + 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, d.idgen, iter.sym, vnode, iter.info) -discard """ - iterator chain[S, T](a, b: *S->T, args: *S): T = - for x in a(args): yield x - for x in b(args): yield x - - let c = chain(f, g) - for x in c: echo x - - # translated to: - let c = chain( (f, newClosure(f)), (g, newClosure(g)), newClosure(chain)) -""" +proc accessViaEnvVar(n: PNode; owner: PSym; d: var DetectionPass; + c: var LiftingPass): PNode = + 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) + else: + localError(d.graph.config, n.info, "internal error: not part of closure object type") + result = n -type - TIterContext {.final, pure.} = object - iter, closureParam, state, resultSym: PSym - capturedVars: TIntSet - tup: PType +proc getStateField*(g: ModuleGraph; owner: PSym): PSym = + getHiddenParam(g, owner).typ.skipTypes({tyOwned, tyRef, tyPtr}).n[0].sym -proc newIterResult(iter: PSym): PSym = - result = iter.ast.sons[resultPos].sym - when false: - result = newSym(skResult, getIdent":result", iter, iter.info) - result.typ = iter.typ.sons[0] - incl(result.flags, sfUsed) +proc liftCapturedVars(n: PNode; owner: PSym; d: var DetectionPass; + c: var LiftingPass): PNode -proc interestingIterVar(s: PSym): bool {.inline.} = - result = s.kind in {skVar, skLet, skTemp, skForVar} and sfGlobal notin s.flags +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, 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, 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, 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 transfIterBody(c: var TIterContext, n: PNode): PNode = - # gather used vars for closure generation - if n == nil: return nil +proc liftCapturedVars(n: PNode; owner: PSym; d: var DetectionPass; + c: var LiftingPass): PNode = + result = n case n.kind of nkSym: - var s = n.sym - if interestingIterVar(s) and c.iter.id == s.owner.id: - if not containsOrIncl(c.capturedVars, s.id): addField(c.tup, s) - result = indirectAccess(newSymNode(c.closureParam), s, n.info) - of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit: nil - of nkYieldStmt: - inc c.state.typ.n.sons[1].intVal - let stateNo = c.state.typ.n.sons[1].intVal - - var stateAsgnStmt = newNodeI(nkAsgn, n.info) - stateAsgnStmt.add(indirectAccess(newSymNode(c.closureParam),c.state,n.info)) - stateAsgnStmt.add(newIntTypeNode(nkIntLit, stateNo, getSysType(tyInt))) - - var retStmt = newNodeI(nkReturnStmt, n.info) - if n.sons[0].kind != nkEmpty: - var a = newNodeI(nkAsgn, n.sons[0].info) - var retVal = transfIterBody(c, n.sons[0]) - addSon(a, newSymNode(c.resultSym)) - addSon(a, if retVal.isNil: n.sons[0] else: retVal) - retStmt.add(a) - else: - retStmt.add(emptyNode) - - var stateLabelStmt = newNodeI(nkState, n.info) - stateLabelStmt.add(newIntTypeNode(nkIntLit, stateNo, getSysType(tyInt))) - - result = newNodeI(nkStmtList, n.info) - result.add(stateAsgnStmt) - result.add(retStmt) - result.add(stateLabelStmt) + let s = n.sym + if isInnerProc(s): + if not c.processed.containsOrIncl(s.id): + #if s.name.s == "temp": + # echo renderTree(s.getBody, {renderIds}) + let oldInContainer = c.inContainer + c.inContainer = 0 + 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.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 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, nkProcDef, nkMethodDef, nkConverterDef, + nkMacroDef, nkFuncDef, nkMixinStmt, nkBindStmt: + discard + of nkClosure: + if n[1].kind == nkNilLit: + 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[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 + let m = newSymNode(n[namePos].sym) + m.typ = n.typ + result = liftCapturedVars(m, owner, d, c) + c.inContainer = oldInContainer + of nkHiddenStdConv: + if n.len == 2: + n[1] = liftCapturedVars(n[1], owner, d, c) + if n[1].kind == nkClosure: result = n[1] of nkReturnStmt: - result = newNodeI(nkStmtList, n.info) - var stateAsgnStmt = newNodeI(nkAsgn, n.info) - stateAsgnStmt.add(indirectAccess(newSymNode(c.closureParam),c.state,n.info)) - stateAsgnStmt.add(newIntTypeNode(nkIntLit, -1, getSysType(tyInt))) - result.add(stateAsgnStmt) - result.add(n) + 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: - for i in countup(0, sonsLen(n)-1): - let x = transfIterBody(c, n.sons[i]) - if x != nil: n.sons[i] = x + 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[1] = liftCapturedVars(n[1], owner, d, c) + return -proc getStateType(iter: PSym): PType = - var n = newNodeI(nkRange, iter.info) - addSon(n, newIntNode(nkIntLit, -1)) - addSon(n, newIntNode(nkIntLit, 0)) - result = newType(tyRange, iter) - result.n = n - rawAddSon(result, getSysType(tyInt)) - -proc liftIterator*(iter: PSym, body: PNode): PNode = - var c: TIterContext - c.iter = iter - c.capturedVars = initIntSet() - - c.tup = newType(tyTuple, iter) - c.tup.n = newNodeI(nkRecList, iter.info) - - var cp = newSym(skParam, getIdent(paramname), iter, iter.info) - incl(cp.flags, sfFromGeneric) - cp.typ = newType(tyRef, iter) - rawAddSon(cp.typ, c.tup) - c.closureParam = cp - addHiddenParam(iter, cp) - - c.state = newSym(skField, getIdent(":state"), iter, iter.info) - c.state.typ = getStateType(iter) - addField(c.tup, c.state) - - if iter.typ.sons[0] != nil: - c.resultSym = newIterResult(iter) - iter.ast.add(newSymNode(c.resultSym)) - - result = newNodeI(nkStmtList, iter.info) - var gs = newNodeI(nkGotoState, iter.info) - gs.add(indirectAccess(newSymNode(c.closureParam), c.state, iter.info)) - result.add(gs) - var state0 = newNodeI(nkState, iter.info) - state0.add(newIntNode(nkIntLit, 0)) - result.add(state0) - - let newBody = transfIterBody(c, body) - if newBody != nil: - result.add(newBody) - else: - result.add(body) + let inContainer = n.kind in {nkObjConstr, nkBracket} + if inContainer: inc c.inContainer + for i in 0..<n.len: + n[i] = liftCapturedVars(n[i], owner, d, c) + if inContainer: dec c.inContainer - var stateAsgnStmt = newNodeI(nkAsgn, iter.info) - stateAsgnStmt.add(indirectAccess(newSymNode(c.closureParam), - c.state,iter.info)) - stateAsgnStmt.add(newIntTypeNode(nkIntLit, -1, getSysType(tyInt))) - result.add(stateAsgnStmt) +# ------------------ old stuff ------------------------------------------- -proc liftIterSym*(n: PNode): PNode = - # transforms (iter) to (let env = newClosure[iter](); (iter, env)) - result = newNodeIT(nkStmtListExpr, n.info, n.typ) - let iter = n.sym - assert iter.kind == skIterator - var env = copySym(getHiddenParam(iter)) - env.kind = skLet +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 - var v = newNodeI(nkVarSection, n.info) - addVar(v, newSymNode(env)) - result.add(v) - # add 'new' statement: - result.add(newCall(getSysSym"internalNew", env)) - result.add makeClosure(iter, env, n.info) + 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 != nil and o.kind != skModule: + if s.owner == o: + 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, " 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; + 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.transitionRoutineSymKind(skIterator) + fn.typ.callConv = ccClosure + d.ownerToType[fn.id] = ptrType + detectCapturedVars(body, fn, d) + result = liftCapturedVars(body, fn, d, c) + fn.transitionRoutineSymKind(oldKind) + fn.typ.callConv = oldCC -proc liftForLoop*(body: PNode): PNode = +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 (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, idgen) + detectCapturedVars(body, fn, d) + if not d.somethingToDo and fn.isIterator: + addClosureParam(d, fn, body.info) + d.somethingToDo = true + if d.somethingToDo: + var c = initLiftingPass(fn) + result = liftCapturedVars(body, fn, d, c) + # 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": + # echo "had something to do ", d.somethingToDo + # echo renderTree(result, {renderIds}) + +proc liftLambdasForTopLevel*(module: PSym, body: PNode): PNode = + # XXX implement it properly + result = body + +# ------------------- iterator transformation -------------------------------- + +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: - # + # we don't know what environment to create here: + # # iterator count(): int = # yield 0 - # + # # iterator count2(): int = # var x = 3 # yield x # inc x # yield x - # + # # proc invoke(iter: iterator(): int) = # for x in iter(): echo x # - # --> When to create the closure? --> for the (count) occurence! + # --> When to create the closure? --> for the (count) occurrence! discard """ for i in foo(): ... Is transformed to: - + cl = createClosure() while true: let i = foo(cl) - nkBreakState(cl.state) + if (nkBreakState(cl.state)): + break ... """ - var L = body.len - InternalAssert body.kind == nkForStmt and body[L-2].kind in nkCallKinds - var call = body[L-2] + if liftingHarmful(g.config, owner): return body + if not (body.kind == nkForStmt and body[^2].kind in nkCallKinds): + localError(g.config, body.info, "ignored invalid for loop") + return body + var call = body[^2] result = newNodeI(nkStmtList, body.info) - + # static binding? - var env: PSym - if call[0].kind == nkSym and call[0].sym.kind == skIterator: - # createClose() - let iter = call[0].sym - assert iter.kind == skIterator - env = copySym(getHiddenParam(iter)) + 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, idgen, owner, body.info) + env.typ = hp.typ + env.flags = hp.flags var v = newNodeI(nkVarSection, body.info) addVar(v, newSymNode(env)) result.add(v) # add 'new' statement: - result.add(newCall(getSysSym"internalNew", env)) - + 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[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(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: - assert body[i].kind == nkSym - body[i].sym.kind = skLet - addSon(vpart, body[i]) - - addSon(vpart, ast.emptyNode) # no explicit type - if not env.isnil: - call.sons[0] = makeClosure(call.sons[0].sym, env, body.info) - addSon(vpart, call) - addSon(v2, vpart) - - loopBody.sons[0] = v2 + 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] + + vpart.add newNodeI(nkEmpty, body.info) # no explicit type + if not env.isNil: + call[0] = makeClosure(g, idgen, call[0].sym, env.newSymNode, body.info) + vpart.add call + v2.add vpart + + loopBody[0] = v2 var bs = newNodeI(nkBreakState, body.info) - #if not env.isNil: - # bs.addSon(indirectAccess(env, - # newSym(skField, getIdent":state", env, env.info), body.info)) - #else: - bs.addSon(call.sons[0]) - loopBody.sons[1] = bs - loopBody.sons[2] = body[L-1] + bs.add call[0] + + let ibs = newNodeI(nkIfStmt, body.info) + let elifBranch = newNodeI(nkElifBranch, body.info) + elifBranch.add(bs) + + let br = newNodeI(nkBreakStmt, body.info) + br.add(g.emptyNode) + + elifBranch.add(br) + ibs.add(elifBranch) + + loopBody[1] = ibs + loopBody[2] = body[^1] diff --git a/compiler/layouter.nim b/compiler/layouter.nim new file mode 100644 index 000000000..0121b1185 --- /dev/null +++ b/compiler/layouter.nim @@ -0,0 +1,609 @@ +# +# +# The Nim Compiler +# (c) Copyright 2018 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Layouter for nimpretty. + +import idents, lexer, ast, lineinfos, llstream, options, msgs, strutils, pathutils + +const + 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: TokType + inquote, lastTokWasTerse: bool + semicolons: SemicolonKind + col, lastLineNumber, lineSpan, indentLevel, indWidth*, inSection: int + keepIndents*: int + doIndentMore*: int + 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 = 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.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 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 + for i in 0..<s.len: + if s[i] == '\L': inc result + +proc calcCol(em: var Emitter; s: string) = + var i = s.len-1 + em.col = 0 + while i >= 0 and s[i] != '\L': + dec i + inc em.col + +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 + + +const + openPars = {tkParLe, tkParDotLe, + 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, tkFrom, tkDotDot, tkAnd, tkOr, tkXor} + +template goodCol(col): bool = col >= em.maxLineLen div 2 + +template moreIndent(em): int = + 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: + 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): + 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: + # we have an inline comment so handle it before the indentation token: + emitComment(em, tok, dontIndent = (em.inSection == 0)) + preventComment = true + em.fixedUntil = em.tokens.high + + elif tok.indent >= 0: + 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 + else: + # dedent? + while em.indentStack.len > 1 and em.indentStack[^1] > tok.indent: + discard em.indentStack.pop() + em.indentLevel = em.indentStack.high * em.indWidth + #[ we only correct the indentation if it is not in an expression context, + so that code like + + const splitters = {tkComma, tkSemicolon, tkParLe, tkParDotLe, + tkBracketLe, tkBracketLeColon, tkCurlyDotLe, + tkCurlyLe} + + is not touched. + ]# + # remove trailing whitespace: + 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): + wrSpace em + elif not em.inquote and not endsInWhite(em) and + em.lastTok notin (openPars+{tkOpr, tkDotDot}) and not em.lastTokWasTerse: + #and tok.tokType in oprSet + wrSpace em + + if not em.inquote: + wr(em, $tok.tokType, ltKeyword) + if tok.tokType in {tkAnd, tkOr, tkIn, tkNotin}: + rememberSplit(splitIn) + wrSpace em + else: + # keywords in backticks are not normalized: + wr(em, tok.ident.s, ltIdent) + + of tkColon: + wr(em, $tok.tokType, ltOther) + wrSpace em + of tkSemiColon, tkComma: + wr(em, $tok.tokType, ltOther) + rememberSplit(splitComma) + 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: wrSpace(em) + wr(em, $tok.tokType, ltOther) + if not em.inquote: wrSpace(em) + of tkOpr, tkDotDot: + 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(em, tok.ident.s, ltOpr) + else: + if not em.endsInWhite: wrSpace(em) + wr(em, tok.ident.s, ltOpr) + template isUnary(tok): bool = + tok.spacing == {tsLeading} + + if not isUnary(tok): + rememberSplit(splitBinary) + wrSpace(em) + of tkAccent: + 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, dontIndent = false) + of tkIntLit..tkStrLit, tkRStrLit, tkTripleStrLit, tkGStrLit, tkGTripleStrLit, tkCharLit: + 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 + 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.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.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.endsWith("}"): + em.tokens[^1] = ".}" + inc em.col diff --git a/compiler/lexer.nim b/compiler/lexer.nim index f4fc4247a..ad5dd560c 100644 --- a/compiler/lexer.nim +++ b/compiler/lexer.nim @@ -1,715 +1,1217 @@ # # -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # 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 +import + options, msgs, platform, idents, nimlexbase, llstream, + wordrecg, lineinfos, pathutils -const - MaxLineLength* = 80 # lines longer than this lead to a warning - numChars*: TCharSet = {'0'..'9', 'a'..'z', 'A'..'Z'} - SymChars*: TCharSet = {'a'..'z', 'A'..'Z', '0'..'9', '\x80'..'\xFF'} - SymStartChars*: TCharSet = {'a'..'z', 'A'..'Z', '\x80'..'\xFF'} - OpChars*: TCharSet = {'+', '-', '*', '/', '\\', '<', '>', '!', '?', '^', '.', - '|', '=', '%', '&', '$', '@', '~', ':', '\x80'..'\xFF'} +import std/[hashes, parseutils, strutils] + +when defined(nimPreviewSlimSystem): + import std/[assertions, formatfloat] + +const + 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, tkAtomic, - tkBind, tkBlock, tkBreak, tkCase, tkCast, - tkConst, tkContinue, tkConverter, tkDiscard, tkDistinct, tkDiv, tkDo, - tkElif, tkElse, tkEnd, tkEnum, tkExcept, tkExport, - tkFinally, tkFor, tkFrom, - tkGeneric, tkIf, tkImport, tkIn, tkInclude, tkInterface, - tkIs, tkIsnot, tkIterator, - tkLambda, tkLet, - tkMacro, tkMethod, tkMixin, tkMod, tkNil, tkNot, tkNotin, - tkObject, tkOf, tkOr, tkOut, - tkProc, tkPtr, tkRaise, tkRef, tkReturn, tkShared, tkShl, tkShr, tkStatic, - tkTemplate, - tkTry, tkTuple, tkType, tkVar, tkWhen, tkWhile, tkWith, tkWithout, 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, - tkOpr, tkComment, tkAccent, - tkSpaces, tkInfixOpr, tkPrefixOpr, tkPostfixOpr, - - TTokTypes* = set[TTokType] - -const +type + 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, + tkParRi, tkParDotRi, tkBracketRi, tkBracketDotRi, + tkCurlyRi} # \ + # 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", "atomic", - "bind", "block", "break", "case", "cast", - "const", "continue", "converter", "discard", "distinct", "div", "do", - "elif", "else", "end", "enum", "except", "export", - "finally", "for", "from", "generic", "if", - "import", "in", "include", "interface", "is", "isnot", "iterator", - "lambda", "let", - "macro", "method", "mixin", "mod", - "nil", "not", "notin", "object", "of", "or", - "out", "proc", "ptr", "raise", "ref", "return", - "shared", "shl", "shr", "static", - "template", - "try", "tuple", "type", "var", "when", "while", "with", "without", "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 + +type + NumericalBase* = enum base10, # base10 is listed as the first element, # so that it is the correct default value base2, base8, base16 - TToken* = object # a Nimrod token - tokType*: TTokType # the type of the token - indent*: int # the indentation; != -1 if the token has been - # preceeded 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 - literal*: string # the parsed (string) literal; and - # documentation comments are here too - - TLexer* = object of TBaseLexer - fileIdx*: int32 - indentAhead*: int # if > 0 an indendation has already been read - # this is needed because scanning comments - # needs so much look-ahead - -var gLinesCompiled*: int # all lines that have been compiled + 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 + commentOffsetA*, commentOffsetB*: int -proc isKeyword*(kind: TTokType): bool -proc openLexer*(lex: var TLexer, fileidx: int32, inputstream: PLLStream) -proc rawGetTok*(L: var TLexer, tok: var TToken) - # reads in the next token into tok and skips it -proc getColumn*(L: TLexer): int -proc getLineInfo*(L: TLexer): TLineInfo -proc closeLexer*(lex: var TLexer) -proc PrintTok*(tok: TToken) -proc tokToStr*(tok: TToken): string + ErrorHandler* = proc (conf: ConfigRef; info: TLineInfo; msg: TMsgKind; arg: string) + Lexer* = object of TBaseLexer + fileIdx*: FileIndex + indentAhead*: int # if > 0 an indentation has already been read + # this is needed because scanning comments + # needs so much look-ahead + currLineIndent*: int + errorHandler*: ErrorHandler + cache*: IdentCache + when defined(nimsuggest): + previousToken: TLineInfo + tokenEnd*: TLineInfo + previousTokenEnd*: TLineInfo + config*: ConfigRef -proc openLexer*(lex: var TLexer, filename: string, inputstream: PLLStream) = - OpenLexer(lex, filename.fileInfoIdx, inputStream) +proc getLineInfo*(L: Lexer, tok: Token): TLineInfo {.inline.} = + result = newLineInfo(L.fileIdx, tok.line, tok.col) + when defined(nimpretty): + result.offsetA = tok.offsetA + result.offsetB = tok.offsetB + result.commentOffsetA = tok.commentOffsetA + result.commentOffsetB = tok.commentOffsetB -proc lexMessage*(L: TLexer, msg: TMsgKind, arg = "") +proc isKeyword*(kind: TokType): bool = + (kind >= tokKeywordLow) and (kind <= tokKeywordHigh) -proc isKeyword(kind: TTokType): bool = - result = (kind >= tokKeywordLow) and (kind <= tokKeywordHigh) +template ones(n): untyped = ((1 shl n)-1) # for utf-8 conversion -proc isNimrodIdentifier*(s: string): bool = - if s[0] in SymStartChars: +proc isNimIdentifier*(s: string): bool = + let sLen = s.len + if sLen > 0 and s[0] in SymStartChars: var i = 1 - while i < s.len: - if s[i] == '_': - inc(i) - if s[i] notin SymChars: return - if s[i] notin SymChars: return + while i < sLen: + if s[i] == '_': inc(i) + 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 - else: - InternalError("tokToStr") - result = "" - -proc prettyTok*(tok: TToken): string = - if IsKeyword(tok.tokType): result = "keyword " & tok.ident.s - else: result = tokToStr(tok) - -proc PrintTok*(tok: TToken) = - write(stdout, TokTypeToStr[tok.tokType]) - write(stdout, " ") - writeln(stdout, tokToStr(tok)) - -var dummyIdent: PIdent - -proc initToken*(L: var TToken) = - L.TokType = tkInvalid - L.iNumber = 0 - L.Indent = 0 - L.literal = "" - L.fNumber = 0.0 - L.base = base10 - L.ident = dummyIdent - -proc fillToken(L: var TToken) = - L.TokType = tkInvalid - L.iNumber = 0 - L.Indent = 0 - setLen(L.literal, 0) - L.fNumber = 0.0 - L.base = base10 - L.ident = dummyIdent - -proc openLexer(lex: var TLexer, fileIdx: int32, inputstream: PLLStream) = + tok.ident.s + else: + "" + +proc prettyTok*(tok: Token): string = + if isKeyword(tok.tokType): "keyword " & tok.ident.s + else: $tok + +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 - inc(lex.Linenumber, inputstream.lineOffset) + lex.indentAhead = -1 + lex.currLineIndent = 0 + inc(lex.lineNumber, inputstream.lineOffset) + lex.cache = cache + when defined(nimsuggest): + lex.previousToken.fileIndex = fileIdx + lex.config = config + +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) = - inc(gLinesCompiled, lex.LineNumber) +proc closeLexer*(lex: var Lexer) = + if lex.config != nil: + inc(lex.config.linesCompiled, lex.lineNumber) closeBaseLexer(lex) -proc getColumn(L: TLexer): int = - result = getColNumber(L, L.bufPos) - -proc getLineInfo(L: TLexer): TLineInfo = - result = newLineInfo(L.fileIdx, L.linenumber, getColNumber(L, L.bufpos)) - -proc lexMessage(L: TLexer, msg: TMsgKind, arg = "") = - msgs.Message(getLineInfo(L), msg, arg) - -proc lexMessagePos(L: var TLexer, msg: TMsgKind, pos: int, arg = "") = - var info = newLineInfo(L.fileIdx, L.linenumber, pos - L.lineStart) - msgs.Message(info, msg, arg) - -proc matchUnderscoreChars(L: var TLexer, tok: var TToken, chars: TCharSet) = - var pos = L.bufpos # use registers for pos, buf - var buf = L.buf - while true: - if buf[pos] in chars: - add(tok.literal, buf[pos]) - Inc(pos) - else: - break - if buf[pos] == '_': - if buf[pos+1] notin chars: - lexMessage(L, errInvalidToken, "_") +proc getLineInfo(L: Lexer): TLineInfo = + result = newLineInfo(L.fileIdx, L.lineNumber, getColNumber(L, L.bufpos)) + +proc dispMessage(L: Lexer; info: TLineInfo; msg: TMsgKind; arg: string) = + if L.errorHandler.isNil: + msgs.message(L.config, info, msg, arg) + else: + L.errorHandler(L.config, info, msg, arg) + +proc lexMessage*(L: Lexer, msg: TMsgKind, arg = "") = + L.dispMessage(getLineInfo(L), msg, arg) + +proc lexMessageTok*(L: Lexer, msg: TMsgKind, tok: Token, arg = "") = + var info = newLineInfo(L.fileIdx, tok.line, tok.col) + L.dispMessage(info, msg, arg) + +proc lexMessagePos(L: var Lexer, msg: TMsgKind, pos: int, arg = "") = + var info = newLineInfo(L.fileIdx, L.lineNumber, pos - L.lineStart) + L.dispMessage(info, msg, arg) + +proc matchTwoChars(L: Lexer, first: char, second: set[char]): bool = + result = (L.buf[L.bufpos] == first) and (L.buf[L.bufpos + 1] in second) + +template tokenBegin(tok, pos) {.dirty.} = + when defined(nimsuggest): + var colA = getColNumber(L, pos) + when defined(nimpretty): + tok.offsetA = L.offsetBase + pos + +template tokenEnd(tok, pos) {.dirty.} = + when defined(nimsuggest): + 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.config.m.trackPos.col = colA.int16 + colA = 0 + when defined(nimpretty): + tok.offsetB = L.offsetBase + pos + +template tokenEndIgnore(tok, pos) = + when defined(nimsuggest): + 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.config.m.trackPos.fileIndex = trackPosInvalidFileIdx + L.config.m.trackPos.line = 0'u16 + colA = 0 + when defined(nimpretty): + tok.offsetB = L.offsetBase + pos + +template tokenEndPrevious(tok, pos) = + when defined(nimsuggest): + # when we detect the cursor in whitespace, we attach the track position + # to the token that came before that, but only if we haven't detected + # the cursor in a string literal or comment: + 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.config.m.trackPos = L.previousToken + L.config.m.trackPosAttached = true + colA = 0 + when defined(nimpretty): + tok.offsetB = L.offsetBase + pos + +template eatChar(L: var Lexer, t: var Token, replacementChar: char) = + t.literal.add(replacementChar) + inc(L.bufpos) + +template eatChar(L: var Lexer, t: var Token) = + t.literal.add(L.buf[L.bufpos]) + inc(L.bufpos) + +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 + result = 0 + while true: + if L.buf[pos] in chars: + tok.literal.add(L.buf[pos]) + inc(pos) + inc(result) + else: break - add(tok.literal, '_') - Inc(pos) - L.bufPos = pos - -proc matchTwoChars(L: TLexer, first: Char, second: TCharSet): bool = - result = (L.buf[L.bufpos] == first) and (L.buf[L.bufpos + 1] in Second) - -proc isFloatLiteral(s: string): bool = - for i in countup(0, len(s) - 1): - if s[i] in {'.', 'e', 'E'}: - return true - result = false - -proc GetNumber(L: var TLexer): TToken = - var - pos, endpos: int - xi: biggestInt - # get the base: + if L.buf[pos] == '_': + if L.buf[pos+1] notin chars: + lexMessage(L, errGenerated, + "only single underscores may occur in a token and token may not " & + "end with an underscore: e.g. '1__1' and '1_' are invalid") + break + tok.literal.add('_') + inc(pos) + L.bufpos = pos + + proc matchChars(L: var Lexer, tok: var Token, chars: set[char]) = + var pos = L.bufpos # use registers for pos, buf + while L.buf[pos] in chars: + tok.literal.add(L.buf[pos]) + inc(pos) + L.bufpos = pos + + proc lexMessageLitNum(L: var Lexer, msg: string, startpos: int, msgKind = errGenerated) = + # Used to get slightly human friendlier err messages. + const literalishChars = {'A'..'Z', 'a'..'z', '0'..'9', '_', '.', '\''} + var msgPos = L.bufpos + 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'}: + t.literal.add(L.buf[L.bufpos]) + inc(L.bufpos) + matchChars(L, t, literalishChars) + if L.buf[L.bufpos] in literalishChars: + t.literal.add(L.buf[L.bufpos]) + inc(L.bufpos) + matchChars(L, t, {'0'..'9'}) + L.bufpos = msgPos + lexMessage(L, msgKind, msg % t.literal) + + var + xi: BiggestInt + isBase10 = true + numDigits = 0 + const + # '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 # BUGFIX - pos = L.bufpos # make sure the literal is correct for error messages: - var eallowed = false - if L.buf[pos] == '0' and L.buf[pos+1] in {'X', 'x'}: - matchUnderscoreChars(L, result, {'A'..'F', 'a'..'f', '0'..'9', 'X', 'x'}) + result.base = base10 + tokenBegin(result, L.bufpos) + + var isPositive = true + if L.buf[L.bufpos] == '-': + eatChar(L, result) + isPositive = false + + let startpos = L.bufpos + + template setNumber(field, value) = + field = (if isPositive: value else: -value) + + # First stage: find out base, make verifications, build token literal string + # {'c', 'C'} is added for deprecation reasons to provide a clear error message + 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 an invalid int literal; For octal literals " & + "use the '0o' prefix.", startpos) + of 'x', 'X': + eatChar(L, result, 'x') + 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') + 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', 'b', 'B', 'o', 'c', 'C'}) - eallowed = true - if (L.buf[L.bufpos] == '.') and (L.buf[L.bufpos + 1] in {'0'..'9'}): - add(result.literal, '.') - inc(L.bufpos) - matchUnderscoreChars(L, result, {'0'..'9'}) - eallowed = true - if eallowed and L.buf[L.bufpos] in {'e', 'E'}: - add(result.literal, 'e') - inc(L.bufpos) - if L.buf[L.bufpos] in {'+', '-'}: - add(result.literal, L.buf[L.bufpos]) - inc(L.bufpos) - matchUnderscoreChars(L, result, {'0'..'9'}) - endpos = L.bufpos - if L.buf[endpos] in {'\'', 'f', 'F', 'i', 'I', 'u', 'U'}: - if L.buf[endpos] == '\'': inc(endpos) - L.bufpos = pos # restore position - case L.buf[endpos] - of 'f', 'F': - inc(endpos) - if (L.buf[endpos] == '3') and (L.buf[endpos + 1] == '2'): - result.tokType = tkFloat32Lit - inc(endpos, 2) - elif (L.buf[endpos] == '6') and (L.buf[endpos + 1] == '4'): - result.tokType = tkFloat64Lit - inc(endpos, 2) - elif (L.buf[endpos] == '1') and - (L.buf[endpos + 1] == '2') and - (L.buf[endpos + 2] == '8'): - result.tokType = tkFloat128Lit - inc(endpos, 3) - else: - lexMessage(L, errInvalidNumber, result.literal & "'f" & L.buf[endpos]) - of 'i', 'I': - inc(endpos) - if (L.buf[endpos] == '6') and (L.buf[endpos + 1] == '4'): - result.tokType = tkInt64Lit - inc(endpos, 2) - elif (L.buf[endpos] == '3') and (L.buf[endpos + 1] == '2'): - result.tokType = tkInt32Lit - inc(endpos, 2) - elif (L.buf[endpos] == '1') and (L.buf[endpos + 1] == '6'): - result.tokType = tkInt16Lit - inc(endpos, 2) - elif (L.buf[endpos] == '8'): - result.tokType = tkInt8Lit - inc(endpos) - else: - lexMessage(L, errInvalidNumber, result.literal & "'i" & L.buf[endpos]) - of 'u', 'U': - inc(endpos) - if (L.buf[endpos] == '6') and (L.buf[endpos + 1] == '4'): - result.tokType = tkUInt64Lit - inc(endpos, 2) - elif (L.buf[endpos] == '3') and (L.buf[endpos + 1] == '2'): - result.tokType = tkUInt32Lit - inc(endpos, 2) - elif (L.buf[endpos] == '1') and (L.buf[endpos + 1] == '6'): - result.tokType = tkUInt16Lit - inc(endpos, 2) - elif (L.buf[endpos] == '8'): - result.tokType = tkUInt8Lit - inc(endpos) + 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, '.') + discard matchUnderscoreChars(L, result, {'0'..'9'}) + if L.buf[L.bufpos] in {'e', 'E'}: + result.tokType = tkFloatLit + eatChar(L, result) + if L.buf[L.bufpos] in {'+', '-'}: + eatChar(L, result) + 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 + + 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 - else: lexMessage(L, errInvalidNumber, result.literal & "'" & L.buf[endpos]) - else: - L.bufpos = pos # restore position - try: - if (L.buf[pos] == '0') and - (L.buf[pos + 1] in {'x', 'X', 'b', 'B', 'o', 'O', 'c', 'C'}): - inc(pos, 2) - xi = 0 # it may be a base prefix - case L.buf[pos - 1] # now look at the optional type suffix: - of 'b', 'B': - result.base = base2 - while true: - case L.buf[pos] - of 'A'..'Z', 'a'..'z', '2'..'9', '.': - lexMessage(L, errInvalidNumber, result.literal) - inc(pos) - of '_': - if L.buf[pos+1] notin {'0'..'1'}: - lexMessage(L, errInvalidToken, "_") - break - inc(pos) - of '0', '1': - xi = `shl`(xi, 1) or (ord(L.buf[pos]) - ord('0')) - inc(pos) - else: break - of 'o', 'c', 'C': - result.base = base8 - while true: - case L.buf[pos] - of 'A'..'Z', 'a'..'z', '8'..'9', '.': - lexMessage(L, errInvalidNumber, result.literal) - inc(pos) - of '_': - if L.buf[pos+1] notin {'0'..'7'}: - lexMessage(L, errInvalidToken, "_") - break - inc(pos) - of '0'..'7': - xi = `shl`(xi, 3) or (ord(L.buf[pos]) - ord('0')) + lexMessageLitNum(L, "invalid number suffix: '$1'", errPos) + else: + 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) + + 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) - else: break - of 'O': - lexMessage(L, errInvalidNumber, result.literal) - of 'x', 'X': - result.base = base16 - while true: - case L.buf[pos] - of 'G'..'Z', 'g'..'z': - lexMessage(L, errInvalidNumber, result.literal) + # '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 '_': - if L.buf[pos+1] notin {'0'..'9', 'a'..'f', 'A'..'F'}: - lexMessage(L, errInvalidToken, "_") + 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 - 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(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(toU16(int(xi))) - of tkInt32Lit: result.iNumber = biggestInt(toU32(xi)) - of tkUIntLit, tkUInt64Lit: result.iNumber = xi - of tkUInt8Lit: result.iNumber = biggestInt(int8(toU8(int(xi)))) - of tkUInt16Lit: result.iNumber = biggestInt(toU16(int(xi))) - of tkUInt32Lit: result.iNumber = biggestInt(toU32(xi)) - of tkFloat32Lit: - result.fNumber = (cast[PFloat32](addr(xi)))[] - # note: this code is endian neutral! - # XXX: Test this on big endian machine! - of tkFloat64Lit: result.fNumber = (cast[PFloat64](addr(xi)))[] - else: InternalError(getLineInfo(L), "getNumber") - elif isFloatLiteral(result.literal) or (result.tokType == tkFloat32Lit) or - (result.tokType == tkFloat64Lit): - result.fnumber = parseFloat(result.literal) - if result.tokType == tkIntLit: result.tokType = tkFloatLit - else: - result.iNumber = ParseBiggestInt(result.literal) - if (result.iNumber < low(int32)) or (result.iNumber > high(int32)): - if result.tokType == tkIntLit: + 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: + 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: + lexMessageLitNum(L, "number out of range: '$1'", startpos) + + # Promote int literal to int64? Not always necessary, but more consistent + if result.tokType == tkIntLit: + if result.iNumber > high(int32) or result.iNumber < low(int32): result.tokType = tkInt64Lit - elif result.tokType != tkInt64Lit: - lexMessage(L, errInvalidNumber, result.literal) - except EInvalidValue: - lexMessage(L, errInvalidNumber, result.literal) - except EOverflow, EOutOfRange: - lexMessage(L, errNumberOutOfRange, result.literal) - L.bufpos = endpos - -proc handleHexChar(L: var TLexer, xi: var int) = + + 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 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': + of '0'..'9': xi = (xi shl 4) or (ord(L.buf[L.bufpos]) - ord('0')) inc(L.bufpos) - of 'a'..'f': + of 'a'..'f': xi = (xi shl 4) or (ord(L.buf[L.bufpos]) - ord('a') + 10) inc(L.bufpos) - of 'A'..'F': + of 'A'..'F': xi = (xi shl 4) or (ord(L.buf[L.bufpos]) - ord('A') + 10) inc(L.bufpos) - else: nil + 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) = - while L.buf[L.bufpos] in {'0'..'9'}: +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 tok.toktype == tkCharLit: lexMessage(L, errNnotAllowedInCharacter) - add(tok.literal, tnl) - Inc(L.bufpos) - of 'r', 'R', 'c', 'C': - add(tok.literal, CR) - Inc(L.bufpos) - of 'l', 'L': - add(tok.literal, LF) - Inc(L.bufpos) - of 'f', 'F': - add(tok.literal, FF) + of 'n', 'N': + tok.literal.add('\L') + inc(L.bufpos) + of 'p', 'P': + if tok.tokType == tkCharLit: + lexMessage(L, errGenerated, "\\p not allowed in character literal") + tok.literal.add(L.config.target.tnl) + inc(L.bufpos) + of 'r', 'R', 'c', 'C': + tok.literal.add(CR) inc(L.bufpos) - of 'e', 'E': - add(tok.literal, ESC) - Inc(L.bufpos) - of 'a', 'A': - add(tok.literal, BEL) - Inc(L.bufpos) - of 'b', 'B': - add(tok.literal, BACKSPACE) - Inc(L.bufpos) - of 'v', 'V': - add(tok.literal, VT) - Inc(L.bufpos) - of 't', 'T': - add(tok.literal, Tabulator) - Inc(L.bufpos) - of '\'', '\"': - add(tok.literal, L.buf[L.bufpos]) - Inc(L.bufpos) - of '\\': - add(tok.literal, '\\') - Inc(L.bufpos) - of 'x', 'X': + of 'l', 'L': + tok.literal.add(LF) + inc(L.bufpos) + of 'f', 'F': + tok.literal.add(FF) + inc(L.bufpos) + of 'e', 'E': + tok.literal.add(ESC) + inc(L.bufpos) + of 'a', 'A': + tok.literal.add(BEL) + inc(L.bufpos) + of 'b', 'B': + tok.literal.add(BACKSPACE) + inc(L.bufpos) + of 'v', 'V': + tok.literal.add(VT) + inc(L.bufpos) + of 't', 'T': + tok.literal.add('\t') + inc(L.bufpos) + of '\'', '\"': + tok.literal.add(L.buf[L.bufpos]) + inc(L.bufpos) + of '\\': + tok.literal.add('\\') + inc(L.bufpos) + of 'x', 'X': inc(L.bufpos) var xi = 0 - handleHexChar(L, xi) - handleHexChar(L, xi) - add(tok.literal, Chr(xi)) - of '0'..'9': - if matchTwoChars(L, '0', {'0'..'9'}): + 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: + 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)) - else: lexMessage(L, errInvalidCharacterConstant) - else: lexMessage(L, errInvalidCharacterConstant) + 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) - - if optEmbedOrigSrc in gGlobalOptions: - let lineStart = cast[TAddress](L.buf) + L.lineStart - let line = newString(cast[cstring](lineStart), col) - addSourceLine(L.fileIdx, line) - + case L.buf[pos] of CR: registerLine() - result = nimlexbase.HandleCR(L, pos) + result = nimlexbase.handleCR(L, pos) of LF: registerLine() - result = nimlexbase.HandleLF(L, pos) + result = nimlexbase.handleLF(L, pos) else: result = pos - -proc getString(L: var TLexer, tok: var TToken, rawMode: bool) = - var pos = L.bufPos + 1 # skip " - var buf = L.buf # put `buf` in a register - var line = L.linenumber # save linenumber for better error message - if buf[pos] == '\"' and buf[pos+1] == '\"': + +type + StringMode = enum + normal, + raw, + generalized + +proc getString(L: var Lexer, tok: var Token, mode: StringMode) = + var pos = L.bufpos + var line = L.lineNumber # save linenumber for better error message + tokenBegin(tok, pos - ord(mode == raw)) + inc pos # skip " + if L.buf[pos] == '\"' and L.buf[pos+1] == '\"': tok.tokType = tkTripleStrLit # long string literal: inc(pos, 2) # skip "" # skip leading newline: - pos = HandleCRLF(L, pos) - buf = L.buf - while true: - case buf[pos] - of '\"': - if buf[pos+1] == '\"' and buf[pos+2] == '\"' and - buf[pos+3] != '\"': + if L.buf[pos] in {' ', '\t'}: + var newpos = pos+1 + while L.buf[newpos] in {' ', '\t'}: inc newpos + if L.buf[newpos] in {CR, LF}: pos = newpos + pos = handleCRLF(L, pos) + while true: + case L.buf[pos] + of '\"': + 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, '\"') - Inc(pos) - of CR, LF: - pos = HandleCRLF(L, pos) - buf = L.buf - add(tok.literal, tnl) - of nimlexbase.EndOfFile: - var line2 = L.linenumber - L.LineNumber = line - lexMessagePos(L, errClosingTripleQuoteExpected, L.lineStart) - L.LineNumber = line2 - break - else: - add(tok.literal, buf[pos]) - Inc(pos) - else: + break + tok.literal.add('\"') + inc(pos) + of CR, LF: + tokenEndIgnore(tok, pos) + pos = handleCRLF(L, pos) + tok.literal.add("\n") + of nimlexbase.EndOfFile: + tokenEndIgnore(tok, pos) + var line2 = L.lineNumber + L.lineNumber = line + lexMessagePos(L, errGenerated, L.lineStart, "closing \"\"\" expected, but end of file reached") + L.lineNumber = line2 + L.bufpos = pos + break + else: + 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] - if c == '\"': - if rawMode and buf[pos+1] == '\"': + while true: + let c = L.buf[pos] + if c == '\"': + if mode != normal and L.buf[pos+1] == '\"': inc(pos, 2) - add(tok.literal, '"') + tok.literal.add('"') else: + tokenEndIgnore(tok, pos) inc(pos) # skip '"' break - elif c in {CR, LF, nimlexbase.EndOfFile}: - lexMessage(L, errClosingQuoteExpected) - break - elif (c == '\\') and not rawMode: - L.bufPos = pos + elif c in {CR, LF, nimlexbase.EndOfFile}: + tokenEndIgnore(tok, pos) + lexMessage(L, errGenerated, "closing \" expected") + break + elif (c == '\\') and mode == normal: + L.bufpos = pos getEscapedChar(L, tok) - pos = L.bufPos - else: - add(tok.literal, c) - Inc(pos) + pos = L.bufpos + else: + tok.literal.add(c) + inc(pos) L.bufpos = pos -proc getCharacter(L: var TLexer, tok: var TToken) = - Inc(L.bufpos) # skip ' - var c = L.buf[L.bufpos] +proc getCharacter(L: var Lexer; tok: var Token) = + tokenBegin(tok, L.bufpos) + let startPos = L.bufpos + inc(L.bufpos) # skip ' + let c = L.buf[L.bufpos] case c - of '\0'..Pred(' '), '\'': lexMessage(L, errInvalidCharacterConstant) + of '\0'..pred(' '), '\'': + lexMessage(L, errGenerated, "invalid character literal") + tok.literal = $c of '\\': getEscapedChar(L, tok) - else: + else: tok.literal = $c - Inc(L.bufpos) - if L.buf[L.bufpos] != '\'': lexMessage(L, errMissingFinalQuote) - inc(L.bufpos) # skip ' - -proc getSymbol(L: var TLexer, tok: var TToken) = - var h: THash = 0 + inc(L.bufpos) + if L.buf[L.bufpos] == '\'': + tokenEndIgnore(tok, L.bufpos) + inc(L.bufpos) # skip ' + else: + if startPos > 0 and L.buf[startPos-1] == '`': + tok.literal = "'" + L.bufpos = startPos+1 + else: + lexMessage(L, errGenerated, "missing closing ' for character literal") + tokenEndIgnore(tok, L.bufpos) + +const + UnicodeOperatorStartChars = {'\226', '\194', '\195'} + # the allowed unicode characters ("∙ ∘ × ★ ⊗ ⊘ ⊙ ⊛ ⊠ ⊡ ∩ ∧ ⊓ ± ⊕ ⊖ ⊞ ⊟ ∪ ∨ ⊔") + # all start with one of these. + +type + UnicodeOprPred = enum + Mul, Add + +proc unicodeOprLen(buf: cstring; pos: int): (int8, UnicodeOprPred) = + template m(len): untyped = (int8(len), Mul) + template a(len): untyped = (int8(len), Add) + result = 0.m + case buf[pos] + of '\226': + if buf[pos+1] == '\136': + if buf[pos+2] == '\152': result = 3.m # ∘ + elif buf[pos+2] == '\153': result = 3.m # ∙ + elif buf[pos+2] == '\167': result = 3.m # ∧ + elif buf[pos+2] == '\168': result = 3.a # ∨ + elif buf[pos+2] == '\169': result = 3.m # ∩ + elif buf[pos+2] == '\170': result = 3.a # ∪ + elif buf[pos+1] == '\138': + if buf[pos+2] == '\147': result = 3.m # ⊓ + elif buf[pos+2] == '\148': result = 3.a # ⊔ + elif buf[pos+2] == '\149': result = 3.a # ⊕ + elif buf[pos+2] == '\150': result = 3.a # ⊖ + elif buf[pos+2] == '\151': result = 3.m # ⊗ + elif buf[pos+2] == '\152': result = 3.m # ⊘ + elif buf[pos+2] == '\153': result = 3.m # ⊙ + elif buf[pos+2] == '\155': result = 3.m # ⊛ + elif buf[pos+2] == '\158': result = 3.a # ⊞ + elif buf[pos+2] == '\159': result = 3.a # ⊟ + elif buf[pos+2] == '\160': result = 3.m # ⊠ + elif buf[pos+2] == '\161': result = 3.m # ⊡ + elif buf[pos+1] == '\152' and buf[pos+2] == '\133': result = 3.m # ★ + of '\194': + if buf[pos+1] == '\177': result = 2.a # ± + of '\195': + if buf[pos+1] == '\151': result = 2.m # × + else: + discard + +proc getSymbol(L: var Lexer, tok: var Token) = + var h: Hash = 0 var pos = L.bufpos - var buf = L.buf - while true: - var c = buf[pos] + tokenBegin(tok, pos) + var suspicious = false + while true: + var c = L.buf[pos] case c - of 'a'..'z', '0'..'9', '\x80'..'\xFF': + of 'a'..'z', '0'..'9': h = h !& ord(c) - of 'A'..'Z': + 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: - lexMessage(L, errInvalidToken, "_") + if L.buf[pos+1] notin SymChars: + lexMessage(L, errGenerated, "invalid token: trailing underscore") break - else: break - Inc(pos) + 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 = 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.ident.id > ord(tokKeywordHigh) - ord(tkSymbol)): tok.tokType = tkSymbol - else: - tok.tokType = TTokType(tok.ident.id + ord(tkSymbol)) - -proc endOperator(L: var TLexer, tok: var TToken, pos: int, - hash: THash) {.inline.} = + else: + tok.tokType = TokType(tok.ident.id + ord(tkSymbol)) + if suspicious and {optStyleHint, optStyleError} * L.config.globalOptions != {}: + lintReport(L.config, getLineInfo(L), tok.ident.s.normalize, tok.ident.s) + L.bufpos = pos + + +proc endOperator(L: var Lexer, tok: var Token, pos: int, + hash: Hash) {.inline.} = var h = !$hash - tok.ident = 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 - var h: THash = 0 - while true: - var c = buf[pos] - if c notin OpChars: break - h = h !& Ord(c) - Inc(pos) + tokenBegin(tok, pos) + var h: Hash = 0 + while true: + 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.spacing = tok.spacing - {tsTrailing, tsEof} + var trailing = false + while L.buf[pos] == ' ': + inc pos + 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 scanComment(L: var TLexer, tok: var TToken) = +proc skipMultiLineComment(L: var Lexer; tok: var Token; start: int; + isDoc: bool) = + var pos = start + var toStrip = 0 + tokenBegin(tok, pos) + # detect the amount of indentation: + if isDoc: + toStrip = getColNumber(L, pos) + while L.buf[pos] == ' ': + inc pos + inc toStrip + while L.buf[pos] in {CR, LF}: # skip blank lines + pos = handleCRLF(L, pos) + toStrip = 0 + while L.buf[pos] == ' ': + inc pos + inc toStrip + var nesting = 0 + while true: + case L.buf[pos] + of '#': + if isDoc: + if L.buf[pos+1] == '#' and L.buf[pos+2] == '[': + inc nesting + tok.literal.add '#' + elif L.buf[pos+1] == '[': + inc nesting + inc pos + of ']': + if isDoc: + 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 L.buf[pos+1] == '#': + if nesting == 0: + tokenEndIgnore(tok, pos+1) + inc(pos, 2) + break + dec nesting + inc pos + of CR, LF: + tokenEndIgnore(tok, pos) + pos = handleCRLF(L, pos) + # strip leading whitespace: + when defined(nimpretty): tok.literal.add "\L" + if isDoc: + when not defined(nimpretty): tok.literal.add "\n" + var c = toStrip + while L.buf[pos] == ' ' and c > 0: + inc pos + dec c + of nimlexbase.EndOfFile: + tokenEndIgnore(tok, pos) + lexMessagePos(L, errGenerated, pos, "end of multiline comment expected") + break + else: + 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 Lexer, tok: var Token) = var pos = L.bufpos - var buf = L.buf - # a comment ends if the next line does not start with the # on the same - # column after only whitespace tok.tokType = tkComment - # iNumber contains the number of '\n' in the token - tok.iNumber = 0 - var col = getColNumber(L, pos) + assert L.buf[pos+1] == '#' + when defined(nimpretty): + tok.commentOffsetA = L.offsetBase + pos + + if L.buf[pos+2] == '[': + skipMultiLineComment(L, tok, pos+3, true) + return + tokenBegin(tok, pos) + inc(pos, 2) + + var toStrip = 0 + 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) - if lastBackslash > 0: - # a backslash is a continuation character if only followed by spaces - # plus a newline: - while buf[lastBackslash] == ' ': inc(lastBackslash) - if buf[lastBackslash] notin {CR, LF, nimlexbase.EndOfFile}: - # false positive: - lastBackslash = -1 - + 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 (col == indent or lastBackslash > 0): + + if L.buf[pos] == '#' and L.buf[pos+1] == '#': tok.literal.add "\n" - col = indent - inc tok.iNumber + inc(pos, 2) + 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 L.bufpos = pos + 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.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) - of Tabulator: - lexMessagePos(L, errTabulatorsAreNotAllowed, pos) + inc(pos) + tok.spacing.incl(tsLeading) + of '\t': + lexMessagePos(L, errGenerated, pos, "tabs are not allowed, use spaces instead") inc(pos) of CR, LF: - pos = HandleCRLF(L, pos) - buf = L.buf + tokenEndPrevious(tok, pos) + pos = handleCRLF(L, pos) var indent = 0 - while buf[pos] == ' ': - Inc(pos) - Inc(indent) - if buf[pos] > ' ': + while true: + if L.buf[pos] == ' ': + inc(pos) + inc(indent) + 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 + else: + break + 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 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 + else: + tokenBegin(tok, 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 else: break # EndOfFile also leaves the loop + tokenEndPrevious(tok, pos-1) L.bufpos = pos + when defined(nimpretty): + if hasComment: + tok.commentOffsetB = L.offsetBase + pos - 1 + tok.tokType = tkComment + tok.indent = commentIndent + +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 -proc rawGetTok(L: var TLexer, tok: var TToken) = - fillToken(tok) + reset(tok) if L.indentAhead >= 0: tok.indent = L.indentAhead + L.currLineIndent = L.indentAhead L.indentAhead = -1 else: tok.indent = -1 skip(L, tok) - var c = L.buf[L.bufpos] - if c in SymStartChars - {'r', 'R', 'l'}: + when defined(nimpretty): + if tok.tokType == tkComment: + L.indentAhead = L.currLineIndent + return + let c = L.buf[L.bufpos] + tok.line = L.lineNumber + tok.col = getColNumber(L, L.bufpos) + if c in SymStartChars - {'r', 'R'} - UnicodeOperatorStartChars: getSymbol(L, tok) else: case c - of '#': + of UnicodeOperatorStartChars: + if unicodeOprLen(L.buf, L.bufpos)[0] != 0: + getOperator(L, tok) + else: + getSymbol(L, tok) + of '#': scanComment(L, tok) of '*': - # '*:' is unfortunately a special case, because it is two tokens in + # '*:' is unfortunately a special case, because it is two tokens in # 'var v*: int'. if L.buf[L.bufpos+1] == ':' and L.buf[L.bufpos+2] notin OpChars: var h = 0 !& ord('*') @@ -717,73 +1219,91 @@ proc rawGetTok(L: var TLexer, tok: var TToken) = else: getOperator(L, tok) of ',': - tok.toktype = tkComma - Inc(L.bufpos) - of 'l': - # if we parsed exactly one character and its a small L (l), this - # is treated as a warning because it may be confused with the number 1 - if L.buf[L.bufpos+1] notin (SymChars + {'_'}): - lexMessage(L, warnSmallLshouldNotBeUsed) - getSymbol(L, tok) + tok.tokType = tkComma + inc(L.bufpos) of 'r', 'R': - if L.buf[L.bufPos + 1] == '\"': - Inc(L.bufPos) - getString(L, tok, true) - else: + if L.buf[L.bufpos + 1] == '\"': + inc(L.bufpos) + getString(L, tok, raw) + else: getSymbol(L, tok) - of '(': - Inc(L.bufpos) - if L.buf[L.bufPos] == '.' and L.buf[L.bufPos+1] != '.': - tok.toktype = tkParDotLe - Inc(L.bufpos) - else: - tok.toktype = tkParLe - of ')': - tok.toktype = tkParRi - Inc(L.bufpos) - of '[': - Inc(L.bufpos) - if L.buf[L.bufPos] == '.' and L.buf[L.bufPos+1] != '.': - tok.toktype = tkBracketDotLe - Inc(L.bufpos) + of '(': + inc(L.bufpos) + if L.buf[L.bufpos] == '.' and L.buf[L.bufpos+1] != '.': + tok.tokType = tkParDotLe + inc(L.bufpos) + else: + tok.tokType = tkParLe + when defined(nimsuggest): + if L.fileIdx == L.config.m.trackPos.fileIndex and tok.col < L.config.m.trackPos.col and + tok.line == L.config.m.trackPos.line.int and L.config.ideCmd == ideCon: + L.config.m.trackPos.col = tok.col.int16 + of ')': + tok.tokType = tkParRi + inc(L.bufpos) + of '[': + inc(L.bufpos) + if L.buf[L.bufpos] == '.' and L.buf[L.bufpos+1] != '.': + tok.tokType = tkBracketDotLe + inc(L.bufpos) + elif L.buf[L.bufpos] == ':': + tok.tokType = tkBracketLeColon + inc(L.bufpos) else: - tok.toktype = tkBracketLe + tok.tokType = tkBracketLe of ']': - tok.toktype = tkBracketRi - Inc(L.bufpos) + tok.tokType = tkBracketRi + inc(L.bufpos) of '.': - if L.buf[L.bufPos+1] == ']': + when defined(nimsuggest): + 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.config.m.trackPos.col = tok.col.int16 + inc(L.bufpos) + atTokenEnd() + return + if L.buf[L.bufpos+1] == ']': tok.tokType = tkBracketDotRi - Inc(L.bufpos, 2) - elif L.buf[L.bufPos+1] == '}': + inc(L.bufpos, 2) + elif L.buf[L.bufpos+1] == '}': tok.tokType = tkCurlyDotRi - Inc(L.bufpos, 2) - elif L.buf[L.bufPos+1] == ')': + inc(L.bufpos, 2) + elif L.buf[L.bufpos+1] == ')': tok.tokType = tkParDotRi - Inc(L.bufpos, 2) - else: + inc(L.bufpos, 2) + else: getOperator(L, tok) - of '{': - Inc(L.bufpos) - if L.buf[L.bufPos] == '.' and L.buf[L.bufPos+1] != '.': - tok.toktype = tkCurlyDotLe - Inc(L.bufpos) - else: - tok.toktype = tkCurlyLe - of '}': - tok.toktype = tkCurlyRi - Inc(L.bufpos) - of ';': - tok.toktype = tkSemiColon - Inc(L.bufpos) - of '`': + of '{': + inc(L.bufpos) + if L.buf[L.bufpos] == '.' and L.buf[L.bufpos+1] != '.': + tok.tokType = tkCurlyDotLe + inc(L.bufpos) + else: + tok.tokType = tkCurlyLe + of '}': + tok.tokType = tkCurlyRi + inc(L.bufpos) + of ';': + tok.tokType = tkSemiColon + inc(L.bufpos) + of '`': tok.tokType = tkAccent - Inc(L.bufpos) - 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: + inc(L.bufpos) + of '_': + inc(L.bufpos) + if L.buf[L.bufpos] notin SymChars+{'_'}: + tok.tokType = tkSymbol + tok.ident = L.cache.getIdent("_") + else: + tok.literal = $c + tok.tokType = tkInvalid + lexMessage(L, errGenerated, "invalid token: " & c & " (\\" & $(ord(c)) & ')') + of '\"': + # check for generalized raw string literal: + let mode = if L.bufpos > 0 and L.buf[L.bufpos-1] in SymChars: generalized else: normal + getString(L, tok, mode) + if mode == generalized: # tkRStrLit -> tkGStrLit # tkTripleStrLit -> tkGTripleStrLit inc(tok.tokType, 2) @@ -792,17 +1312,66 @@ proc rawGetTok(L: var TLexer, tok: var TToken) = getCharacter(L, tok) tok.tokType = tkCharLit of '0'..'9': - tok = getNumber(L) + 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") + 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: + if c in OpChars: getOperator(L, tok) elif c == nimlexbase.EndOfFile: - tok.toktype = tkEof + tok.tokType = tkEof tok.indent = 0 else: tok.literal = $c tok.tokType = tkInvalid - lexMessage(L, errInvalidToken, c & " (\\" & $(ord(c)) & ')') - Inc(L.bufpos) - -dummyIdent = getIdent("") + lexMessage(L, errGenerated, "invalid token: " & c & " (\\" & $(ord(c)) & ')') + inc(L.bufpos) + atTokenEnd() + +proc getIndentWidth*(fileIdx: FileIndex, inputstream: PLLStream; + cache: IdentCache; config: ConfigRef): int = + result = 0 + var lex: Lexer = default(Lexer) + var tok: Token = default(Token) + openLexer(lex, fileIdx, inputstream, cache, config) + var prevToken = tkEof + while tok.tokType != tkEof: + rawGetTok(lex, tok) + 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 new file mode 100644 index 000000000..aaa0707e0 --- /dev/null +++ b/compiler/liftlocals.nim @@ -0,0 +1,76 @@ +# +# +# 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 '.liftLocals' pragma. + +import + options, ast, msgs, + idents, renderer, types, lowerings, lineinfos + +import std/strutils + +from pragmas import getPragmaVal +from wordrecg import wLiftLocals + +type + Ctx = object + 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, c.idgen) + var deref = newNodeI(nkHiddenDeref, info) + deref.typ = c.objType + deref.add(newSymNode(c.partialParam, info)) + result = newNodeI(nkDotExpr, info) + result.add(deref) + result.add(newSymNode(field)) + result.typ = field.typ + +proc liftLocals(n: PNode; i: int; c: var Ctx) = + let it = n[i] + case it.kind + of nkSym: + if interestingVar(it.sym): + n[i] = lookupOrAdd(c, it.sym, it.info) + of procDefs, nkTypeSection, nkMixinStmt, nkBindStmt: discard + else: + 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: + 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; + idgen: IdGenerator): PNode = + let liftDest = getPragmaVal(prc.ast, wLiftLocals) + if liftDest == nil: return n + let partialParam = lookupParam(prc.typ.n, liftDest) + if partialParam.isNil: + localError(conf, liftDest.info, "'$1' is not a parameter of '$2'" % + [$liftDest, prc.name.s]) + return n + let objType = partialParam.typ.skipTypes(abstractPtrs) + if objType.kind != tyObject or tfPartial notin objType.flags: + localError(conf, liftDest.info, "parameter '$1' is not a pointer to a partial object" % $liftDest) + return n + 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 new file mode 100644 index 000000000..94a483299 --- /dev/null +++ b/compiler/lineinfos.nim @@ -0,0 +1,357 @@ +# +# +# The Nim Compiler +# (c) Copyright 2018 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## This module contains the `TMsgKind` enum as well as the +## `TLineInfo` object. + +import ropes, pathutils +import std/[hashes, tables] + +const + 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 + # fatal errors + errUnknown, errFatal, errInternal, + # non-fatal errors + errIllFormedAstX, errCannotOpenFile, + errXExpected, + errRstMissingClosing, + errRstGridTableNotImplemented, + errRstMarkdownIllformedTable, + errRstIllformedTable, + errRstNewSectionExpected, + errRstGeneralParseError, + errRstInvalidDirectiveX, + errRstInvalidField, + errRstFootnoteMismatch, + errRstSandboxedDirective, + errProveInit, # deadcode + errGenerated, + errFailedMove, + errUser, + # warnings + warnCannotOpenFile = "CannotOpenFile", warnOctalEscape = "OctalEscape", + warnXIsNeverRead = "XIsNeverRead", warnXmightNotBeenInit = "XmightNotBeenInit", + warnDeprecated = "Deprecated", warnConfigDeprecated = "ConfigDeprecated", + warnDotLikeOps = "DotLikeOps", + warnSmallLshouldNotBeUsed = "SmallLshouldNotBeUsed", warnUnknownMagic = "UnknownMagic", + 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", + 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", + warnConfigDeprecated: "config file '$1' is deprecated", + warnDotLikeOps: "$1", + warnSmallLshouldNotBeUsed: "'l' should not be used as an identifier; may look like '1' (one)", + warnUnknownMagic: "unknown magic '$1' might crash the compiler", + warnRstRedefinitionOfLabel: "redefinition of label '$1'", + warnRstUnknownSubstitutionX: "unknown substitution '$1'", + 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: "", # deadcode + warnUseBase: "use {.base.} for base methods; baseless methods are deprecated", + warnWriteToForeignHeap: "write to foreign heap", + warnUnsafeCode: "unsafe code: '$1'", + warnUnusedImportX: "imported and not used: '$1'", + warnInheritFromException: "inherit from a more precise exception type like ValueError, " & + "IOError or OSError. If these don't suit, inherit from CatchableError or Defect.", + warnEachIdentIsTuple: "each identifier is a tuple", + warnUnsafeSetLen: "setLen can potentially expand the sequence, " & + "but the element type '$1' doesn't have a valid default value", + warnUnsafeDefault: "The '$1' type doesn't have a valid default value", + warnProveInit: "Cannot prove that '$1' is initialized. This will become a compile time error in the future.", + warnProveField: "cannot prove that field '$1' is accessible", + warnProveIndex: "cannot prove index '$1' is valid", + warnUnreachableElse: "unreachable else, all cases are already covered", + warnUnreachableCode: "unreachable code after 'return' statement or '{.noReturn.}' proc", + warnStaticIndexCheck: "$1", + warnGcUnsafe: "not GC-safe: '$1'", + warnGcUnsafe2: "$1", + warnUninit: "use explicit initialization of '$1' for clarity", + warnGcMem: "'$1' uses GC'ed memory", + warnDestructor: "usage of a type with a destructor in a non destructible context. This will become a compile time error in the future.", + warnLockLevel: "$1", # deadcode + warnResultShadowed: "Special variable 'result' is shadowed.", + warnInconsistentSpacing: "Number of spaces around '$#' is not consistent", + warnCaseTransition: "Potential object case transition, instantiate new object instead", + warnCycleCreated: "$1", + warnObservableStores: "observable stores to '$1'", + warnStrictNotNil: "$1", + warnResultUsed: "used 'result' variable", + warnCannotOpen: "cannot open: $1", + warnFileChanged: "file changed: $1", + warnSuspiciousEnumConv: "$1", + warnAnyEnumConv: "$1", + warnHoleEnumConv: "$1", + warnCstringConv: "$1", + warnPtrToCstringConv: "unsafe conversion to 'cstring' from '$1'; Use a `cast` operation like `cast[cstring](x)`; this will become a compile time error in the future", + warnEffect: "$1", + warnCastSizes: "$1", # deadcode + warnAboveMaxSizeSet: "$1", + warnImplicitTemplateRedefinition: "template '$1' is implicitly redefined; this is deprecated, add an explicit .redefine pragma", + warnUnnamedBreak: "Using an unnamed break in a block is deprecated; Use a named block with a named break instead", + warnStmtListLambda: "statement list expression assumed to be anonymous proc; this is deprecated, use `do (): ...` or `proc () = ...` instead", + warnBareExcept: "$1", + warnImplicitDefaultValue: "$1", + warnIgnoredSymbolInjection: "$1", + warnStdPrefix: "$1 needs the 'std' prefix", + warnUser: "$1", + warnGlobalVarConstructorTemporary: "global variable '$1' initialization requires a temporary variable", + hintSuccess: "operation successful: $#", + # keep in sync with `testament.isSuccess` + hintSuccessX: "$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'", + hintConditionAlwaysFalse: "condition is always false: '$1'", + hintName: "$1", + hintPattern: "$1", + hintExecuting: "$1", + hintLinking: "$1", + hintDependency: "$1", + hintSource: "$1", + hintPerformance: "$1", + hintStackTrace: "$1", + hintGCStats: "$1", + hintGlobalVar: "global variable declared here", + hintExpandMacro: "expanded macro: $1", + hintUser: "$1", + hintUserRaw: "$1", + hintExtendedContext: "$1", + hintMsgOrigin: "$1", + hintDeclaredLoc: "$1", + hintUnknownHint: "unknown hint: $1" + ] + +const + fatalMsgs* = {errUnknown..errInternal} + errMin* = errUnknown + errMax* = errUser + warnMin* = warnCannotOpenFile + warnMax* = pred(hintSuccess) + hintMin* = hintSuccess + hintMax* = high(TMsgKind) + rstWarnings* = {warnRstRedefinitionOfLabel..warnRstStyle} + +type + TNoteKind* = range[warnMin..hintMax] # "notes" are warnings or hints + TNoteKinds* = set[TNoteKind] + +proc computeNotesVerbosity(): array[0..3, TNoteKinds] = + result = 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*: AbsoluteFile # This is a canonical full filesystem path + projPath*: RelativeFile # This is relative to the project's root + shortName*: string # short name of the module + quotedName*: Rope # cached quoted short name for codegen + # purposes + quotedFullName*: Rope # cached quoted full name for codegen + # purposes + + lines*: seq[string] # the source code of the module + # used for better error messages and + # embedding the original source in the + # generated code + dirtyFile*: AbsoluteFile # the file that is actually read into memory + # and parsed; usually "" but is used + # for 'nimsuggest' + hash*: string # the checksum of the file + dirty*: bool # for 'nimpretty' like tooling + when defined(nimpretty): + fullContent*: string + FileIndex* = distinct int32 + TLineInfo* = object # This is designed to be as small as possible, + # because it is used + # in syntax nodes. We save space here by using + # two int16 and an int32. + # On 64 bit and on 32 bit systems this is + # only 8 bytes. + line*: uint16 + col*: int16 + fileIndex*: FileIndex + when defined(nimpretty): + offsetA*, offsetB*: int + commentOffsetA*, commentOffsetB*: int + + TErrorOutput* = enum + eStdOut + eStdErr + + TErrorOutputs* = set[TErrorOutput] + + ERecoverableError* = object of ValueError + ESuggestDone* = object of ValueError + +proc `==`*(a, b: FileIndex): bool {.borrow.} + +proc hash*(i: TLineInfo): Hash = + hash (i.line.int, i.col.int, i.fileIndex.int) + +proc raiseRecoverableError*(msg: string) {.noinline, 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 + commandLineIdx* = FileIndex(-3) + +type + MsgConfig* = object ## does not need to be stored in the incremental cache + trackPos*: TLineInfo + trackPosAttached*: bool ## whether the tracking position was attached to + ## some close token. + + errorOutputs*: TErrorOutputs + msgContext*: seq[tuple[info: TLineInfo, detail: string]] + lastError*: TLineInfo + filenameToIndexTbl*: Table[string, FileIndex] + fileInfos*: seq[TFileInfo] + systemFileIdx*: FileIndex + + +proc initMsgConfig*(): MsgConfig = + 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 new file mode 100644 index 000000000..a80c377e9 --- /dev/null +++ b/compiler/linter.nim @@ -0,0 +1,158 @@ +# +# +# 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 style checker. + +import std/strutils +from std/sugar import dup + +import options, ast, msgs, idents, lineinfos, wordrecg, astmsgs, semdata, packages +export packages + +const + Letters* = {'a'..'z', 'A'..'Z', '0'..'9', '\x80'..'\xFF', '_'} + +proc identLen*(line: string, start: int): int = + result = 0 + while start+result < line.len and line[start+result] in Letters: + inc result + +proc `=~`(s: string, a: openArray[string]): bool = + result = false + for x in a: + if s.startsWith(x): return true + +proc beautifyName(s: string, k: TSymKind): string = + # minimal set of rules here for transition: + # GC_ is allowed + + let allUpper = allCharsInSet(s, {'A'..'Z', '0'..'9', '_'}) + if allUpper and k in {skConst, skEnumField, skType}: return s + result = newStringOfCap(s.len) + var i = 0 + case k + of skType, skGenericParam: + # 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", "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]) + of skConst, skEnumField: + # for 'const' we keep how it's spelt; either upper case or lower case: + result.add s[0] + else: + # as a special rule, don't transform 'L' to 'l' + if s.len == 1 and s[0] == 'L': result.add 'L' + elif '_' in s: result.add(s[i]) + else: result.add toLowerAscii(s[0]) + inc i + while i < s.len: + if s[i] == '_': + 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 + result.add s[i] + else: + inc i + result.add toUpperAscii(s[i]) + elif allUpper: + result.add toLowerAscii(s[i]) + else: + result.add s[i] + inc i + +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 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 first+1 < line.len and line[first] == '`': inc first + + let last = first+identLen(line, first)-1 + result = differ(line, first, last, newName) + +proc styleCheckUseImpl(conf: ConfigRef; info: TLineInfo; s: PSym) = + let newName = s.name.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 67b32f919..000000000 --- a/compiler/lists.nim +++ /dev/null @@ -1,113 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements a generic doubled linked list. - -type - PListEntry* = ref TListEntry - TListEntry* = object of TObject - prev*, next*: PListEntry - - TStrEntry* = object of TListEntry - data*: string - - PStrEntry* = ref TStrEntry - TLinkedList* = object # for the "find" operation: - head*, tail*: PListEntry - Counter*: int - - TCompareProc* = proc (entry: PListEntry, closure: Pointer): bool {.nimcall.} - -proc InitLinkedList*(list: var TLinkedList) = - list.Counter = 0 - list.head = nil - list.tail = nil - -proc Append*(list: var TLinkedList, entry: PListEntry) = - Inc(list.counter) - entry.next = nil - entry.prev = list.tail - if list.tail != nil: - assert(list.tail.next == nil) - list.tail.next = entry - list.tail = entry - if list.head == nil: list.head = entry - -proc Contains*(list: TLinkedList, data: string): bool = - var it = list.head - while it != nil: - if PStrEntry(it).data == data: - return true - it = it.next - -proc newStrEntry(data: string): PStrEntry = - new(result) - result.data = data - -proc AppendStr*(list: var TLinkedList, data: string) = - append(list, newStrEntry(data)) - -proc IncludeStr*(list: var TLinkedList, data: string): bool = - if Contains(list, data): return true - AppendStr(list, data) # else: add to list - -proc Prepend*(list: var TLinkedList, entry: PListEntry) = - Inc(list.counter) - entry.prev = nil - entry.next = list.head - if list.head != nil: - assert(list.head.prev == nil) - list.head.prev = entry - list.head = entry - if list.tail == nil: list.tail = entry - -proc PrependStr*(list: var TLinkedList, data: string) = - prepend(list, newStrEntry(data)) - -proc InsertBefore*(list: var TLinkedList, pos, entry: PListEntry) = - assert(pos != nil) - if pos == list.head: - prepend(list, entry) - else: - Inc(list.counter) - entry.next = pos - entry.prev = pos.prev - if pos.prev != nil: pos.prev.next = entry - pos.prev = entry - -proc Remove*(list: var TLinkedList, entry: PListEntry) = - Dec(list.counter) - if entry == list.tail: - list.tail = entry.prev - if entry == list.head: - list.head = entry.next - if entry.next != nil: entry.next.prev = entry.prev - if entry.prev != nil: entry.prev.next = entry.next - -proc bringToFront*(list: var TLinkedList, entry: PListEntry) = - if entry == list.head: return - if entry == list.tail: list.tail = entry.prev - if entry.next != nil: entry.next.prev = entry.prev - if entry.prev != nil: entry.prev.next = entry.next - entry.prev = nil - entry.next = list.head - list.head = entry - -proc ExcludeStr*(list: var TLinkedList, data: string) = - var it = list.head - while it != nil: - let nxt = it.next - if PStrEntry(it).data == data: remove(list, it) - it = nxt - -proc Find*(list: TLinkedList, fn: TCompareProc, closure: Pointer): PListEntry = - result = list.head - while result != nil: - if fn(result, closure): return - result = result.next diff --git a/compiler/llstream.nim b/compiler/llstream.nim index 8ccf24b99..cc8148483 100644 --- a/compiler/llstream.nim +++ b/compiler/llstream.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -9,217 +9,210 @@ ## Low-level streams for high performance. -import - strutils +import + pathutils -when not defined(windows) and defined(useGnuReadline): - import rdstdin +when defined(nimPreviewSlimSystem): + import std/syncio -type +# 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 llsFile, # stream encapsulates a file llsStdIn # stream encapsulates stdin - TLLStream* = object of TObject + TLLStream* = object of RootObj kind*: TLLStreamKind # accessible for low-level access (lexbase uses this) - f*: tfile + f*: File 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 -proc LLStreamOpen*(f: var tfile): PLLStream -proc LLStreamOpen*(filename: string, mode: TFileMode): PLLStream -proc LLStreamOpen*(): PLLStream -proc LLStreamOpenStdIn*(): PLLStream -proc LLStreamClose*(s: PLLStream) -proc LLStreamRead*(s: PLLStream, buf: pointer, bufLen: int): int -proc LLStreamReadLine*(s: PLLStream, line: var string): bool -proc LLStreamReadAll*(s: PLLStream): string -proc LLStreamWrite*(s: PLLStream, data: string) -proc LLStreamWrite*(s: PLLStream, data: Char) -proc LLStreamWrite*(s: PLLStream, buf: pointer, buflen: int) -proc LLStreamWriteln*(s: PLLStream, data: string) -# implementation - -proc LLStreamOpen(data: string): PLLStream = - new(result) - result.s = data - result.kind = llsString - -proc LLStreamOpen(f: var tfile): PLLStream = - new(result) - result.f = f - result.kind = llsFile - -proc LLStreamOpen(filename: string, mode: TFileMode): PLLStream = - new(result) - result.kind = llsFile - if not open(result.f, filename, mode): result = nil - -proc LLStreamOpen(): PLLStream = - new(result) - result.kind = llsNone - -proc LLStreamOpenStdIn(): PLLStream = - new(result) - result.kind = llsStdIn - result.s = "" - result.lineOffset = -1 - -proc LLStreamClose(s: PLLStream) = +proc llStreamOpen*(data: sink string): PLLStream = + PLLStream(kind: llsString, s: data) + +proc llStreamOpen*(f: File): PLLStream = + PLLStream(kind: llsFile, f: f) + +proc llStreamOpen*(filename: AbsoluteFile, mode: FileMode): PLLStream = + result = PLLStream(kind: llsFile) + if not open(result.f, filename.string, mode): result = nil + +proc llStreamOpen*(): PLLStream = + PLLStream(kind: llsNone) + +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 - of llsNone, llsString, llsStdIn: - nil - of llsFile: + of llsNone, llsString, llsStdIn: + discard + of llsFile: close(s.f) -when not defined(ReadLineFromStdin): +when not declared(readLineFromStdin): # fallback implementation: - proc ReadLineFromStdin(prompt: string, line: var string): bool = + proc readLineFromStdin(prompt: string, line: var string): bool = stdout.write(prompt) + stdout.flushFile() result = readLine(stdin, line) + if not result: + stdout.write("\n") + quit(0) proc endsWith*(x: string, s: set[char]): bool = var i = x.len-1 while i >= 0 and x[i] == ' ': dec(i) if i >= 0 and x[i] in s: result = true + else: + result = false -const +const LineContinuationOprs = {'+', '-', '*', '/', '\\', '<', '>', '!', '?', '^', '|', '%', '&', '$', '@', '~', ','} AdditionalLineContinuationOprs = {'#', ':', '='} proc endsWithOpr*(x: string): bool = - # also used by the standard template filter: 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 inc i -proc LLreadFromStdin(s: PLLStream, buf: pointer, bufLen: int): int = +proc llReadFromStdin(s: PLLStream, buf: pointer, bufLen: int): int = s.s = "" s.rd = 0 var line = newStringOfCap(120) var triples = 0 - while ReadLineFromStdin(if s.s.len == 0: ">>> " else: "... ", line): - add(s.s, line) - add(s.s, "\n") + while readLineFromStdin(if s.s.len == 0: ">>> " else: "... ", line): + 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) - if result > 0: + result = min(bufLen, s.s.len - s.rd) + if result > 0: copyMem(buf, addr(s.s[s.rd]), result) inc(s.rd, result) -proc LLStreamRead(s: PLLStream, buf: pointer, bufLen: int): int = +proc llStreamRead*(s: PLLStream, buf: pointer, bufLen: int): int = case s.kind - of llsNone: + of llsNone: result = 0 - of llsString: - result = min(bufLen, len(s.s) - s.rd) - if result > 0: + of llsString: + 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: + of llsFile: result = readBuffer(s.f, buf, bufLen) - of llsStdIn: - result = LLreadFromStdin(s, buf, bufLen) - -proc LLStreamReadLine(s: PLLStream, line: var string): bool = + of llsStdIn: + if s.onPrompt!=nil: s.onPrompt() + result = s.repl(s, buf, bufLen) + +proc llStreamReadLine*(s: PLLStream, line: var string): bool = setLen(line, 0) case s.kind 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: result = readLine(stdin, line) - -proc LLStreamWrite(s: PLLStream, data: string) = + +proc llStreamWrite*(s: PLLStream, data: string) = case s.kind - of llsNone, llsStdIn: - nil - of llsString: - add(s.s, data) - inc(s.wr, len(data)) - of llsFile: + of llsNone, llsStdIn: + discard + of llsString: + s.s.add(data) + inc(s.wr, data.len) + of llsFile: write(s.f, data) - -proc LLStreamWriteln(s: PLLStream, data: string) = - LLStreamWrite(s, data) - LLStreamWrite(s, "\n") -proc LLStreamWrite(s: PLLStream, data: Char) = +proc llStreamWriteln*(s: PLLStream, data: string) = + llStreamWrite(s, data) + llStreamWrite(s, "\n") + +proc llStreamWrite*(s: PLLStream, data: char) = var c: char case s.kind - of llsNone, llsStdIn: - nil - of llsString: - add(s.s, data) + of llsNone, llsStdIn: + discard + of llsString: + s.s.add(data) inc(s.wr) - of llsFile: + of llsFile: c = data discard writeBuffer(s.f, addr(c), sizeof(c)) -proc LLStreamWrite(s: PLLStream, buf: pointer, buflen: int) = +proc llStreamWrite*(s: PLLStream, buf: pointer, buflen: int) = case s.kind - of llsNone, llsStdIn: - nil - of llsString: - if bufLen > 0: - setlen(s.s, len(s.s) + bufLen) - copyMem(addr(s.s[0 + s.wr]), buf, bufLen) - inc(s.wr, bufLen) - of llsFile: - discard writeBuffer(s.f, buf, bufLen) - -proc LLStreamReadAll(s: PLLStream): string = - const + of llsNone, llsStdIn: + discard + of llsString: + if buflen > 0: + setLen(s.s, s.s.len + buflen) + copyMem(addr(s.s[0 + s.wr]), buf, buflen) + inc(s.wr, buflen) + of llsFile: + discard writeBuffer(s.f, buf, buflen) + +proc llStreamReadAll*(s: PLLStream): string = + const bufSize = 2048 - var bytes, i: int case s.kind - of llsNone, llsStdIn: + of llsNone, llsStdIn: result = "" - of llsString: + of llsString: if s.rd == 0: result = s.s else: result = substr(s.s, s.rd) - s.rd = len(s.s) - of llsFile: + s.rd = s.s.len + of llsFile: result = newString(bufSize) - bytes = readBuffer(s.f, addr(result[0]), bufSize) - i = bytes - while bytes == bufSize: - setlen(result, i + bufSize) + var bytes = readBuffer(s.f, addr(result[0]), bufSize) + var i = bytes + while bytes == bufSize: + setLen(result, i + bufSize) bytes = readBuffer(s.f, addr(result[i + 0]), bufSize) inc(i, bytes) - setlen(result, i) + setLen(result, i) diff --git a/compiler/lookups.nim b/compiler/lookups.nim index e1ec9e14b..d8fcf73e0 100644 --- a/compiler/lookups.nim +++ b/compiler/lookups.nim @@ -1,52 +1,82 @@ # # -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf +# 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 lookup helpers. +import std/[algorithm, strutils, tables] -import - intsets, ast, astalgo, idents, semdata, types, msgs, options, rodread, - renderer, wordrecg, idgen +when defined(nimPreviewSlimSystem): + import std/assertions -proc ensureNoMissingOrUnusedSymbols(scope: PScope) +import + ast, astalgo, idents, semdata, types, msgs, options, + renderer, lineinfos, modulegraphs, astmsgs, wordrecg + +import std/[intsets, sets] + +proc ensureNoMissingOrUnusedSymbols(c: PContext; scope: PScope) + +proc noidentError(conf: ConfigRef; n, origin: PNode) = + var m = "" + if origin != nil: + m.add "in expression '" & origin.renderTree & "': " + m.add "identifier expected, but found '" & n.renderTree & "'" + localError(conf, n.info, m) + +proc considerQuotedIdent*(c: PContext; n: PNode, origin: PNode = nil): PIdent = + ## Retrieve a PIdent from a PNode, taking into account accent nodes. + ## ``origin`` can be nil. If it is not nil, it is used for a better + ## error message. + template handleError(n, origin: PNode) = + noidentError(c.config, n, origin) + result = getIdent(c.cache, "<Error>") -proc considerAcc*(n: PNode): PIdent = case n.kind of nkIdent: result = n.ident of nkSym: result = n.sym.name of nkAccQuoted: case n.len - of 0: GlobalError(n.info, errIdentifierExpected, renderTree(n)) - of 1: result = considerAcc(n.sons[0]) + of 0: handleError(n, origin) + of 1: result = considerQuotedIdent(c, n[0], origin) else: var id = "" - for i in 0.. <n.len: - let x = n.sons[i] + 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: GlobalError(n.info, errIdentifierExpected, renderTree(n)) - result = getIdent(id) + 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[0].sym.name + else: + handleError(n, origin) + of nkOpenSym: + result = considerQuotedIdent(c, n[0], origin) else: - GlobalError(n.info, errIdentifierExpected, renderTree(n)) - + handleError(n, origin) + template addSym*(scope: PScope, s: PSym) = - StrTableAdd(scope.symbols, s) + strTableAdd(scope.symbols, s) -proc addUniqueSym*(scope: PScope, s: PSym): TResult = - if StrTableIncl(scope.symbols, s): - result = Failure - else: - result = Success +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 @@ -54,286 +84,837 @@ proc rawCloseScope*(c: PContext) = c.currentScope = c.currentScope.parent proc closeScope*(c: PContext) = - ensureNoMissingOrUnusedSymbols(c.currentScope) + 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 +iterator localScopesFrom*(c: PContext; scope: PScope): PScope = + for s in allScopes(scope): + if s == c.topLevelScope: break + yield s + +proc isShadowScope*(s: PScope): bool {.inline.} = + s.parent != nil and s.parent.depthLevel == s.depthLevel + proc localSearchInScope*(c: PContext, s: PIdent): PSym = - result = StrTableGet(c.currentScope.symbols, s) + 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) -proc searchInScopes*(c: PContext, s: PIdent): PSym = - for scope in walkScopes(c.currentScope): - result = StrTableGet(scope.symbols, s) - if result != nil: return - result = nil +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) -proc searchInScopes*(c: PContext, s: PIdent, filter: TSymKinds): PSym = - for scope in walkScopes(c.currentScope): - result = StrTableGet(scope.symbols, s) - if result != nil and result.kind in filter: return +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 errorSym*(c: PContext, n: PNode): PSym = +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) + +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: + result.add candidate + 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 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) - var m = n - # ensure that 'considerAcc' can't fail: - if m.kind == nkDotExpr: m = m.sons[1] - let ident = if m.kind in {nkIdent, nkSym, nkAccQuoted}: - considerAcc(m) - else: - getIdent("err:" & renderTree(m)) - result = newSym(skError, ident, getCurrOwner(), n.info) + result = newSym(skError, ident, c.idgen, getCurrOwner(c), info, {}) result.typ = errorType(c) incl(result.flags, sfDiscardable) - # pretend it's imported from some unknown module to prevent cascading errors: - if gCmd != cmdInteractive: - c.importTable.addSym(result) + # 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) -type - TOverloadIterMode* = enum +proc errorSym*(c: PContext, n: PNode): PSym = + var m = n + # ensure that 'considerQuotedIdent' can't fail: + 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 = errorSym(c, ident, n.info) + +type + TOverloadIterMode* = enum oimDone, oimNoQualifier, oimSelfModule, oimOtherModule, oimSymChoice, oimSymChoiceLocalLookup - TOverloadIter*{.final.} = object + TOverloadIter* = object it*: TIdentIter + mit*: ModuleIter m*: PSym mode*: TOverloadIterMode symChoiceIndex*: int - scope*: PScope - inSymChoice: TIntSet + currentScope: PScope + importIdx: int + marked: IntSet -proc getSymRepr*(s: PSym): string = +proc getSymRepr*(conf: ConfigRef; s: PSym, getDeclarationPath = true): string = case s.kind - of skProc, skMethod, skConverter, skIterator: result = getProcHeader(s) - else: result = s.name.s + of routineKinds, skType: + result = getProcHeader(conf, s, getDeclarationPath = getDeclarationPath) + else: + result = "'$1'" % s.name.s + if getDeclarationPath: + result.addDeclaredLoc(conf, s) -proc ensureNoMissingOrUnusedSymbols(scope: PScope) = +proc ensureNoMissingOrUnusedSymbols(c: PContext; scope: PScope) = # check if all symbols have been used and defined: - var it: TTabIter - var s = InitTabIter(it, scope.symbols) + 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: + 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(s.info, errImplOfXexpected, getSymRepr(s)) + localError(c.config, s.info, "implementation of '$1' expected" % + getSymRepr(c.config, s, getDeclarationPath=false)) inc missingImpls - elif {sfUsed, sfExported} * s.flags == {} and optHints in s.options: - # BUGFIX: check options in s! - if s.kind notin {skForVar, skParam, skMethod, skUnknown, skGenericParam}: - Message(s.info, hintXDeclaredButNotUsed, getSymRepr(s)) - s = NextIter(it, scope.symbols) - -proc WrongRedefinition*(info: TLineInfo, s: string) = - if gCmd != cmdInteractive: - localError(info, errAttemptToRedefine, s) - -proc addDecl*(c: PContext, sym: PSym) = - if c.currentScope.addUniqueSym(sym) == Failure: - WrongRedefinition(sym.info, sym.Name.s) + 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: + unusedSyms.add (s, toFileLineCol(c.config, s.info)) + s = nextIter(it, scope.symbols) + for (s, _) in sortedByIt(unusedSyms, it.key): + message(c.config, s.info, hintXDeclaredButNotUsed, s.name.s) + +proc wrongRedefinition*(c: PContext; info: TLineInfo, s: string; + conflictsWith: TLineInfo, note = errGenerated) = + ## Emit a redefinition error if in non-interactive mode + if c.config.cmd != cmdInteractive: + localError(c.config, info, note, + "redefinition of '$1'; previous declaration here: $2" % + [s, c.config $ conflictsWith]) + +# 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 addDeclAt*(c: PContext; scope: PScope, sym: PSym) {.inline.} = + addDeclAt(c, scope, sym, sym.info) + +proc addDecl*(c: PContext, sym: PSym, info: TLineInfo) {.inline.} = + addDeclAt(c, c.currentScope, sym, info) + +proc addDecl*(c: PContext, sym: PSym) {.inline.} = + addDeclAt(c, c.currentScope, sym) proc addPrelimDecl*(c: PContext, sym: PSym) = discard c.currentScope.addUniqueSym(sym) -proc addDeclAt*(scope: PScope, sym: PSym) = - if scope.addUniqueSym(sym) == Failure: - WrongRedefinition(sym.info, sym.Name.s) +from ic / ic import addHidden -proc AddInterfaceDeclAux(c: PContext, sym: PSym) = +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) - else: InternalError(sym.info, "AddInterfaceDeclAux") + 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) = - addDeclAt(scope, sym) - AddInterfaceDeclAux(c, sym) + ## adds a symbol on the scope and the interface if appropriate + addDeclAt(c, scope, sym) + if not scope.isShadowScope: + # adding into a non-shadow scope, we need to handle exports, etc + addInterfaceDeclAux(c, sym) -proc addOverloadableSymAt*(scope: PScope, fn: PSym) = - if fn.kind notin OverloadableSyms: - InternalError(fn.info, "addOverloadableSymAt") +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 - var check = StrTableGet(scope.symbols, fn.name) - if check != nil and check.Kind notin OverloadableSyms: - WrongRedefinition(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 - addOverloadableSymAt(scope, sym) - AddInterfaceDeclAux(c, sym) + ## adds an overloadable symbol on the scope and the interface if appropriate + addOverloadableSymAt(c, scope, sym) + if not scope.isShadowScope: + # adding into a non-shadow scope, we need to handle exports, etc + addInterfaceDeclAux(c, sym) + +proc openShadowScope*(c: PContext) = + ## opens a shadow scope, just like any other scope except the depth is the + ## same as the parent -- see `isShadowScope`. + c.currentScope = PScope(parent: c.currentScope, + symbols: 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) + -proc lookUp*(c: PContext, n: PNode): PSym = +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 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 + 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 + +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) - if result == nil: - LocalError(n.info, errUndeclaredIdentifier, 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 = considerAcc(n) - result = searchInScopes(c, ident) - if result == nil: - LocalError(n.info, errUndeclaredIdentifier, ident.s) - result = errorSym(c, n) + var ident = considerQuotedIdent(c, n) + result = searchInScopes(c, ident, amb) + if result == nil: result = errorUndeclaredIdentifierHint(c, ident, n.info) else: - InternalError(n.info, "lookUp") - return - if Contains(c.AmbiguousSymbols, result.id): - LocalError(n.info, errUseQualifier, result.name.s) - if result.kind == skStub: loadStub(result) - -type - TLookupFlag* = enum - checkAmbiguity, checkUndeclared - -proc QualifiedLookUp*(c: PContext, n: PNode, flags = {checkUndeclared}): PSym = + internalError(c.config, n.info, "lookUp") + return nil + if amb: + #contains(c.ambiguousSymbols, result.id): + result = errorUseQualifier(c, n.info, result, amb) + when false: + if result.kind == skStub: loadStub(result) + +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 = case n.kind of nkIdent, nkAccQuoted: - var ident = considerAcc(n) - result = searchInScopes(c, ident) - if result == nil and checkUndeclared in flags: - LocalError(n.info, errUndeclaredIdentifier, ident.s) - result = errorSym(c, n) - elif checkAmbiguity in flags and result != nil and - Contains(c.AmbiguousSymbols, result.id): - LocalError(n.info, errUseQualifier, ident.s) + var amb = false + var ident = considerQuotedIdent(c, n) + if checkModule in flags: + result = searchInScopes(c, ident, amb) + if result == nil: + let candidates = allPureEnumFields(c, ident) + if candidates.len > 0: + result = candidates[0] + amb = candidates.len > 1 + if amb and checkAmbiguity in flags: + errorUseQualifier(c, n.info, candidates) + else: + let candidates = lookUpCandidates(c, ident, allExceptModule) + if candidates.len > 0: + result = candidates[0] + amb = candidates.len > 1 + if amb and checkAmbiguity in flags: + errorUseQualifier(c, n.info, candidates) + else: + result = nil + if result == nil and checkUndeclared in flags: + result = errorUndeclaredIdentifierHint(c, 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): - LocalError(n.info, errUseQualifier, n.sym.name.s) - of nkDotExpr: + of nkOpenSym: + result = qualifiedLookUp(c, n[0], flags) + of nkDotExpr: result = nil - var m = qualifiedLookUp(c, n.sons[0], flags*{checkUndeclared}) - if (m != nil) and (m.kind == skModule): + 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 = considerAcc(n.sons[1]) - if ident != nil: - if m == c.module: - result = StrTableGet(c.topLevelScope.symbols, ident) - else: - result = StrTableGet(m.tab, ident) - if result == nil and checkUndeclared in flags: - LocalError(n.sons[1].info, errUndeclaredIdentifier, ident.s) - result = errorSym(c, n.sons[1]) - elif checkUndeclared in flags: - LocalError(n.sons[1].info, errIdentifierExpected, - renderTree(n.sons[1])) - result = errorSym(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: + 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: + var amb: bool = false + if c.importModuleLookup.getOrDefault(m.name.id).len > 1: + result = errorUseQualifier(c, n.info, m, amb) + else: + result = someSymAmb(c.graph, m, ident, amb) + if amb: c.isAmbiguous = true + if result == nil and checkUndeclared in flags: + result = errorUndeclaredIdentifierHint(c, ident, n[1].info) + elif n[1].kind == nkSym: + result = n[1].sym + if result.owner != nil and result.owner != m and checkUndeclared in flags: + # dotExpr in templates can end up here + result = errorUndeclaredIdentifierHint(c, result.name, n[1].info) + elif checkUndeclared in flags and + n[1].kind notin {nkOpenSymChoice, nkClosedSymChoice}: + localError(c.config, n[1].info, "identifier expected, but got: " & + renderTree(n[1])) + result = errorSym(c, n[1]) else: result = nil - if result != nil and result.kind == skStub: loadStub(result) - -proc InitOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = + 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: - var ident = considerAcc(n) - o.scope = c.currentScope + result = nil + var ident = considerQuotedIdent(c, n) + var scope = c.currentScope o.mode = oimNoQualifier while true: - result = InitIdentIter(o.it, o.scope.symbols, ident) + 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: + of nkDotExpr: + result = nil o.mode = oimOtherModule - o.m = qualifiedLookUp(c, n.sons[0]) + 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 = considerAcc(n.sons[1]) - if ident != nil: - if o.m == c.module: + 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) + result = initIdentIter(o.it, c.topLevelScope.symbols, + ident) o.mode = oimSelfModule - else: - result = InitIdentIter(o.it, o.m.tab, ident) - else: - LocalError(n.sons[1].info, errIdentifierExpected, - renderTree(n.sons[1])) - result = errorSym(c, n.sons[1]) + else: + result = initModuleIter(o.mit, c.graph, o.m, ident) + else: + noidentError(c.config, n[1], n) + result = errorSym(c, n[1]) of nkClosedSymChoice, nkOpenSymChoice: o.mode = oimSymChoice - result = n.sons[0].sym + if n[0].kind == nkSym: + result = n[0].sym + else: + o.mode = oimDone + return nil o.symChoiceIndex = 1 - o.inSymChoice = initIntSet() - Incl(o.inSymChoice, result.id) - else: nil - if result != nil and result.kind == skStub: loadStub(result) + 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 nextOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = + +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: + of oimDone: result = nil - of oimNoQualifier: - if o.scope != nil: - result = nextIdentIter(o.it, o.scope.symbols) + of oimNoQualifier: + 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) - # BUGFIX: o.it.name <-> n.ident - else: + 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: + of oimSelfModule: result = nextIdentIter(o.it, c.topLevelScope.symbols) - of oimOtherModule: - result = nextIdentIter(o.it, o.m.tab) - of oimSymChoice: - if o.symChoiceIndex < sonsLen(n): - result = n.sons[o.symChoiceIndex].sym - Incl(o.inSymChoice, result.id) + of oimOtherModule: + result = nextModuleIter(o.mit, c.graph) + of oimSymChoice: + 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) + 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) + 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) - 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) - - if result != nil and result.kind == skStub: loadStub(result) - + 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 = + 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: + if result == nil: result = a + else: return nil # ambiguous + a = nextOverloadIter(o, c, n) + diff --git a/compiler/lowerings.nim b/compiler/lowerings.nim new file mode 100644 index 000000000..2c9c4cb32 --- /dev/null +++ b/compiler/lowerings.nim @@ -0,0 +1,370 @@ +# +# +# 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 common simple lowerings. + +const + genPrefix* = ":tmp" # prefix for generated names + +import ast, astalgo, types, idents, magicsys, msgs, options, modulegraphs, + lineinfos + +when defined(nimPreviewSlimSystem): + import std/assertions + +proc newDeref*(n: PNode): PNode {.inline.} = + result = newNodeIT(nkHiddenDeref, n.info, n.typ.elementType) + result.add n + +proc newTupleAccess*(g: ModuleGraph; tup: PNode, i: int): PNode = + 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[0] = v + vpart[1] = newNodeI(nkEmpty, v.info) + vpart[2] = vpart[1] + father.add vpart + +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[0] = le + result[1] = ri + +proc newFastAsgnStmt*(le, ri: PNode): PNode = + result = newNodeI(nkFastAsgn, le.info, 2) + result[0] = le + result[1] = ri + +proc newFastMoveStmt*(g: ModuleGraph, le, ri: PNode): PNode = + result = newNodeI(nkFastAsgn, le.info, 2) + 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; idgen: IdGenerator; owner: PSym): PNode = + assert n.kind == nkVarTuple + let value = n.lastSon + result = newNodeI(nkStmtList, n.info) + + 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(nkLetSection, value.info) + let tempAsNode = newSymNode(temp) + v.addVar(tempAsNode) + result.add(v) + result.add newAsgnStmt(tempAsNode, value) + result.add tempAsNode + +proc newTupleAccessRaw*(tup: PNode, i: int): PNode = + result = newNodeI(nkBracketExpr, tup.info) + result.add copyTree(tup) + var lit = newNodeI(nkIntLit, tup.info) + lit.intVal = i + result.add lit + +proc newTryFinally*(body, final: PNode): PNode = + result = newTree(nkHiddenTryStmt, body, newTree(nkFinally, final)) + +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), 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[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; 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.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 = 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)[0] + deref.add a + result = newNodeI(nkDotExpr, info) + 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) + result.add newSymNode(obj) + result.add newSymNode(field) + result.typ = field.typ + +proc lookupInRecord(n: PNode, id: ItemId): PSym = + result = nil + case n.kind + of nkRecList: + for i in 0..<n.len: + result = lookupInRecord(n[i], id) + if result != nil: return + of nkRecCase: + if n[0].kind != nkSym: return + result = lookupInRecord(n[0], id) + if result != nil: return + for i in 1..<n.len: + case n[i].kind + of nkOfBranch, nkElse: + result = lookupInRecord(lastSon(n[i]), id) + if result != nil: return + else: discard + of nkSym: + if n.sym.itemId.module == id.module and n.sym.itemId.item == -abs(id.item): result = n.sym + else: discard + +proc addField*(obj: PType; s: PSym; cache: IdentCache; idgen: IdGenerator): 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), + idgen, s.owner, s.info, s.options) + field.itemId = ItemId(module: s.itemId.module, item: -s.itemId.item) + let t = skipIntLit(s.typ, idgen) + field.typ = t + if s.kind in {skLet, skVar, skField, skForVar}: + #field.bitsize = s.bitsize + field.alignment = s.alignment + assert t.kind != tyTyped + propagateToOwner(obj, t) + field.position = obj.n.len + # 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), 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 != tyTyped + propagateToOwner(obj, t) + field.position = obj.n.len + obj.n.add newSymNode(field) + result = field + +proc newDotExpr*(obj, b: PSym): PNode = + result = newNodeI(nkDotExpr, obj.info) + let field = lookupInRecord(obj.typ.n, b.itemId) + assert field != nil, b.name.s + result.add newSymNode(obj) + result.add newSymNode(field) + result.typ = field.typ + +proc indirectAccess*(a: PNode, b: ItemId, info: TLineInfo): PNode = + # returns a[].b as a node + var deref = newNodeI(nkHiddenDeref, info) + deref.typ = a.typ.skipTypes(abstractInst).elementType + 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.baseClass + if t == nil: break + t = t.skipTypes(skipPtrs) + #if field == nil: + # echo "FIELD ", b + # debug deref.typ + assert field != nil + deref.add a + result = newNodeI(nkDotExpr, info) + result.add deref + result.add newSymNode(field) + result.typ = field.typ + +proc indirectAccess*(a: PNode, b: string, info: TLineInfo; cache: IdentCache): PNode = + # returns a[].b as a node + var deref = newNodeI(nkHiddenDeref, info) + deref.typ = a.typ.skipTypes(abstractInst).elementType + var t = deref.typ.skipTypes(abstractInst) + var field: PSym + let bb = getIdent(cache, b) + while true: + assert t.kind == tyObject + field = getSymFromList(t.n, bb) + if field != nil: break + t = t.baseClass + if t == nil: break + t = t.skipTypes(skipPtrs) + #if field == nil: + # echo "FIELD ", b + # debug deref.typ + assert field != nil + deref.add a + result = newNodeI(nkDotExpr, info) + result.add deref + result.add newSymNode(field) + result.typ = field.typ + +proc getFieldFromObj*(t: PType; v: PSym): PSym = + assert v.kind != skField + var t = t + while true: + assert t.kind == tyObject + result = lookupInRecord(t.n, v.itemId) + if result != nil: break + 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.itemId, info) + +proc indirectAccess*(a, b: PSym, info: TLineInfo): PNode = + result = indirectAccess(newSymNode(a), b, info) + +proc genAddrOf*(n: PNode; idgen: IdGenerator; typeKind = tyPtr): PNode = + result = newNodeI(nkAddr, n.info, 1) + result[0] = n + result.typ = newType(typeKind, idgen, n.typ.owner) + result.typ.rawAddSon(n.typ) + +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; + 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, info, "system module needs: " & name) + else: + result.add newSymNode(sym) + 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-2: + result.add optionalArgs[i] + result.typ = sym.typ.returnType + +proc newIntLit*(g: ModuleGraph; info: TLineInfo; value: BiggestInt): PNode = + result = nkIntLit.newIntNode(value) + result.typ = getSysType(g, info, tyInt) + +proc genHigh*(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)))) + else: + result = newNodeI(nkCall, n.info, 2) + result.typ = getSysType(g, n.info, tyInt) + 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: + 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 new file mode 100644 index 000000000..c869c2289 --- /dev/null +++ b/compiler/macrocacheimpl.nim @@ -0,0 +1,44 @@ +# +# +# 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 helpers for the macro cache. + +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(nkReplayAction, info) + recorded.add newStrNode("inc", info) + recorded.add newStrNode(key, info) + recorded.add newIntNode(nkIntLit, by) + c.append(recorded) + +proc recordPut*(c: PCtx; info: TLineInfo; key: string; k: string; val: PNode) = + 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.append(recorded) + +proc recordAdd*(c: PCtx; info: TLineInfo; key: string; val: PNode) = + var recorded = newNodeI(nkReplayAction, info) + recorded.add newStrNode("add", info) + recorded.add newStrNode(key, info) + recorded.add copyTree(val) + c.append(recorded) + +proc recordIncl*(c: PCtx; info: TLineInfo; key: string; val: PNode) = + var recorded = newNodeI(nkReplayAction, info) + recorded.add newStrNode("incl", info) + recorded.add newStrNode(key, info) + recorded.add copyTree(val) + c.append(recorded) diff --git a/compiler/magicsys.nim b/compiler/magicsys.nim index 1972dec98..1ec6b9a69 100644 --- a/compiler/magicsys.nim +++ b/compiler/magicsys.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -9,59 +9,48 @@ # Built-in types and compilerprocs are registered here. -import - ast, astalgo, hashes, msgs, platform, nversion, times, idents, rodread - -var SystemModule*: PSym - -proc registerSysType*(t: PType) - # magic symbols in the system module: -proc getSysType*(kind: TTypeKind): PType -proc getCompilerProc*(name: string): PSym -proc registerCompilerProc*(s: PSym) -proc FinishSystem*(tab: TStrTable) -proc getSysSym*(name: string): PSym -# implementation - -var - gSysTypes: array[TTypeKind, PType] - compilerprocs: TStrTable - -proc registerSysType(t: PType) = - if gSysTypes[t.kind] == nil: gSysTypes[t.kind] = t - -proc newSysType(kind: TTypeKind, size: int): PType = - result = newType(kind, systemModule) +import + ast, astalgo, msgs, platform, idents, + modulegraphs, lineinfos + +export createMagic + +proc nilOrSysInt*(g: ModuleGraph): PType = g.sysTypes[tyInt] + +proc newSysType(g: ModuleGraph; kind: TTypeKind, size: int): PType = + result = newType(kind, g.idgen, g.systemModule) result.size = size - result.align = size - -proc getSysSym(name: string): PSym = - result = StrTableGet(systemModule.tab, getIdent(name)) - if result == nil: - rawMessage(errSystemNeeds, name) - result = newSym(skError, getIdent(name), systemModule, systemModule.info) - result.typ = newType(tyError, systemModule) - if result.kind == skStub: loadStub(result) - -proc getSysMagic*(name: string, m: TMagic): PSym = - var ti: TIdentIter - let id = getIdent(name) - result = InitIdentIter(ti, systemModule.tab, id) - while result != nil: - if result.kind == skStub: loadStub(result) - if result.magic == m: return result - result = NextIdentIter(ti, systemModule.tab) - rawMessage(errSystemNeeds, name) - result = newSym(skError, id, systemModule, systemModule.info) - result.typ = newType(tyError, systemModule) - -proc sysTypeFromName*(name: string): PType = - result = getSysSym(name).typ - -proc getSysType(kind: TTypeKind): PType = - result = gSysTypes[kind] - if result == nil: + result.align = size.int16 + +proc getSysSym*(g: ModuleGraph; info: TLineInfo; name: string): PSym = + result = systemModuleSym(g, getIdent(g.cache, name)) + if result == nil: + localError(g.config, info, "system module needs: " & name) + result = newSym(skError, getIdent(g.cache, name), g.idgen, g.systemModule, g.systemModule.info, {}) + result.typ = newType(tyError, g.idgen, g.systemModule) + +proc getSysMagic*(g: ModuleGraph; info: TLineInfo; name: string, m: TMagic): PSym = + result = nil + let id = getIdent(g.cache, name) + for r in systemModuleSyms(g, id): + if r.magic == m: + # prefer the tyInt variant: + if r.typ.returnType != nil and r.typ.returnType.kind == tyInt: return r + result = r + if result != nil: return result + localError(g.config, info, "system module needs: " & name) + result = newSym(skError, id, 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 + +proc getSysType*(g: ModuleGraph; info: TLineInfo; kind: TTypeKind): PType = + template sysTypeFromName(s: string): untyped = sysTypeFromName(g, info, s) + 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") @@ -81,93 +70,100 @@ proc getSysType(kind: TTypeKind): PType = of tyString: result = sysTypeFromName("string") of tyCstring: result = sysTypeFromName("cstring") of tyPointer: result = sysTypeFromName("pointer") - of tyNil: result = newSysType(tyNil, ptrSize) - else: InternalError("request for typekind: " & $kind) - gSysTypes[kind] = result - if result.kind != kind: - InternalError("wanted: " & $kind & " got: " & $result.kind) - if result == nil: InternalError("type not found: " & $kind) - -var - intTypeCache: array[-5..64, PType] - -proc resetSysTypes* = - systemModule = nil - initStrTable(compilerprocs) - for i in low(gSysTypes)..high(gSysTypes): - gSysTypes[i] = nil - - for i in low(intTypeCache)..high(intTypeCache): - intTypeCache[i] = nil - -proc getIntLitType*(literal: PNode): PType = - # we cache some common integer literal types for performance: - let value = literal.intVal - if value >= low(intTypeCache) and value <= high(intTypeCache): - result = intTypeCache[value.int] - if result == nil: - let ti = getSysType(tyInt) - result = copyType(ti, ti.owner, false) - result.n = literal - intTypeCache[value.int] = result - else: - let ti = getSysType(tyInt) - result = copyType(ti, ti.owner, false) - result.n = literal - -proc skipIntLit*(t: PType): PType {.inline.} = - if t.kind == tyInt and t.n != nil: - result = getSysType(tyInt) + 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: + 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 + g.compilerprocs = initStrTable() + g.exposed = initStrTable() + for i in low(g.sysTypes)..high(g.sysTypes): + g.sysTypes[i] = nil + +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; id: IdGenerator): PType {.inline.} = + if t.n != nil and t.kind in {tyInt, tyFloat}: + 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*(result: PNode) = - let i = result.intVal - case platform.IntSize - of 8: result.typ = getIntLitType(result) - of 4: - if i >= low(int32) and i <= high(int32): - result.typ = getIntLitType(result) - else: - result.typ = getSysType(tyInt64) - of 2: - if i >= low(int16) and i <= high(int16): - result.typ = getIntLitType(result) - elif i >= low(int32) and i <= high(int32): - result.typ = getSysType(tyInt32) - else: - result.typ = getSysType(tyInt64) - of 1: - # 8 bit CPUs are insane ... - if i >= low(int8) and i <= high(int8): - result.typ = getIntLitType(result) - elif i >= low(int16) and i <= high(int16): - result.typ = getSysType(tyInt16) - elif i >= low(int32) and i <= high(int32): - result.typ = getSysType(tyInt32) - else: - result.typ = getSysType(tyInt64) - else: InternalError(result.info, "invalid int size") - -proc getCompilerProc(name: string): PSym = - var ident = getIdent(name, hashIgnoreStyle(name)) - result = StrTableGet(compilerprocs, ident) - if result == nil: - result = StrTableGet(rodCompilerProcs, ident) - if result != nil: - strTableAdd(compilerprocs, result) - if result.kind == skStub: loadStub(result) - -proc registerCompilerProc(s: PSym) = - strTableAdd(compilerprocs, s) - -proc FinishSystem(tab: TStrTable) = nil - -initStrTable(compilerprocs) +proc makeVarType*(owner: PSym; baseType: PType; idgen: IdGenerator; kind = tyVar): PType = + if baseType.kind == kind: + result = baseType + else: + result = newType(kind, idgen, owner) + addSonSkipIntLit(result, baseType, idgen) + +proc getCompilerProc*(g: ModuleGraph; name: string): PSym = + let ident = getIdent(g.cache, name) + result = strTableGet(g.compilerprocs, ident) + if result == nil: + result = loadCompilerProc(g, name) + +proc registerCompilerProc*(g: ModuleGraph; s: PSym) = + strTableAdd(g.compilerprocs, s) + +proc registerNimScriptSymbol*(g: ModuleGraph; s: PSym) = + # Nimscript symbols must be al unique: + let conflict = strTableGet(g.exposed, s.name) + if conflict == nil: + strTableAdd(g.exposed, s) + else: + localError(g.config, s.info, + "symbol conflicts with other .exportNims symbol at: " & g.config$conflict.info) + +proc getNimScriptSymbol*(g: ModuleGraph; name: string): PSym = + strTableGet(g.exposed, getIdent(g.cache, name)) + +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 2ff7691d8..4c52317cf 100644 --- a/compiler/main.nim +++ b/compiler/main.nim @@ -1,628 +1,440 @@ # # -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # -# implements the command dispatcher and several commands as well as the -# module handling - -import - llstream, strutils, ast, astalgo, lexer, syntaxes, renderer, options, msgs, - os, lists, condsyms, rodread, rodwrite, ropes, trees, times, - wordrecg, sem, semdata, idents, passes, docgen, extccomp, - cgen, jsgen, cgendata, json, nversion, - platform, nimconf, importer, passaux, depends, evals, types, idgen, - tables, docgen2, service, magicsys, parser, crc, ccgutils, sigmatch - -const - has_LLVM_Backend = false - -when has_LLVM_Backend: - import llvmgen - -proc MainCommand*() - -# ------------------ module handling ----------------------------------------- - -type - TNeedRecompile = enum Maybe, No, Yes, Probing, Recompiled - TCrcStatus = enum crcNotTaken, crcCached, crcHasChanged, crcNotChanged - - TModuleInMemory = object - compiledAt: float - crc: TCrc32 - deps: seq[int32] ## XXX: slurped files are not currently tracked - needsRecompile: TNeedRecompile - crcStatus: TCrcStatus +# implements the command dispatcher and several commands + +when not defined(nimcore): + {.error: "nimcore MUST be defined for Nim's core tooling".} + +import + 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) = + setPipeLinePass(graph, GenDependPass) + compilePipelineProject(graph) + let project = graph.config.projectFull + writeDepsFile(graph) + generateDot(graph, project) + + # dot in graphivz tool kit is required + let graphvizDotPath = findExe("dot") + if graphvizDotPath.len == 0: + quit("gendepend: Graphviz's tool dot is required," & + "see https://graphviz.org/download for downloading") + + execExternalProgram(graph.config, "dot -Tpng -o" & + changeFileExt(project, "png").string & + ' ' & changeFileExt(project, "dot").string) + +proc commandCheck(graph: ModuleGraph) = + 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) + 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 -var - gCompiledModules: seq[PSym] = @[] - gMemCacheData: seq[TModuleInMemory] = @[] - ## XXX: we should implement recycling of file IDs - ## if the user keeps renaming modules, the file IDs will keep growing + if not extccomp.ccHasSaneOverflow(conf): + conf.symbols.defineSymbol("nimEmulateOverflowChecks") -proc getModule(fileIdx: int32): PSym = - if fileIdx >= 0 and fileIdx < gCompiledModules.len: - result = gCompiledModules[fileIdx] + if conf.symbolFiles == disabledSf: + setPipeLinePass(graph, CgenPass) else: - result = nil - -template compiledAt(x: PSym): expr = - gMemCacheData[x.position].compiledAt - -template crc(x: PSym): expr = - gMemCacheData[x.position].crc - -proc crcChanged(fileIdx: int32): bool = - InternalAssert fileIdx >= 0 and fileIdx < gMemCacheData.len - - template updateStatus = - gMemCacheData[fileIdx].crcStatus = if result: crcHasChanged - else: crcNotChanged - # echo "TESTING CRC: ", fileIdx.toFilename, " ", result - - case gMemCacheData[fileIdx].crcStatus: - of crcHasChanged: - result = true - of crcNotChanged: - result = false - of crcCached: - let newCrc = crcFromFile(fileIdx.toFilename) - result = newCrc != gMemCacheData[fileIdx].crc - gMemCacheData[fileIdx].crc = newCrc - updateStatus() - of crcNotTaken: - gMemCacheData[fileIdx].crc = crcFromFile(fileIdx.toFilename) - result = true - updateStatus() - -proc doCRC(fileIdx: int32) = - if gMemCacheData[fileIdx].crcStatus == crcNotTaken: - # echo "FIRST CRC: ", fileIdx.ToFilename - gMemCacheData[fileIdx].crc = crcFromFile(fileIdx.toFilename) - -proc addDep(x: Psym, dep: int32) = - growCache gMemCacheData, dep - gMemCacheData[x.position].deps.safeAdd(dep) - -proc resetModule(fileIdx: int32) = - # echo "HARD RESETTING ", fileIdx.toFilename - gMemCacheData[fileIdx].needsRecompile = Yes - gCompiledModules[fileIdx] = nil - cgendata.gModules[fileIdx] = nil - resetSourceMap(fileIdx) - -proc resetAllModules = - for i in 0..gCompiledModules.high: - if gCompiledModules[i] != nil: - resetModule(i.int32) - - # for m in cgenModules(): echo "CGEN MODULE FOUND" - -proc checkDepMem(fileIdx: int32): TNeedRecompile = - template markDirty = - resetModule(fileIdx) - return Yes - - if gMemCacheData[fileIdx].needsRecompile != Maybe: - return gMemCacheData[fileIdx].needsRecompile - - if optForceFullMake in gGlobalOptions or - crcChanged(fileIdx): - markDirty - - if gMemCacheData[fileIdx].deps != nil: - gMemCacheData[fileIdx].needsRecompile = Probing - for dep in gMemCacheData[fileIdx].deps: - let d = checkDepMem(dep) - if d in { Yes, Recompiled }: - # echo fileIdx.toFilename, " depends on ", dep.toFilename, " ", d - markDirty - - gMemCacheData[fileIdx].needsRecompile = No - return No - -proc newModule(fileIdx: int32): 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 = fileIdx.toFilename - result.name = getIdent(splitFile(filename).name) - if not isNimrodIdentifier(result.name.s): - rawMessage(errInvalidModuleName, result.name.s) - - result.owner = result # a module belongs to itself - result.info = newLineInfo(fileIdx, 1, 1) - result.position = fileIdx - - growCache gMemCacheData, fileIdx - growCache gCompiledModules, fileIdx - gCompiledModules[result.position] = result - - incl(result.flags, sfUsed) - initStrTable(result.tab) - StrTableAdd(result.tab, result) # a module knows itself - -proc compileModule(fileIdx: int32, flags: TSymFlags): PSym = - result = getModule(fileIdx) - if result == nil: - growCache gMemCacheData, fileIdx - gMemCacheData[fileIdx].needsRecompile = Probing - result = newModule(fileIdx) - #var rd = handleSymbolFile(result) - var rd: PRodReader - result.flags = result.flags + flags - if gCmd in {cmdCompileToC, cmdCompileToCpp, cmdCheck, cmdIdeTools}: - rd = handleSymbolFile(result) - if result.id < 0: - InternalError("handleSymbolFile should have set the module\'s ID") - return - else: - result.id = getID() - processModule(result, nil, rd) - if optCaasEnabled in gGlobalOptions: - gMemCacheData[fileIdx].compiledAt = gLastCmdTime - gMemCacheData[fileIdx].needsRecompile = Recompiled - doCRC fileIdx + setPipeLinePass(graph, SemPass) + compilePipelineProject(graph) + if graph.config.errorCounter > 0: + return # issue #9933 + if conf.symbolFiles == disabledSf: + cgenWriteModules(graph.backend, conf) else: - if checkDepMem(fileIdx) == Yes: - result = CompileModule(fileIdx, flags) - else: - result = gCompiledModules[fileIdx] - -proc importModule(s: PSym, fileIdx: int32): PSym = - # this is called by the semantic checking phase - result = compileModule(fileIdx, {}) - if optCaasEnabled in gGlobalOptions: addDep(s, fileIdx) - if sfSystemModule in result.flags: - LocalError(result.info, errAttemptToRedefine, result.Name.s) - -proc includeModule(s: PSym, fileIdx: int32): PNode = - result = syntaxes.parseFile(fileIdx) - if optCaasEnabled in gGlobalOptions: - growCache gMemCacheData, fileIdx - addDep(s, fileIdx) - doCrc(fileIdx) - -proc `==^`(a, b: string): bool = - try: - result = sameFile(a, b) - except EOS: - result = false - -proc compileSystemModule = - if magicsys.SystemModule == nil: - SystemFileIdx = fileInfoIdx(options.libpath/"system.nim") - discard CompileModule(SystemFileIdx, {sfSystemModule}) - -proc CompileProject(projectFile = gProjectMainIdx) = - let systemFileIdx = fileInfoIdx(options.libpath / "system.nim") - if projectFile == SystemFileIdx: - discard CompileModule(projectFile, {sfMainModule, sfSystemModule}) + 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) + if optGenCDeps in graph.config.globalOptions: + writeCMakeDepsFile(conf) + +proc commandJsonScript(graph: ModuleGraph) = + extccomp.runJsonBuildInstructions(graph.config, graph.config.jsonBuildInstructionsFile) + +proc commandCompileToJS(graph: ModuleGraph) = + let conf = graph.config + when defined(leanCompiler): + globalError(conf, unknownLineInfo, "compiler wasn't built with JS code generator") else: - compileSystemModule() - discard CompileModule(projectFile, {sfMainModule}) - -proc rodPass = - if optSymbolFiles in gGlobalOptions: - registerPass(rodwritePass) - -proc codegenPass = - registerPass cgenPass - -proc semanticPasses = - registerPass verbosePass - registerPass semPass - -proc CommandGenDepend = - semanticPasses() - registerPass(genDependPass) - registerPass(cleanupPass) - compileProject() - generateDot(gProjectFull) - execExternalProgram("dot -Tpng -o" & changeFileExt(gProjectFull, "png") & - ' ' & changeFileExt(gProjectFull, "dot")) - -proc CommandCheck = - msgs.gErrorMax = high(int) # do not stop after first error - semanticPasses() # use an empty backend for semantic checking only - rodPass() - compileProject() - -proc CommandDoc2 = - msgs.gErrorMax = high(int) # do not stop after first error - semanticPasses() - registerPass(docgen2Pass) - #registerPass(cleanupPass()) - compileProject() - finishDoc2Pass(gProjectName) - -proc CommandCompileToC = - semanticPasses() - registerPass(cgenPass) - rodPass() - #registerPass(cleanupPass()) - if optCaasEnabled in gGlobalOptions: - # echo "BEFORE CHECK DEP" - # discard checkDepMem(gProjectMainIdx) - # echo "CHECK DEP COMPLETE" - - compileProject() - cgenWriteModules() - if gCmd != cmdRun: - extccomp.CallCCompiler(changeFileExt(gProjectFull, "")) - - if isServing: - # caas will keep track only of the compilation commands - lastCaasCmd = curCaasCmd - resetCgenModules() - for i in 0 .. <gMemCacheData.len: - gMemCacheData[i].crcStatus = crcCached - gMemCacheData[i].needsRecompile = Maybe - - # XXX: clean these global vars - # ccgstmts.gBreakpoints - # ccgthreadvars.nimtv - # ccgthreadvars.nimtVDeps - # ccgthreadvars.nimtvDeclared - # cgendata - # cgmeth? - # condsyms? - # depends? - # lexer.gLinesCompiled - # msgs - error counts - # magicsys, when system.nim changes - # rodread.rodcompilerProcs - # rodread.gTypeTable - # rodread.gMods - - # !! ropes.cache - # semthreads.computed? - # - # suggest.usageSym - # - # XXX: can we run out of IDs? - # XXX: detect config reloading (implement as error/require restart) - # XXX: options are appended (they will accumulate over time) - resetCompilationLists() - ccgutils.resetCaches() - GC_fullCollect() - -when has_LLVM_Backend: - proc CommandCompileToLLVM = - semanticPasses() - registerPass(llvmgen.llvmgenPass()) - rodPass() - #registerPass(cleanupPass()) - compileProject() - -proc CommandCompileToJS = - #incl(gGlobalOptions, optSafeCode) - setTarget(osJS, cpuJS) - #initDefines() - DefineSymbol("nimrod") # 'nimrod' is always defined - DefineSymbol("ecmascript") # For backward compatibility - DefineSymbol("js") - semanticPasses() - registerPass(jsgenPass) - compileProject() - -proc InteractivePasses = - #incl(gGlobalOptions, optSafeCode) - #setTarget(osNimrodVM, cpuNimrodVM) - initDefines() - DefineSymbol("nimrodvm") - when hasFFI: DefineSymbol("nimffi") - registerPass(verbosePass) - registerPass(semPass) - registerPass(evalPass) - -var stdinModule: PSym -proc makeStdinModule: PSym = - if stdinModule == nil: - stdinModule = newModule(fileInfoIdx"stdin") - stdinModule.id = getID() - result = stdinModule - -proc CommandInteractive = - msgs.gErrorMax = high(int) # do not stop after first error - InteractivePasses() - compileSystemModule() - if commandArgs.len > 0: - discard CompileModule(fileInfoIdx(gProjectFull), {}) + 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") + setPipeLinePass(graph, InterpreterPass) + compilePipelineSystemModule(graph) + if graph.config.commandArgs.len > 0: + discard graph.compilePipelineModule(fileInfoIdx(graph.config, graph.config.projectFull), {}) else: - var m = makeStdinModule() + var m = graph.makeStdinModule() incl(m.flags, sfMainModule) - processModule(m, LLStreamOpenStdIn(), nil) - -const evalPasses = [verbosePass, semPass, evalPass] - -proc evalNim(nodes: PNode, module: PSym) = - carryPasses(nodes, module, evalPasses) - -proc commandEval(exp: string) = - if SystemModule == nil: - InteractivePasses() - compileSystemModule() - var echoExp = "echo \"eval\\t\", " & "repr(" & exp & ")" - evalNim(echoExp.parseString, makeStdinModule()) - -proc CommandPretty = - var projectFile = addFileExt(mainCommandArg(), NimExt) - var module = parseFile(projectFile.fileInfoIdx) - if module != nil: - renderModule(module, getOutFile(mainCommandArg(), "pretty." & NimExt)) - -proc CommandScan = - var f = addFileExt(mainCommandArg(), nimExt) - var stream = LLStreamOpen(f, fmRead) - if stream != nil: - var - L: TLexer - tok: TToken - initToken(tok) - openLexer(L, f, stream) - while true: + 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(AbsoluteFile mainCommandArg(config), NimExt) + var stream = llStreamOpen(f, fmRead) + if stream != nil: + var + L: Lexer = default(Lexer) + tok: Token = default(Token) + openLexer(L, f, stream, cache, config) + while true: rawGetTok(L, tok) - PrintTok(tok) - if tok.tokType == tkEof: break - CloseLexer(L) - else: - rawMessage(errCannotOpenFile, f) - -proc CommandSuggest = - if isServing: - # XXX: hacky work-around ahead - # Currently, it's possible to issue a idetools command, before - # issuing the first compile command. This will leave the compiler - # cache in a state where "no recompilation is necessary", but the - # cgen pass was never executed at all. - CommandCompileToC() - if gDirtyBufferIdx != 0: - discard compileModule(gDirtyBufferIdx, {sfDirty}) - resetModule(gDirtyBufferIdx) - if optDef in gGlobalOptions: - defFromSourceMap(optTrackPos) + printTok(config, tok) + if tok.tokType == tkEof: break + closeLexer(L) else: - msgs.gErrorMax = high(int) # do not stop after first error - semanticPasses() - rodPass() - compileProject() - -proc wantMainModule = - if gProjectFull.len == 0: - if optMainModule.len == 0: - Fatal(gCmdLineInfo, errCommandExpectsFilename) - else: - gProjectName = optMainModule - gProjectFull = gProjectPath / gProjectName - - gProjectMainIdx = addFileExt(gProjectFull, nimExt).fileInfoIdx + rawMessage(config, errGenerated, "cannot open file: " & f.string) -proc requireMainModuleOption = - if optMainModule.len == 0: - Fatal(gCmdLineInfo, errMainModuleMustBeSpecified) - else: - gProjectName = optMainModule - gProjectFull = gProjectPath / gProjectName - - gProjectMainIdx = addFileExt(gProjectFull, nimExt).fileInfoIdx - -proc resetMemory = - resetCompilationLists() - ccgutils.resetCaches() - resetAllModules() - resetRopeCache() - resetSysTypes() - gOwners = @[] - rangeDestructorProc = nil - for i in low(buckets)..high(buckets): - buckets[i] = nil - idAnon = nil - - # XXX: clean these global vars - # ccgstmts.gBreakpoints - # ccgthreadvars.nimtv - # ccgthreadvars.nimtVDeps - # ccgthreadvars.nimtvDeclared - # cgendata - # cgmeth? - # condsyms? - # depends? - # lexer.gLinesCompiled - # msgs - error counts - # magicsys, when system.nim changes - # rodread.rodcompilerProcs - # rodread.gTypeTable - # rodread.gMods - - # !! ropes.cache - # semthreads.computed? - # - # suggest.usageSym - # - # XXX: can we run out of IDs? - # XXX: detect config reloading (implement as error/require restart) - # XXX: options are appended (they will accumulate over time) - # vis = visimpl - when compileOption("gc", "v2"): - gcDebugging = true - echo "COLLECT 1" - GC_fullCollect() - echo "COLLECT 2" - GC_fullCollect() - echo "COLLECT 3" - GC_fullCollect() - echo GC_getStatistics() +proc commandView(graph: ModuleGraph) = + let f = toAbsolute(mainCommandArg(graph.config), AbsoluteDir getCurrentDir()).addFileExt(RodExt) + rodViewer(f, graph.config, graph.cache) const - SimiluateCaasMemReset = false PrintRopeCacheStats = false -proc MainCommand = - when SimiluateCaasMemReset: - gGlobalOptions.incl(optCaasEnabled) - - # In "nimrod serve" scenario, each command must reset the registered passes - clearPasses() - gLastCmdTime = epochTime() - appendStr(searchPaths, options.libpath) - if gProjectFull.len != 0: - # current path is always looked first for modules - prependStr(searchPaths, gProjectPath) - setID(100) - passes.gIncludeFile = includeModule - passes.gImportModule = importModule - case command.normalize - of "c", "cc", "compile", "compiletoc": - # compile means compileToC currently - gCmd = cmdCompileToC - wantMainModule() - CommandCompileToC() - of "cpp", "compiletocpp": - extccomp.cExt = ".cpp" - gCmd = cmdCompileToCpp - if cCompiler == ccGcc: setCC("gpp") - wantMainModule() - DefineSymbol("cpp") - CommandCompileToC() - of "objc", "compiletooc": - extccomp.cExt = ".m" - gCmd = cmdCompileToOC - wantMainModule() - DefineSymbol("objc") - CommandCompileToC() - of "run": - gCmd = cmdRun - wantMainModule() +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 + + conf.lastCmdTime = epochTime() + conf.searchPaths.add(conf.libpath) + + 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() - else: - rawMessage(errInvalidCommandX, command) - of "js", "compiletojs": - gCmd = cmdCompileToJS - wantMainModule() - CommandCompileToJS() - of "compiletollvm": - gCmd = cmdCompileToLLVM - wantMainModule() - when has_LLVM_Backend: - CommandCompileToLLVM() + 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 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: - rawMessage(errInvalidCommandX, command) - of "pretty": - gCmd = cmdPretty - wantMainModule() - CommandPretty() - of "doc": - gCmd = cmdDoc - LoadConfigs(DocConfig) - wantMainModule() - CommandDoc() - of "doc2": - gCmd = cmdDoc - LoadConfigs(DocConfig) - wantMainModule() - DefineSymbol("nimdoc") - CommandDoc2() - of "rst2html": - gCmd = cmdRst2html - LoadConfigs(DocConfig) - wantMainModule() - CommandRst2Html() - of "rst2tex": - gCmd = cmdRst2tex - LoadConfigs(DocTexConfig) - wantMainModule() - CommandRst2TeX() - of "buildindex": - gCmd = cmdDoc - LoadConfigs(DocConfig) - CommandBuildIndex() - of "gendepend": - gCmd = cmdGenDepend - wantMainModule() - CommandGenDepend() - of "dump": - gcmd = cmdDump - if getconfigvar("dump.format") == "json": - requireMainModuleOption() + 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) var definedSymbols = newJArray() - for s in definedSymbolNames(): definedSymbols.elems.add(%s) + for s in definedSymbolNames(conf.symbols): definedSymbols.elems.add(%s) var libpaths = newJArray() - for dir in itersearchpath(searchpaths): libpaths.elems.add(%dir) - - var dumpdata = % [ + var lazyPaths = newJArray() + for dir in conf.searchPaths: libpaths.elems.add(%dir.string) + for dir in conf.lazyPaths: lazyPaths.elems.add(%dir.string) + + var hints = newJObject() # consider factoring with `listHints` + for a in hintMin..hintMax: + hints[$a] = %(a in conf.notes) + var warnings = newJObject() + for a in warnMin..warnMax: + warnings[$a] = %(a in conf.notes) + + var dumpdata = %[ (key: "version", val: %VersionAsString), - (key: "project_path", val: %gProjectFull), + (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), ] - outWriteLn($dumpdata) - else: - outWriteLn("-- list of currently defined symbols --") - for s in definedSymbolNames(): outWriteLn(s) - outWriteLn("-- end of list --") - - for it in iterSearchPath(searchpaths): msgWriteLn(it) - of "check": - gCmd = cmdCheck - wantMainModule() - CommandCheck() - of "parse": - gCmd = cmdParse - wantMainModule() - discard parseFile(gProjectMainIdx) - of "scan": - gCmd = cmdScan - wantMainModule() - CommandScan() - MsgWriteln("Beware: Indentation tokens depend on the parser\'s state!") - of "i": - gCmd = cmdInteractive - CommandInteractive() - of "e": - # XXX: temporary command for easier testing - commandEval(mainCommandArg()) - of "reset": - resetMemory() - of "idetools": - gCmd = cmdIdeTools - if gEvalExpr != "": - commandEval(gEvalExpr) + msgWriteln(conf, $dumpdata, {msgStdout, msgSkipHook, msgNoUnitSep}) + # `msgNoUnitSep` to avoid generating invalid json, refs bug #17853 else: - wantMainModule() - CommandSuggest() - of "serve": - isServing = true - gGlobalOptions.incl(optCaasEnabled) - msgs.gErrorMax = high(int) # do not stop after first error - serve(MainCommand) - else: - rawMessage(errInvalidCommandX, command) - - if msgs.gErrorCounter == 0 and gCmd notin {cmdInterpret, cmdRun, cmdDump}: - rawMessage(hintSuccessX, [$gLinesCompiled, - formatFloat(epochTime() - gLastCmdTime, ffDecimal, 3), - formatSize(getTotalMem())]) + msgWriteln(conf, "-- list of currently defined symbols --", + {msgStdout, msgSkipHook, msgNoUnitSep}) + for s in definedSymbolNames(conf.symbols): msgWriteln(conf, s, {msgStdout, msgSkipHook, msgNoUnitSep}) + msgWriteln(conf, "-- end of list --", {msgStdout, msgSkipHook}) + + for 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 cmdParse: + wantMainModule(conf) + discard parseFile(conf.projectMainIdx, cache, conf) + of cmdRod: + wantMainModule(conf) + 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) + of cmdUnknown, cmdNone, cmdIdeTools: + rawMessage(conf, errGenerated, "invalid command: " & conf.command) + + 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: " echo " tries : ", gCacheTries echo " misses: ", gCacheMisses echo " int tries: ", gCacheIntTries - echo " efficiency: ", formatFloat(1-(gCacheMisses.float/gCacheTries.float), ffDecimal, 3) - - when SimiluateCaasMemReset: - resetMemory() - + echo " efficiency: ", formatFloat(1-(gCacheMisses.float/gCacheTries.float), + ffDecimal, 3) 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 new file mode 100644 index 000000000..77762d23a --- /dev/null +++ b/compiler/modulegraphs.nim @@ -0,0 +1,779 @@ +# +# +# 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 module graph data structure. The module graph +## represents a complete Nim project. Single modules can either be kept in RAM +## 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 + 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 + # module dependencies. + backend*: RootRef # minor hack so that a backend can extend this easily + config*: ConfigRef + cache*: IdentCache + vm*: RootRef # unfortunately the 'vm' state is shared project-wise, this will + # be clarified in later compiler implementations. + repl*: RootRef # REPL state is shared project-wise. + doStopCompile*: proc(): bool {.closure.} + usageSym*: PSym # for nimsuggest + owners*: seq[PSym] + suggestSymbols*: SuggestSymbolDatabase + suggestErrors*: Table[FileIndex, seq[Suggest]] + methods*: seq[tuple[methods: seq[PSym], dispatcher: PSym]] # needs serialization! + bucketTable*: CountTable[ItemId] + objectTree*: Table[ItemId, seq[tuple[depth: int, value: PType]]] + methodsPerType*: Table[ItemId, seq[LazySym]] + dispatchers*: seq[LazySym] + + systemModule*: PSym + sysTypes*: array[TTypeKind, PType] + compilerprocs*: TStrTable + exposed*: TStrTable + packageTypes*: TStrTable + emptyNode*: PNode + 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.} + 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.} + +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 = g.doStopCompile != nil and g.doStopCompile() + +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 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.importDeps = initTable[FileIndex, seq[FileIndex]]() + result.ifaces = @[] + result.importStack = @[] + result.inclToMod = initTable[FileIndex, FileIndex]() + result.owners = @[] + result.suggestSymbols = initTable[FileIndex, SuggestFileSymbolDatabase]() + result.suggestErrors = initTable[FileIndex, seq[Suggest]]() + result.methods = @[] + result.compilerprocs = initStrTable() + result.exposed = initStrTable() + result.packageTypes = initStrTable() + result.emptyNode = newNode(nkEmpty) + 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) = + 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 = + 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 + 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) = + 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 < g.ifaces.len and g.ifaces[fileIdx.int32].module != nil: + result = fileIdx + else: + result = g.inclToMod.getOrDefault(fileIdx) + +proc transitiveClosure(g: var IntSet; n: int) = + # warshall's algorithm + for k in 0..<n: + for i in 0..<n: + for j in 0..<n: + if i != j and not g.contains(i.dependsOn(j)): + if g.contains(i.dependsOn(k)) and g.contains(k.dependsOn(j)): + g.incl i.dependsOn(j) + +proc markDirty*(g: ModuleGraph; fileIdx: FileIndex) = + 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 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..<g.ifaces.len.int32: + if g.deps.contains(i.dependsOn(fileIdx.int)): + g.markDirty(FileIndex(i)) + +proc needsCompilation*(g: ModuleGraph): bool = + # every module that *depends* on this file is also dirty: + result = false + for i in 0i32..<g.ifaces.len.int32: + let m = g.ifaces[i].module + if m != nil: + 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 new file mode 100644 index 000000000..c9e6060e5 --- /dev/null +++ b/compiler/modulepaths.nim @@ -0,0 +1,95 @@ +# +# +# The Nim Compiler +# (c) Copyright 2017 Contributors +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +import ast, renderer, msgs, options, idents, lineinfos, + pathutils + +import std/[strutils, os] + +proc getModuleName*(conf: ConfigRef; n: PNode): string = + # This returns a short relative module name without the nim extension + # e.g. like "system", "importer" or "somepath/module" + # The proc won't perform any checks that the path is actually valid + case n.kind + of nkStrLit, nkRStrLit, nkTripleStrLit: + try: + result = pathSubs(conf, n.strVal, toFullPath(conf, n.info).splitFile().dir) + except ValueError: + localError(conf, n.info, "invalid path: " & n.strVal) + result = n.strVal + of nkIdent: + result = n.ident.s + of nkSym: + result = n.sym.name.s + of nkInfix: + let n0 = n[0] + let n1 = n[1] + when false: + if n1.kind == nkPrefix and n1[0].kind == nkIdent and n1[0].ident.s == "$": + if n0.kind == nkIdent and n0.ident.s == "/": + result = lookupPackage(n1[1], n[2]) + else: + localError(n.info, "only '/' supported with $package notation") + result = "" + else: + if n0.kind in nkIdentKinds: + let ident = n0.getPIdent + if ident != nil and ident.s[0] == '/': + let modname = getModuleName(conf, n[2]) + # hacky way to implement 'x / y /../ z': + result = getModuleName(conf, n1) + result.add renderTree(n0, {renderNoComments}).replace(" ") + result.add modname + else: + result = "" + else: + result = "" + of nkPrefix: + when false: + if n[0].kind == nkIdent and n[0].ident.s == "$": + 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[0]) + else: + localError(conf, n.info, "invalid module name: '$1'" % n.renderTree) + result = "" + +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.isEmpty: + if doLocalError: + let m = if modulename.len > 0: modulename else: $n + localError(conf, n.info, "cannot open file: " & m) + 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 new file mode 100644 index 000000000..6e2af8bcc --- /dev/null +++ b/compiler/modules.nim @@ -0,0 +1,63 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Implements the module handling, including the caching of modules. + +import + 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) + +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 + +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 = + result = syntaxes.parseFile(fileIdx, graph.cache, graph.config) + graph.addDep(s, fileIdx) + graph.addIncludeDep(s.position.FileIndex, fileIdx) + let path = toFullPath(graph.config, fileIdx) + graph.cachedFiles[path] = $secureHashFile(path) + +proc wantMainModule*(conf: ConfigRef) = + if conf.projectFull.isEmpty: + fatal(conf, gCmdLineInfo, "command expects a filename") + conf.projectMainIdx = fileInfoIdx(conf, addFileExt(conf.projectFull, NimExt)) + +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 = makeModule(graph, AbsoluteFile filename) + +proc makeStdinModule*(graph: ModuleGraph): PSym = graph.makeModule(AbsoluteFile"stdin") diff --git a/compiler/msgs.nim b/compiler/msgs.nim index 711a3c733..c49ca8c9b 100644 --- a/compiler/msgs.nim +++ b/compiler/msgs.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2013 Andreas Rumpf # # See the file "copying.txt", included in this @@ -8,819 +8,716 @@ # import - options, strutils, os, tables, sockets, ropes, platform - -type - TMsgKind* = enum - errUnknown, errIllFormedAstX, errInternal, errCannotOpenFile, errGenerated, - errXCompilerDoesNotSupportCpp, errStringLiteralExpected, - errIntLiteralExpected, errInvalidCharacterConstant, - errClosingTripleQuoteExpected, errClosingQuoteExpected, - errTabulatorsAreNotAllowed, errInvalidToken, errLineTooLong, - errInvalidNumber, errNumberOutOfRange, errNnotAllowedInCharacter, - errClosingBracketExpected, errMissingFinalQuote, errIdentifierExpected, - errNewlineExpected, - errInvalidModuleName, - errOperatorExpected, errTokenExpected, errStringAfterIncludeExpected, - errRecursiveDependencyX, errOnOrOffExpected, errNoneSpeedOrSizeExpected, - errInvalidPragma, errUnknownPragma, errInvalidDirectiveX, - errAtPopWithoutPush, errEmptyAsm, errInvalidIndentation, - errExceptionExpected, errExceptionAlreadyHandled, - errYieldNotAllowedHere, errYieldNotAllowedInTryStmt, - errInvalidNumberOfYieldExpr, errCannotReturnExpr, errAttemptToRedefine, - errStmtInvalidAfterReturn, errStmtExpected, errInvalidLabel, - errInvalidCmdLineOption, errCmdLineArgExpected, errCmdLineNoArgExpected, - errInvalidVarSubstitution, errUnknownVar, errUnknownCcompiler, - errOnOrOffExpectedButXFound, errNoneBoehmRefcExpectedButXFound, - errNoneSpeedOrSizeExpectedButXFound, errGuiConsoleOrLibExpectedButXFound, - errUnknownOS, errUnknownCPU, errGenOutExpectedButXFound, - errArgsNeedRunOption, errInvalidMultipleAsgn, errColonOrEqualsExpected, - errExprExpected, errUndeclaredIdentifier, errUseQualifier, errTypeExpected, - errSystemNeeds, errExecutionOfProgramFailed, errNotOverloadable, - errInvalidArgForX, errStmtHasNoEffect, errXExpectsTypeOrValue, - errXExpectsArrayType, errIteratorCannotBeInstantiated, errExprXAmbiguous, - errConstantDivisionByZero, errOrdinalTypeExpected, - errOrdinalOrFloatTypeExpected, errOverOrUnderflow, - errCannotEvalXBecauseIncompletelyDefined, errChrExpectsRange0_255, - errDynlibRequiresExportc, errUndeclaredFieldX, errNilAccess, - errIndexOutOfBounds, errIndexTypesDoNotMatch, errBracketsInvalidForType, - errValueOutOfSetBounds, errFieldInitTwice, errFieldNotInit, - errExprXCannotBeCalled, errExprHasNoType, errExprXHasNoType, - errCastNotInSafeMode, errExprCannotBeCastedToX, errCommaOrParRiExpected, - errCurlyLeOrParLeExpected, errSectionExpected, errRangeExpected, - errMagicOnlyInSystem, errPowerOfTwoExpected, - errStringMayNotBeEmpty, errCallConvExpected, errProcOnlyOneCallConv, - errSymbolMustBeImported, errExprMustBeBool, errConstExprExpected, - errDuplicateCaseLabel, errRangeIsEmpty, errSelectorMustBeOfCertainTypes, - errSelectorMustBeOrdinal, errOrdXMustNotBeNegative, errLenXinvalid, - errWrongNumberOfVariables, errExprCannotBeRaised, errBreakOnlyInLoop, - errTypeXhasUnknownSize, errConstNeedsConstExpr, errConstNeedsValue, - errResultCannotBeOpenArray, errSizeTooBig, errSetTooBig, - errBaseTypeMustBeOrdinal, errInheritanceOnlyWithNonFinalObjects, - errInheritanceOnlyWithEnums, errIllegalRecursionInTypeX, - errCannotInstantiateX, errExprHasNoAddress, errXStackEscape, - errVarForOutParamNeeded, - errPureTypeMismatch, errTypeMismatch, errButExpected, errButExpectedX, - errAmbiguousCallXYZ, errWrongNumberOfArguments, - errXCannotBePassedToProcVar, - errXCannotBeInParamDecl, errPragmaOnlyInHeaderOfProc, errImplOfXNotAllowed, - errImplOfXexpected, errNoSymbolToBorrowFromFound, errDiscardValue, - errInvalidDiscard, errIllegalConvFromXtoY, errCannotBindXTwice, - errInvalidOrderInArrayConstructor, - errInvalidOrderInEnumX, errEnumXHasHoles, errExceptExpected, errInvalidTry, - errOptionExpected, errXisNoLabel, errNotAllCasesCovered, - errUnkownSubstitionVar, errComplexStmtRequiresInd, errXisNotCallable, - errNoPragmasAllowedForX, errNoGenericParamsAllowedForX, - errInvalidParamKindX, errDefaultArgumentInvalid, errNamedParamHasToBeIdent, - errNoReturnTypeForX, errConvNeedsOneArg, errInvalidPragmaX, - errXNotAllowedHere, errInvalidControlFlowX, - errXisNoType, errCircumNeedsPointer, errInvalidExpression, - errInvalidExpressionX, errEnumHasNoValueX, errNamedExprExpected, - errNamedExprNotAllowed, errXExpectsOneTypeParam, - errArrayExpectsTwoTypeParams, errInvalidVisibilityX, errInitHereNotAllowed, - errXCannotBeAssignedTo, errIteratorNotAllowed, errXNeedsReturnType, - errNoReturnTypeDeclared, - errInvalidCommandX, errXOnlyAtModuleScope, - errXNeedsParamObjectType, - errTemplateInstantiationTooNested, errInstantiationFrom, - errInvalidIndexValueForTuple, errCommandExpectsFilename, - errMainModuleMustBeSpecified, - errXExpected, - errInvalidSectionStart, errGridTableNotImplemented, errGeneralParseError, - errNewSectionExpected, errWhitespaceExpected, errXisNoValidIndexFile, - errCannotRenderX, errVarVarTypeNotAllowed, errInstantiateXExplicitely, - - errXExpectsTwoArguments, - errXExpectsObjectTypes, errXcanNeverBeOfThisSubtype, errTooManyIterations, - errCannotInterpretNodeX, errFieldXNotFound, errInvalidConversionFromTypeX, - errAssertionFailed, errCannotGenerateCodeForX, errXRequiresOneArgument, - errUnhandledExceptionX, errCyclicTree, errXisNoMacroOrTemplate, - errXhasSideEffects, errIteratorExpected, errLetNeedsInit, - errThreadvarCannotInit, errWrongSymbolX, errIllegalCaptureX, - errXCannotBeClosure, errXMustBeCompileTime, - errUser, - warnCannotOpenFile, - warnOctalEscape, warnXIsNeverRead, warnXmightNotBeenInit, - warnDeprecated, warnConfigDeprecated, - warnSmallLshouldNotBeUsed, warnUnknownMagic, warnRedefinitionOfLabel, - warnUnknownSubstitutionX, warnLanguageXNotSupported, warnCommentXIgnored, - warnNilStatement, warnAnalysisLoophole, - warnDifferentHeaps, warnWriteToForeignHeap, warnImplicitClosure, - warnEachIdentIsTuple, warnShadowIdent, - warnProveInit, warnProveField, warnProveIndex, - warnUninit, warnUser, - hintSuccess, hintSuccessX, - hintLineTooLong, hintXDeclaredButNotUsed, hintConvToBaseNotNeeded, - hintConvFromXtoItselfNotNeeded, hintExprAlwaysX, hintQuitCalled, - hintProcessing, hintCodeBegin, hintCodeEnd, hintConf, hintPath, - hintConditionAlwaysTrue, hintPattern, - hintUser - -const - MsgKindToStr*: array[TMsgKind, string] = [ - errUnknown: "unknown error", - errIllFormedAstX: "illformed AST: $1", - errInternal: "internal error: $1", - errCannotOpenFile: "cannot open \'$1\'", - errGenerated: "$1", - errXCompilerDoesNotSupportCpp: "\'$1\' compiler does not support C++", - errStringLiteralExpected: "string literal expected", - errIntLiteralExpected: "integer literal expected", - errInvalidCharacterConstant: "invalid character constant", - errClosingTripleQuoteExpected: "closing \"\"\" expected, but end of file reached", - errClosingQuoteExpected: "closing \" expected", - errTabulatorsAreNotAllowed: "tabulators are not allowed", - errInvalidToken: "invalid token: $1", - errLineTooLong: "line too long", - errInvalidNumber: "$1 is not a valid number", - errNumberOutOfRange: "number $1 out of valid range", - errNnotAllowedInCharacter: "\\n not allowed in character literal", - errClosingBracketExpected: "closing ']' expected, but end of file reached", - errMissingFinalQuote: "missing final \' for character literal", - errIdentifierExpected: "identifier expected, but found \'$1\'", - errNewlineExpected: "newline expected, but found \'$1\'", - errInvalidModuleName: "invalid module name: '$1'", - errOperatorExpected: "operator expected, but found \'$1\'", - errTokenExpected: "\'$1\' expected", - errStringAfterIncludeExpected: "string after \'include\' expected", - errRecursiveDependencyX: "recursive dependency: \'$1\'", - errOnOrOffExpected: "\'on\' or \'off\' expected", - errNoneSpeedOrSizeExpected: "\'none\', \'speed\' or \'size\' expected", - errInvalidPragma: "invalid pragma", - errUnknownPragma: "unknown pragma: \'$1\'", - errInvalidDirectiveX: "invalid directive: \'$1\'", - errAtPopWithoutPush: "\'pop\' without a \'push\' pragma", - errEmptyAsm: "empty asm statement", - errInvalidIndentation: "invalid indentation", - errExceptionExpected: "exception expected", - errExceptionAlreadyHandled: "exception already handled", - errYieldNotAllowedHere: "'yield' only allowed in an iterator", - errYieldNotAllowedInTryStmt: "'yield' cannot be used within 'try' in a non-inlined iterator", - errInvalidNumberOfYieldExpr: "invalid number of \'yield\' expressions", - errCannotReturnExpr: "current routine cannot return an expression", - errAttemptToRedefine: "redefinition of \'$1\'", - errStmtInvalidAfterReturn: "statement not allowed after \'return\', \'break\' or \'raise\'", - errStmtExpected: "statement expected", - errInvalidLabel: "\'$1\' is no label", - errInvalidCmdLineOption: "invalid command line option: \'$1\'", - errCmdLineArgExpected: "argument for command line option expected: \'$1\'", - errCmdLineNoArgExpected: "invalid argument for command line option: \'$1\'", - errInvalidVarSubstitution: "invalid variable substitution in \'$1\'", - errUnknownVar: "unknown variable: \'$1\'", - errUnknownCcompiler: "unknown C compiler: \'$1\'", - errOnOrOffExpectedButXFound: "\'on\' or \'off\' expected, but \'$1\' found", - errNoneBoehmRefcExpectedButXFound: "'none', 'boehm' or 'refc' expected, but '$1' found", - errNoneSpeedOrSizeExpectedButXFound: "'none', 'speed' or 'size' expected, but '$1' found", - errGuiConsoleOrLibExpectedButXFound: "'gui', 'console' or 'lib' expected, but '$1' found", - errUnknownOS: "unknown OS: '$1'", - errUnknownCPU: "unknown CPU: '$1'", - errGenOutExpectedButXFound: "'c', 'c++' or 'yaml' expected, but '$1' found", - errArgsNeedRunOption: "arguments can only be given if the '--run' option is selected", - errInvalidMultipleAsgn: "multiple assignment is not allowed", - errColonOrEqualsExpected: "\':\' or \'=\' expected, but found \'$1\'", - errExprExpected: "expression expected, but found \'$1\'", - errUndeclaredIdentifier: "undeclared identifier: \'$1\'", - errUseQualifier: "ambiguous identifier: \'$1\' -- use a qualifier", - errTypeExpected: "type expected", - errSystemNeeds: "system module needs \'$1\'", - errExecutionOfProgramFailed: "execution of an external program failed", - errNotOverloadable: "overloaded \'$1\' leads to ambiguous calls", - errInvalidArgForX: "invalid argument for \'$1\'", - errStmtHasNoEffect: "statement has no effect", - errXExpectsTypeOrValue: "\'$1\' expects a type or value", - errXExpectsArrayType: "\'$1\' expects an array type", - errIteratorCannotBeInstantiated: "'$1' cannot be instantiated because its body has not been compiled yet", - errExprXAmbiguous: "expression '$1' ambiguous in this context", - errConstantDivisionByZero: "constant division by zero", - errOrdinalTypeExpected: "ordinal type expected", - errOrdinalOrFloatTypeExpected: "ordinal or float type expected", - errOverOrUnderflow: "over- or underflow", - errCannotEvalXBecauseIncompletelyDefined: "cannot evalutate '$1' because type is not defined completely", - errChrExpectsRange0_255: "\'chr\' expects an int in the range 0..255", - errDynlibRequiresExportc: "\'dynlib\' requires \'exportc\'", - errUndeclaredFieldX: "undeclared field: \'$1\'", - errNilAccess: "attempt to access a nil address", - errIndexOutOfBounds: "index out of bounds", - errIndexTypesDoNotMatch: "index types do not match", - errBracketsInvalidForType: "\'[]\' operator invalid for this type", - errValueOutOfSetBounds: "value out of set bounds", - errFieldInitTwice: "field initialized twice: \'$1\'", - errFieldNotInit: "field \'$1\' not initialized", - errExprXCannotBeCalled: "expression \'$1\' cannot be called", - errExprHasNoType: "expression has no type", - errExprXHasNoType: "expression \'$1\' has no type (or is ambiguous)", - errCastNotInSafeMode: "\'cast\' not allowed in safe mode", - errExprCannotBeCastedToX: "expression cannot be casted to $1", - errCommaOrParRiExpected: "',' or ')' expected", - errCurlyLeOrParLeExpected: "\'{\' or \'(\' expected", - errSectionExpected: "section (\'type\', \'proc\', etc.) expected", - errRangeExpected: "range expected", - errMagicOnlyInSystem: "\'magic\' only allowed in system module", - errPowerOfTwoExpected: "power of two expected", - errStringMayNotBeEmpty: "string literal may not be empty", - errCallConvExpected: "calling convention expected", - errProcOnlyOneCallConv: "a proc can only have one calling convention", - errSymbolMustBeImported: "symbol must be imported if 'lib' pragma is used", - errExprMustBeBool: "expression must be of type 'bool'", - errConstExprExpected: "constant expression expected", - errDuplicateCaseLabel: "duplicate case label", - errRangeIsEmpty: "range is empty", - errSelectorMustBeOfCertainTypes: "selector must be of an ordinal type, float or string", - errSelectorMustBeOrdinal: "selector must be of an ordinal type", - errOrdXMustNotBeNegative: "ord($1) must not be negative", - errLenXinvalid: "len($1) must be less than 32768", - errWrongNumberOfVariables: "wrong number of variables", - errExprCannotBeRaised: "only a 'ref object' can be raised", - errBreakOnlyInLoop: "'break' only allowed in loop construct", - errTypeXhasUnknownSize: "type \'$1\' has unknown size", - errConstNeedsConstExpr: "a constant can only be initialized with a constant expression", - errConstNeedsValue: "a constant needs a value", - errResultCannotBeOpenArray: "the result type cannot be on open array", - errSizeTooBig: "computing the type\'s size produced an overflow", - errSetTooBig: "set is too large", - errBaseTypeMustBeOrdinal: "base type of a set must be an ordinal", - errInheritanceOnlyWithNonFinalObjects: "inheritance only works with non-final objects", - errInheritanceOnlyWithEnums: "inheritance only works with an enum", - errIllegalRecursionInTypeX: "illegal recursion in type \'$1\'", - errCannotInstantiateX: "cannot instantiate: \'$1\'", - errExprHasNoAddress: "expression has no address", - errXStackEscape: "address of '$1' may not escape its stack frame", - errVarForOutParamNeeded: "for a \'var\' type a variable needs to be passed", - errPureTypeMismatch: "type mismatch", - errTypeMismatch: "type mismatch: got (", - errButExpected: "but expected one of: ", - errButExpectedX: "but expected \'$1\'", - errAmbiguousCallXYZ: "ambiguous call; both $1 and $2 match for: $3", - errWrongNumberOfArguments: "wrong number of arguments", - errXCannotBePassedToProcVar: "\'$1\' cannot be passed to a procvar", - errXCannotBeInParamDecl: "$1 cannot be declared in parameter declaration", - errPragmaOnlyInHeaderOfProc: "pragmas are only allowed in the header of a proc", - errImplOfXNotAllowed: "implementation of \'$1\' is not allowed", - errImplOfXexpected: "implementation of \'$1\' expected", - errNoSymbolToBorrowFromFound: "no symbol to borrow from found", - errDiscardValue: "value returned by statement has to be discarded", - errInvalidDiscard: "statement returns no value that can be discarded", - errIllegalConvFromXtoY: "conversion from $1 to $2 is invalid", - errCannotBindXTwice: "cannot bind parameter \'$1\' twice", - errInvalidOrderInArrayConstructor: "invalid order in array constructor", - errInvalidOrderInEnumX: "invalid order in enum \'$1\'", - errEnumXHasHoles: "enum \'$1\' has holes", - errExceptExpected: "\'except\' or \'finally\' expected", - errInvalidTry: "after catch all \'except\' or \'finally\' no section may follow", - errOptionExpected: "option expected, but found \'$1\'", - errXisNoLabel: "\'$1\' is not a label", - errNotAllCasesCovered: "not all cases are covered", - errUnkownSubstitionVar: "unknown substitution variable: \'$1\'", - errComplexStmtRequiresInd: "complex statement requires indentation", - errXisNotCallable: "\'$1\' is not callable", - errNoPragmasAllowedForX: "no pragmas allowed for $1", - errNoGenericParamsAllowedForX: "no generic parameters allowed for $1", - errInvalidParamKindX: "invalid param kind: \'$1\'", - errDefaultArgumentInvalid: "default argument invalid", - errNamedParamHasToBeIdent: "named parameter has to be an identifier", - errNoReturnTypeForX: "no return type allowed for $1", - errConvNeedsOneArg: "a type conversion needs exactly one argument", - errInvalidPragmaX: "invalid pragma: $1", - errXNotAllowedHere: "$1 not allowed here", - errInvalidControlFlowX: "invalid control flow: $1", - errXisNoType: "invalid type: \'$1\'", - errCircumNeedsPointer: "'[]' needs a pointer or reference type", - errInvalidExpression: "invalid expression", - errInvalidExpressionX: "invalid expression: \'$1\'", - errEnumHasNoValueX: "enum has no value \'$1\'", - errNamedExprExpected: "named expression expected", - errNamedExprNotAllowed: "named expression not allowed here", - 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", - errNoReturnTypeDeclared: "no return type declared", - errInvalidCommandX: "invalid command: \'$1\'", - errXOnlyAtModuleScope: "\'$1\' is only allowed at top level", - errXNeedsParamObjectType: "'$1' needs a parameter that has an object type", - errTemplateInstantiationTooNested: "template/macro instantiation too nested", - errInstantiationFrom: "instantiation from here", - errInvalidIndexValueForTuple: "invalid index value for tuple subscript", - errCommandExpectsFilename: "command expects a filename argument", - errMainModuleMustBeSpecified: "please, specify a main module in the project configuration file", - errXExpected: "\'$1\' expected", - errInvalidSectionStart: "invalid section start", - errGridTableNotImplemented: "grid table is not implemented", - errGeneralParseError: "general parse error", - errNewSectionExpected: "new section expected", - errWhitespaceExpected: "whitespace expected, got \'$1\'", - errXisNoValidIndexFile: "\'$1\' is no valid index file", - errCannotRenderX: "cannot render reStructuredText element \'$1\'", - errVarVarTypeNotAllowed: "type \'var var\' is not allowed", - errInstantiateXExplicitely: "instantiate '$1' explicitely", - errXExpectsTwoArguments: "\'$1\' expects two arguments", - errXExpectsObjectTypes: "\'$1\' expects object types", - errXcanNeverBeOfThisSubtype: "\'$1\' can never be of this subtype", - errTooManyIterations: "interpretation requires too many iterations", - errCannotInterpretNodeX: "cannot evaluate \'$1\'", - errFieldXNotFound: "field \'$1\' cannot be found", - errInvalidConversionFromTypeX: "invalid conversion from type \'$1\'", - errAssertionFailed: "assertion failed", - errCannotGenerateCodeForX: "cannot generate code for \'$1\'", - errXRequiresOneArgument: "$1 requires one parameter", - errUnhandledExceptionX: "unhandled exception: $1", - errCyclicTree: "macro returned a cyclic abstract syntax tree", - errXisNoMacroOrTemplate: "\'$1\' is no macro or template", - errXhasSideEffects: "\'$1\' can have side effects", - errIteratorExpected: "iterator within for loop context expected", - errLetNeedsInit: "'let' symbol requires an initialization", - errThreadvarCannotInit: "a thread var cannot be initialized explicitly", - errWrongSymbolX: "usage of \'$1\' is a user-defined error", - errIllegalCaptureX: "illegal capture '$1'", - errXCannotBeClosure: "'$1' cannot have 'closure' calling convention", - errXMustBeCompileTime: "'$1' can only be used in compile-time context", - errUser: "$1", - warnCannotOpenFile: "cannot open \'$1\' [CannotOpenFile]", - warnOctalEscape: "octal escape sequences do not exist; leading zero is ignored [OctalEscape]", - warnXIsNeverRead: "\'$1\' is never read [XIsNeverRead]", - warnXmightNotBeenInit: "\'$1\' might not have been initialized [XmightNotBeenInit]", - warnDeprecated: "\'$1\' is deprecated [Deprecated]", - warnConfigDeprecated: "config file '$1' is deprecated [ConfigDeprecated]", - warnSmallLshouldNotBeUsed: "\'l\' should not be used as an identifier; may look like \'1\' (one) [SmallLshouldNotBeUsed]", - warnUnknownMagic: "unknown magic \'$1\' might crash the compiler [UnknownMagic]", - warnRedefinitionOfLabel: "redefinition of label \'$1\' [RedefinitionOfLabel]", - warnUnknownSubstitutionX: "unknown substitution \'$1\' [UnknownSubstitutionX]", - warnLanguageXNotSupported: "language \'$1\' not supported [LanguageXNotSupported]", - warnCommentXIgnored: "comment \'$1\' ignored [CommentXIgnored]", - warnNilStatement: "'nil' statement is deprecated; use an empty 'discard' statement instead [NilStmt]", - warnAnalysisLoophole: "thread analysis incomplete due to unknown call '$1' [AnalysisLoophole]", - warnDifferentHeaps: "possible inconsistency of thread local heaps [DifferentHeaps]", - warnWriteToForeignHeap: "write to foreign heap [WriteToForeignHeap]", - warnImplicitClosure: "implicit closure convention: '$1' [ImplicitClosure]", - warnEachIdentIsTuple: "each identifier is a tuple [EachIdentIsTuple]", - warnShadowIdent: "shadowed identifier: '$1' [ShadowIdent]", - warnProveInit: "Cannot prove that '$1' is initialized. This will become a compile time error in the future. [ProveInit]", - warnProveField: "cannot prove that field '$1' is accessible [ProveField]", - warnProveIndex: "cannot prove index '$1' is valid [ProveIndex]", - warnUninit: "'$1' might not have been initialized [Uninit]", - warnUser: "$1 [User]", - hintSuccess: "operation successful [Success]", - hintSuccessX: "operation successful ($# lines compiled; $# sec total; $#) [SuccessX]", - hintLineTooLong: "line too long [LineTooLong]", - hintXDeclaredButNotUsed: "\'$1\' is declared but not used [XDeclaredButNotUsed]", - hintConvToBaseNotNeeded: "conversion to base object is not needed [ConvToBaseNotNeeded]", - hintConvFromXtoItselfNotNeeded: "conversion from $1 to itself is pointless [ConvFromXtoItselfNotNeeded]", - hintExprAlwaysX: "expression evaluates always to \'$1\' [ExprAlwaysX]", - hintQuitCalled: "quit() called [QuitCalled]", - hintProcessing: "$1 [Processing]", - hintCodeBegin: "generated code listing: [CodeBegin]", - hintCodeEnd: "end of listing [CodeEnd]", - hintConf: "used config file \'$1\' [Conf]", - hintPath: "added path: '$1' [Path]", - hintConditionAlwaysTrue: "condition is always true: '$1' [CondTrue]", - hintPattern: "$1 [Pattern]", - hintUser: "$1 [User]"] + std/[strutils, os, tables, terminal, macros, times], + std/private/miscdollars, + options, lineinfos, pathutils -const - WarningsToStr*: array[0..23, string] = ["CannotOpenFile", "OctalEscape", - "XIsNeverRead", "XmightNotBeenInit", - "Deprecated", "ConfigDeprecated", - "SmallLshouldNotBeUsed", "UnknownMagic", - "RedefinitionOfLabel", "UnknownSubstitutionX", "LanguageXNotSupported", - "CommentXIgnored", "NilStmt", - "AnalysisLoophole", "DifferentHeaps", "WriteToForeignHeap", - "ImplicitClosure", "EachIdentIsTuple", "ShadowIdent", - "ProveInit", "ProveField", "ProveIndex", "Uninit", "User"] - - HintsToStr*: array[0..15, string] = ["Success", "SuccessX", "LineTooLong", - "XDeclaredButNotUsed", "ConvToBaseNotNeeded", "ConvFromXtoItselfNotNeeded", - "ExprAlwaysX", "QuitCalled", "Processing", "CodeBegin", "CodeEnd", "Conf", - "Path", "CondTrue", "Pattern", - "User"] - -const - fatalMin* = errUnknown - fatalMax* = errInternal - errMin* = errUnknown - errMax* = errUser - warnMin* = warnCannotOpenFile - warnMax* = pred(hintSuccess) - hintMin* = hintSuccess - hintMax* = high(TMsgKind) - -type - TNoteKind* = range[warnMin..hintMax] # "notes" are warnings or hints - TNoteKinds* = set[TNoteKind] - - TFileInfo*{.final.} = object - fullPath*: string # This is a canonical full filesystem path - projPath*: string # This is relative to the project's root - - quotedName*: PRope # cached quoted short name for codegen - # purpoes - - lines*: seq[PRope] # the source code of the module - # used for better error messages and - # embedding the original source in the - # generated code - - TLineInfo*{.final.} = object # This is designed to be as small as possible, - # because it is used - # in syntax nodes. We safe space here by using - # two int16 and an int32. - # On 64 bit and on 32 bit systems this is - # only 8 bytes. - line*, col*: int16 - fileIndex*: int32 - - ERecoverableError* = object of EInvalidValue - ESuggestDone* = object of EBase +import ropes except `%` -const - InvalidFileIDX* = int32(-1) +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] + + +type InstantiationInfo* = typeof(instantiationInfo()) +template instLoc*(): InstantiationInfo = instantiationInfo(-2, fullPaths = true) -var - filenameToIndexTbl = initTable[string, int32]() - fileInfos*: seq[TFileInfo] = @[] - SystemFileIdx*: int32 +template toStdOrrKind(stdOrr): untyped = + if stdOrr == stdout: stdOrrStdout else: stdOrrStderr -proc toCChar*(c: Char): string = +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', '\x80'..'\xFF': result = '\\' & toOctal(c) - of '\'', '\"', '\\': result = '\\' & c - else: result = $(c) - -proc makeCString*(s: string): PRope = - # BUGFIX: We have to split long strings into many ropes. Otherwise - # this could trigger an InternalError(). See the ropes module for - # further information. - const - MaxLineLength = 64 - result = nil - var res = "\"" - for i in countup(0, len(s) - 1): - if (i + 1) mod MaxLineLength == 0: - add(res, '\"') - add(res, tnl) - app(result, toRope(res)) # reset: - setlen(res, 1) - res[0] = '\"' - add(res, toCChar(s[i])) - add(res, '\"') - app(result, toRope(res)) - - -proc newFileInfo(fullPath, projPath: string): TFileInfo = - result.fullPath = fullPath - #shallow(result.fullPath) - result.projPath = projPath - #shallow(result.projPath) - result.quotedName = projPath.extractFilename.makeCString - if optEmbedOrigSrc in gGlobalOptions or true: - result.lines = @[] - -proc fileInfoIdx*(filename: string): int32 = + of '\0'..'\x1F', '\x7F'..'\xFF': + result.add '\\' + result.add toOctal(c) + of '\'', '\"', '\\', '?': + result.add '\\' + result.add c + else: + result.add c + +proc makeCString*(s: string): Rope = + 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 not result.fullPath.isEmpty: + try: + result.fullContent = readFile(result.fullPath.string) + except IOError: + #rawMessage(errCannotOpenFile, result.fullPath) + # XXX fixme + result.fullContent = "" + +when defined(nimpretty): + proc fileSection*(conf: ConfigRef; fid: FileIndex; a, b: int): string = + substr(conf.m.fileInfos[fid.int].fullContent, a, b) + +proc canonicalCase(path: var string) {.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: AbsoluteFile + try: + canon = canonicalizePath(conf, filename) + except OSError: + canon = filename + canon.string.canonicalCase + result = conf.m.filenameToIndexTbl.hasKey(canon.string) + +proc fileInfoIdx*(conf: ConfigRef; filename: AbsoluteFile; isKnownFile: var bool): FileIndex = var - canon: string + canon: AbsoluteFile pseudoPath = false try: - canon = canonicalizePath(filename) - shallow(canon) - except: + canon = canonicalizePath(conf, filename) + 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 filenameToIndexTbl.hasKey(canon): - result = filenameToIndexTbl[canon] + var canon2 = canon.string + canon2.canonicalCase + + if conf.m.filenameToIndexTbl.hasKey(canon2): + isKnownFile = true + result = conf.m.filenameToIndexTbl[canon2] else: - result = fileInfos.len.int32 - fileInfos.add(newFileInfo(canon, if pseudoPath: filename - else: canon.shortenDir)) - filenameToIndexTbl[canon] = result - -proc newLineInfo*(fileInfoIdx: int32, line, col: int): TLineInfo = - result.fileIndex = fileInfoIdx - result.line = int16(line) - result.col = int16(col) - -proc newLineInfo*(filename: string, line, col: int): TLineInfo {.inline.} = - result = newLineInfo(filename.fileInfoIdx, line, col) - -fileInfos.add(newFileInfo("", "command line")) -var gCmdLineInfo* = newLineInfo(int32(0), 1, 1) - -fileInfos.add(newFileInfo("", "compilation artifact")) -var gCodegenLineInfo* = newLineInfo(int32(1), 1, 1) - -proc raiseRecoverableError*(msg: string) {.noinline, noreturn.} = - raise newException(ERecoverableError, msg) - -proc sourceLine*(i: TLineInfo): PRope - -var - gNotes*: TNoteKinds = {low(TNoteKind)..high(TNoteKind)} - - {warnShadowIdent, warnUninit, - warnProveField, warnProveIndex} - gErrorCounter*: int = 0 # counts the number of errors - gHintCounter*: int = 0 - gWarnCounter*: int = 0 - gErrorMax*: int = 1 # stop after gErrorMax errors - gSilence*: int # == 0 if we produce any output at all - stdoutSocket*: TSocket - -proc SuggestWriteln*(s: string) = - if gSilence == 0: - if isNil(stdoutSocket): Writeln(stdout, s) - else: - Writeln(stdout, s) - stdoutSocket.send(s & "\c\L") - -proc SuggestQuit*() = - if not isServing: - quit(0) - elif isWorkingWithDirtyBuffer: - # No need to compile the rest if we are working with a - # throw-away buffer. Incomplete dot expressions frequently - # found in dirty buffers will result in errors few steps - # from now anyway. - raise newException(ESuggestDone, "suggest done") + isKnownFile = false + result = conf.m.fileInfos.len.FileIndex + conf.m.fileInfos.add(newFileInfo(canon, if pseudoPath: RelativeFile filename + else: relativeTo(canon, conf.projectPath))) + conf.m.filenameToIndexTbl[canon2] = result + +proc fileInfoIdx*(conf: ConfigRef; filename: AbsoluteFile): FileIndex = + var dummy: bool = 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 = 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: AbsoluteFile, line, col: int): TLineInfo {.inline.} = + result = newLineInfo(fileInfoIdx(conf, filename), line, col) + +const gCmdLineInfo* = newLineInfo(commandLineIdx, 1, 1) + +proc concat(strings: openArray[string]): string = + var totalLen = 0 + for s in strings: totalLen += s.len + result = newStringOfCap totalLen + for s in strings: result.add s + +proc suggestWriteln*(conf: ConfigRef; s: string) = + if eStdOut in conf.m.errorOutputs: + if isNil(conf.writelnHook): + writeLine(stdout, s) + flushFile(stdout) + else: + conf.writelnHook(s) + +proc msgQuit*(x: int8) = quit x +proc msgQuit*(x: string) = quit x + +proc suggestQuit*() = + raise newException(ESuggestDone, "suggest done") # this format is understood by many text editors: it is the same that # Borland and Freepascal use const - PosErrorFormat* = "$1($2, $3) Error: $4" - PosWarningFormat* = "$1($2, $3) Warning: $4" - PosHintFormat* = "$1($2, $3) Hint: $4" - PosContextFormat = "$1($2, $3) Info: $4" - RawErrorFormat* = "Error: $1" - RawWarningFormat* = "Warning: $1" - RawHintFormat* = "Hint: $1" - -proc UnknownLineInfo*(): TLineInfo = - result.line = int16(-1) - result.col = int16(-1) - result.fileIndex = -1 - -var - msgContext: seq[TLineInfo] = @[] - -proc getInfoContextLen*(): int = return msgContext.len -proc setInfoContextLen*(L: int) = setLen(msgContext, L) - -proc pushInfoContext*(info: TLineInfo) = - msgContext.add(info) - -proc popInfoContext*() = - setlen(msgContext, len(msgContext) - 1) - -proc getInfoContext*(index: int): TLineInfo = - let L = msgContext.len - let i = if index < 0: L + index else: index - if i >=% L: result = UnknownLineInfo() - else: result = msgContext[i] - -proc toFilename*(fileIdx: int32): string = - if fileIdx < 0: result = "???" - else: result = fileInfos[fileIdx].projPath - -proc toFullPath*(fileIdx: int32): string = - if fileIdx < 0: result = "???" - else: result = fileInfos[fileIdx].fullPath - -template toFilename*(info: TLineInfo): string = - info.fileIndex.toFilename - -template toFullPath*(info: TLineInfo): string = - info.fileIndex.toFullPath - -proc toMsgFilename*(info: TLineInfo): string = - if info.fileIndex < 0: result = "???" + KindFormat = " [$1]" + KindColor = fgCyan + ErrorTitle = "Error: " + ErrorColor = fgRed + WarningTitle = "Warning: " + WarningColor = fgYellow + HintTitle = "Hint: " + HintColor = fgGreen + # NOTE: currently line info line numbers start with 1, + # but column numbers start with 0, however most editors expect + # first column to be 1, so we need to +1 here + 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; detail: string = "") = + conf.m.msgContext.add((info, detail)) + +proc popInfoContext*(conf: ConfigRef) = + setLen(conf.m.msgContext, conf.m.msgContext.len - 1) + +proc getInfoContext*(conf: ConfigRef; index: int): TLineInfo = + let i = if index < 0: conf.m.msgContext.len + index else: index + if i >=% conf.m.msgContext.len: result = unknownLineInfo + else: result = conf.m.msgContext[i].info + +template toFilename*(conf: ConfigRef; fileIdx: FileIndex): string = + 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 or conf == nil: + result = (if fileIdx == commandLineIdx: commandLineDesc else: "???") else: - if gListFullPaths: - result = fileInfos[info.fileIndex].fullPath + result = conf.m.fileInfos[fileIdx.int32].fullPath.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 + 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 + when defined(gcArc) or defined(gcOrc) or defined(gcAtomicArc): + result = conf.m.fileInfos[fileIdx.int32].hash + else: + shallowCopy(result, conf.m.fileInfos[fileIdx.int32].hash) + +proc toFullPathConsiderDirty*(conf: ConfigRef; fileIdx: FileIndex): AbsoluteFile = + if fileIdx.int32 < 0: + 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 + +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) + +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 = fileInfos[info.fileIndex].projPath + result = toFilenameOption(conf, fileIdx, foName) + +proc toMsgFilename*(conf: ConfigRef; fileIdx: FileIndex): string = + toFilenameOption(conf, fileIdx, conf.filenameOption) -proc toLinenumber*(info: TLineInfo): int {.inline.} = - result = info.line +template toMsgFilename*(conf: ConfigRef; info: TLineInfo): string = + toMsgFilename(conf, info.fileIndex) -proc toColumn*(info: TLineInfo): int {.inline.} = +proc toLinenumber*(info: TLineInfo): int {.inline.} = + result = int info.line + +proc toColumn*(info: TLineInfo): int {.inline.} = result = info.col -proc toFileLine*(info: TLineInfo): string {.inline.} = - result = info.toFilename & ":" & $info.line +proc toFileLineCol(info: InstantiationInfo): string {.inline.} = + result = "" + result.toLocation(info.filename, info.line, info.column + ColOffset) -proc toFileLineCol*(info: TLineInfo): string {.inline.} = - result = info.toFilename & "(" & $info.line & "," & $info.col & ")" +proc toFileLineCol*(conf: ConfigRef; info: TLineInfo): string {.inline.} = + result = "" + result.toLocation(toMsgFilename(conf, info), info.line.int, info.col.int + ColOffset) -proc `??`* (info: TLineInfo, filename: string): bool = - # only for debugging purposes - result = filename in info.toFilename - -var checkPoints*: seq[TLineInfo] = @[] -var optTrackPos*: TLineInfo - -proc addCheckpoint*(info: TLineInfo) = - checkPoints.add(info) - -proc addCheckpoint*(filename: string, line: int) = - addCheckpoint(newLineInfo(filename, line, - 1)) - -proc OutWriteln*(s: string) = - ## Writes to stdout. Always. - if gSilence == 0: Writeln(stdout, s) - -proc MsgWriteln*(s: string) = - ## Writes to stdout. If --stdout option is given, writes to stderr instead. - if gSilence == 0: - if gCmd == cmdIdeTools and optCDebug notin gGlobalOptions: return - if optStdout in gGlobalOptions: Writeln(stderr, s) - else: Writeln(stdout, s) - -proc coordToStr(coord: int): string = - if coord == -1: result = "???" - else: result = $coord - -proc MsgKindToString*(kind: TMsgKind): string = - # later versions may provide translated error messages - result = msgKindToStr[kind] +proc `$`*(conf: ConfigRef; info: TLineInfo): string = toFileLineCol(conf, info) -proc getMessageStr(msg: TMsgKind, arg: string): string = - result = msgKindToString(msg) % [arg] +proc `$`*(info: TLineInfo): string {.error.} = discard -type - TCheckPointResult* = enum - cpNone, cpFuzzy, cpExact - -proc inCheckpoint*(current: TLineInfo): TCheckPointResult = - for i in countup(0, high(checkPoints)): - if current.fileIndex == checkPoints[i].fileIndex: - if current.line == checkPoints[i].line and - abs(current.col-checkPoints[i].col) < 4: - return cpExact - if current.line >= checkPoints[i].line: - return cpFuzzy +proc `??`* (conf: ConfigRef; info: TLineInfo, filename: string): bool = + # only for debugging purposes + result = filename in toFilename(conf, info) type - TErrorHandling = enum doNothing, doAbort, doRaise - -proc handleError(msg: TMsgKind, eh: TErrorHandling, s: string) = - template maybeTrace = - if defined(debug) or gVerbosity >= 3: - writeStackTrace() - - if msg == errInternal: - writeStackTrace() # we always want a stack trace here - if msg >= fatalMin and msg <= fatalMax: - maybeTrace() - quit(1) - if msg >= errMin and msg <= errMax: - maybeTrace() - inc(gErrorCounter) - options.gExitcode = 1'i8 - if gErrorCounter >= gErrorMax: - quit(1) - elif eh == doAbort and gCmd != cmdIdeTools: - quit(1) + 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 = {}) = + ## Writes given message string to stderr by default. + ## If ``--stdout`` option is given, writes to stdout instead. If message hook + ## is present, then it is used to output message rather than stderr/stdout. + ## This behavior can be altered by given optional flags. + + ## This is used for 'nim dump' etc. where we don't have nimsuggest + ## support. + #if conf.cmd == cmdIdeTools and optCDebug notin gGlobalOptions: return + let sep = if msgNoUnitSep notin flags: conf.unitSep else: "" + if not isNil(conf.writelnHook) and msgSkipHook notin flags: + conf.writelnHook(s & sep) + elif optStdout in conf.globalOptions or msgStdout in flags: + if eStdOut in conf.m.errorOutputs: + flushDot(conf) + write stdout, s + writeLine(stdout, sep) + flushFile(stdout) + else: + if eStdErr in conf.m.errorOutputs: + 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) + +macro callIgnoringStyle(theProc: typed, first: typed, + args: varargs[typed]): untyped = + let typForegroundColor = bindSym"ForegroundColor".getType + let typBackgroundColor = bindSym"BackgroundColor".getType + let typStyle = bindSym"Style".getType + let typTerminalCmd = bindSym"TerminalCmd".getType + result = newCall(theProc) + if first.kind != nnkNilLit: result.add(first) + for arg in children(args[0][1]): + if arg.kind == nnkNilLit: continue + let typ = arg.getType + if typ.kind != nnkEnumTy or + typ != typForegroundColor and + typ != typBackgroundColor and + typ != typStyle and + typ != typTerminalCmd: + result.add(arg) + +macro callStyledWriteLineStderr(args: varargs[typed]): untyped = + result = newCall(bindSym"styledWriteLine") + 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) + +proc msgWrite(conf: ConfigRef; s: string) = + if conf.m.errorOutputs != {}: + let stdOrr = + if optStdout in conf.globalOptions: + stdout + else: + stderr + write(stdOrr, s) + flushFile(stdOrr) + conf.lastMsgWasDot.incl stdOrr.toStdOrrKind() # subsequent writes need `flushDot` + +template styledMsgWriteln(args: varargs[typed]) = + if not isNil(conf.writelnHook): + callIgnoringStyle(callWritelnHook, nil, args) + elif optStdout in conf.globalOptions: + if eStdOut in conf.m.errorOutputs: + flushDot(conf) + callIgnoringStyle(writeLine, stdout, args) + flushFile(stdout) + elif eStdErr in conf.m.errorOutputs: + flushDot(conf) + if optUseColors in conf.globalOptions: + callStyledWriteLineStderr(args) + else: + callIgnoringStyle(writeLine, stderr, args) + # On Windows stderr is fully-buffered when piped, regardless of C std. + when defined(windows): + flushFile(stderr) + +proc msgKindToString*(kind: TMsgKind): string = MsgKindToStr[kind] + # later versions may provide translated error messages + +proc getMessageStr(msg: TMsgKind, arg: string): string = msgKindToString(msg) % [arg] + +type TErrorHandling* = enum doNothing, doAbort, doRaise + +proc log*(s: string) = + var f: File = default(File) + if open(f, getHomeDir() / "nimsuggest.log", fmAppend): + f.writeLine(s) + close(f) + +proc quit(conf: ConfigRef; msg: TMsgKind) {.gcsafe.} = + if conf.isDefined("nimDebug"): quitOrRaise(conf, $msg) + elif defined(debug) or msg == errInternal or conf.hasHint(hintStackTrace): + {.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, ignoreMsg: bool) = + if msg in fatalMsgs: + if conf.cmd == cmdIdeTools: log(s) + 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: + # 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: raiseRecoverableError(s) -proc `==`*(a, b: TLineInfo): bool = +proc `==`*(a, b: TLineInfo): bool = result = a.line == b.line and a.fileIndex == b.fileIndex -proc writeContext(lastinfo: TLineInfo) = - var info = lastInfo - for i in countup(0, len(msgContext) - 1): - if msgContext[i] != lastInfo and msgContext[i] != info: - MsgWriteln(posContextFormat % [toMsgFilename(msgContext[i]), - coordToStr(msgContext[i].line), - coordToStr(msgContext[i].col), - getMessageStr(errInstantiationFrom, "")]) - info = msgContext[i] - -proc rawMessage*(msg: TMsgKind, args: openarray[string]) = - var frmt: string - case msg - of errMin..errMax: - writeContext(unknownLineInfo()) - frmt = rawErrorFormat - of warnMin..warnMax: - if optWarns notin gOptions: return - if msg notin gNotes: return - writeContext(unknownLineInfo()) - frmt = rawWarningFormat - inc(gWarnCounter) - of hintMin..hintMax: - if optHints notin gOptions: return - if msg notin gNotes: return - frmt = rawHintFormat - inc(gHintCounter) - let s = `%`(frmt, `%`(msgKindToString(msg), args)) - MsgWriteln(s) - handleError(msg, doAbort, s) - -proc rawMessage*(msg: TMsgKind, arg: string) = - rawMessage(msg, [arg]) - -var - lastError = UnknownLineInfo() - -proc writeSurroundingSrc(info: TLineInfo) = - const indent = " " - MsgWriteln(indent & info.sourceLine.ropeToStr) - MsgWriteln(indent & repeatChar(info.col, ' ') & '^') - -proc liMessage(info: TLineInfo, msg: TMsgKind, arg: string, - eh: TErrorHandling) = - var frmt: string - var ignoreMsg = false +proc exactEquals*(a, b: TLineInfo): bool = + result = a.fileIndex == b.fileIndex and a.line == b.line and a.col == b.col + +proc writeContext(conf: ConfigRef; lastinfo: TLineInfo) = + const instantiationFrom = "template/generic instantiation from here" + const instantiationOfFrom = "template/generic instantiation of `$1` from here" + var info = lastinfo + 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, context.info, instantiationFrom, + Severity.Hint) + else: + 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 addSourceLine(conf: ConfigRef; fileIdx: FileIndex, line: string) = + conf.m.fileInfos[fileIdx.int32].lines.add line + +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(toFullPathConsiderDirty(conf, fileIdx).string): + addSourceLine conf, fileIdx, line + except IOError: + discard + 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 > num: return "" + + result = conf.m.fileInfos[i.fileIndex.int32].lines[i.line.int-1] + +proc getSurroundingSrc(conf: ConfigRef; info: TLineInfo): string = + if conf.hasHint(hintSource) and info != unknownLineInfo: + 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 + conf.toFileLineCol(info) & " " & title & getMessageStr(msg, arg) + +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 + 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: - writeContext(info) - frmt = posErrorFormat - # 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 - lastError = info + sev = Severity.Error + writeContext(conf, info) + title = ErrorTitle + color = ErrorColor + when false: + # we try to filter error messages so that not two error message + # in the same file and line are produced: + # xxx `lastError` is only used in this disabled code; but could be useful to revive + ignoreMsg = conf.m.lastError == info and info != unknownLineInfo and eh != doAbort + if info != unknownLineInfo: conf.m.lastError = info of warnMin..warnMax: - ignoreMsg = optWarns notin gOptions or msg notin gNotes - if not ignoreMsg: writeContext(info) - frmt = posWarningFormat - inc(gWarnCounter) - of hintMin..hintMax: - ignoreMsg = optHints notin gOptions or msg notin gNotes - frmt = posHintFormat - inc(gHintCounter) - let s = frmt % [toMsgFilename(info), coordToStr(info.line), - coordToStr(info.col), getMessageStr(msg, arg)] + sev = Severity.Warning + 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) + inc(conf.warnCounter) + of hintMin..hintMax: + sev = Severity.Hint + 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) + + let s = if isRaw: arg else: getMessageStr(msg, arg) if not ignoreMsg: - MsgWriteln(s) - if optPrintSurroundingSrc and msg in errMin..errMax: - info.writeSurroundingSrc - handleError(msg, eh, s) - -proc Fatal*(info: TLineInfo, msg: TMsgKind, arg = "") = - liMessage(info, msg, arg, doAbort) - -proc GlobalError*(info: TLineInfo, msg: TMsgKind, arg = "") = - liMessage(info, msg, arg, doRaise) - -proc GlobalError*(info: TLineInfo, arg: string) = - liMessage(info, errGenerated, arg, doRaise) - -proc LocalError*(info: TLineInfo, msg: TMsgKind, arg = "") = - liMessage(info, msg, arg, doNothing) - -proc Message*(info: TLineInfo, msg: TMsgKind, arg = "") = - liMessage(info, msg, arg, doNothing) - -proc InternalError*(info: TLineInfo, errMsg: string) = - if gCmd == cmdIdeTools: return - writeContext(info) - liMessage(info, errInternal, errMsg, doAbort) - -proc InternalError*(errMsg: string) = - if gCmd == cmdIdeTools: return - writeContext(UnknownLineInfo()) - rawMessage(errInternal, errMsg) - -template AssertNotNil*(e: expr): expr = - if e == nil: InternalError($InstantiationInfo()) - e - -template InternalAssert*(e: bool): stmt = - if not e: InternalError($InstantiationInfo()) - -proc addSourceLine*(fileIdx: int32, line: string) = - fileInfos[fileIdx].lines.add line.toRope - -proc sourceLine*(i: TLineInfo): PRope = - if i.fileIndex < 0: return nil - - if not optPreserveOrigSource and fileInfos[i.fileIndex].lines.len == 0: - try: - for line in lines(i.toFullPath): - addSourceLine i.fileIndex, line.string - except EIO: - discard - InternalAssert i.fileIndex < fileInfos.len - # can happen if the error points to EOF: - if i.line > fileInfos[i.fileIndex].lines.len: return nil - - result = fileInfos[i.fileIndex].lines[i.line-1] - -proc quotedFilename*(i: TLineInfo): PRope = - InternalAssert i.fileIndex >= 0 - result = fileInfos[i.fileIndex].quotedName - -ropes.ErrorHandler = proc (err: TRopesError, msg: string, useWarning: bool) = - case err - of rInvalidFormatStr: - internalError("ropes: invalid format string: " & msg) - of rTokenTooLong: - internalError("ropes: token too long: " & msg) - of rCannotOpenFile: - rawMessage(if useWarning: warnCannotOpenFile else: errCannotOpenFile, - msg) - + let loc = if info != unknownLineInfo: conf.toFileLineCol(info) & " " else: "" + # we could also show `conf.cmdInput` here for `projectIsCmd` + var kindmsg = if kind.len > 0: KindFormat % kind else: "" + if conf.structuredErrorHook != nil: + conf.structuredErrorHook(conf, info, s & kindmsg, sev) + if not ignoreMsgBecauseOfIdeTools(conf, msg): + if msg == hintProcessing and conf.hintProcessingDots: + msgWrite(conf, ".") + else: + styledMsgWriteln(styleBright, loc, resetStyle, color, title, resetStyle, s, KindColor, kindmsg, + resetStyle, conf.getSurroundingSrc(info), conf.unitSep) + if hintMsgOrigin in conf.mainPackageNotes: + # xxx needs a bit of refactoring to honor `conf.filenameOption` + styledMsgWriteln(styleBright, toFileLineCol(info2), resetStyle, + " compiler msg initiated here", KindColor, + KindFormat % $hintMsgOrigin, + resetStyle, conf.unitSep) + 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, info2) + +template internalError*(conf: ConfigRef; info: TLineInfo, errMsg: string) = + internalErrorImpl(conf, info, errMsg, instLoc()) + +template internalError*(conf: ConfigRef; errMsg: string) = + internalErrorImpl(conf, unknownLineInfo, errMsg, instLoc()) + +template internalAssert*(conf: ConfigRef, e: bool) = + # xxx merge with `globalAssert` + if not e: + const info2 = instLoc() + let arg = info2.toFileLineCol + internalErrorImpl(conf, unknownLineInfo, arg, info2) + +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 = + 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: + 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 new file mode 100644 index 000000000..cc18ab39f --- /dev/null +++ b/compiler/ndi.nim @@ -0,0 +1,52 @@ +# +# +# 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 generation of ``.ndi`` files for better debugging +## support of Nim code. "ndi" stands for "Nim debug info". + +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.addInt s.info.line.int + f.buf.add "\t" + f.buf.addInt s.info.col.int + f.f.write(s.name.s, "\t") + 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: f.syms.add s + +proc open*(f: var NdiFile; filename: AbsoluteFile; conf: ConfigRef) = + f.enabled = not filename.isEmpty + if f.enabled: + f.filename = filename + f.buf = newStringOfCap(20) + +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 new file mode 100644 index 000000000..ce5a22ad2 --- /dev/null +++ b/compiler/nim.cfg @@ -0,0 +1,63 @@ +# Special configuration file for the Nim project + +hint[XDeclaredButNotUsed]:off + +define:booting +define:nimcore +define:nimPreviewFloatRoundtrip +define:nimPreviewSlimSystem +define:nimPreviewCstringConversion +define:nimPreviewProcConversion +define:nimPreviewRangeDefault +define:nimPreviewNonVarDestructor +threads:off + +#import:"$projectpath/testability" + +@if windows: + cincludes: "$lib/wrappers/libffi/common" +@end + +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 new file mode 100644 index 000000000..005f11a58 --- /dev/null +++ b/compiler/nim.nim @@ -0,0 +1,172 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +import std/[os, strutils, parseopt] + +when defined(nimPreviewSlimSystem): + import std/assertions + +when defined(windows): + when defined(gcc): + when defined(x86): + {.link: "../icons/nim.res".} + else: + {.link: "../icons/nim_icon.o".} + + when defined(amd64) and defined(vcc): + {.link: "../icons/nim-amd64-windows-vcc.res".} + when defined(i386) and defined(vcc): + {.link: "../icons/nim-i386-windows-vcc.res".} + +import + commands, options, msgs, extccomp, main, idents, lineinfos, cmdlinehelper, + pathutils, modulegraphs + +from std/browsers import openDefaultBrowser +from nodejs import findNodeJs + +when hasTinyCBackend: + import tccgen + +when defined(profiler) or defined(memProfiler): + {.hint: "Profiling support is turned on!".} + import nimprof + +proc nimbleLockExists(config: ConfigRef): bool = + const nimbleLock = "nimble.lock" + let pd = if not config.projectPath.isEmpty: config.projectPath else: AbsoluteDir(getCurrentDir()) + if optSkipParentConfigFiles notin config.globalOptions: + for dir in parentDirs(pd.string, fromRoot=true, inclusive=false): + if fileExists(dir / nimbleLock): + return true + return fileExists(pd.string / nimbleLock) + +proc processCmdLine(pass: TCmdLinePass, cmd: string; config: ConfigRef) = + var p = parseopt.initOptParser(cmd) + var argsCount = 0 + + config.commandLine.setLen 0 + # bugfix: otherwise, config.commandLine ends up duplicated + + while true: + parseopt.next(p) + case p.kind + of cmdEnd: break + of cmdLongOption, cmdShortOption: + config.commandLine.add " " + config.commandLine.addCmdPrefix p.kind + config.commandLine.add p.key.quoteShell # quoteShell to be future proof + if p.val.len > 0: + config.commandLine.add ':' + config.commandLine.add p.val.quoteShell + + if p.key == "": # `-` was passed to indicate main project is stdin + p.key = "-" + if processArgument(pass, p, argsCount, config): break + else: + processSwitch(pass, p, config) + of cmdArgument: + config.commandLine.add " " + config.commandLine.add p.key.quoteShell + if processArgument(pass, p, argsCount, config): break + if pass == passCmd2: + if {optRun, optWasNimscript} * config.globalOptions == {} and + config.arguments.len > 0 and config.cmd notin {cmdTcc, cmdNimscript, cmdCrun}: + rawMessage(config, errGenerated, errArgsNeedRunOption) + + if config.nimbleLockExists: + # disable nimble path if nimble.lock is present. + # see https://github.com/nim-lang/nimble/issues/1004 + disableNimblePath(config) + +proc getNimRunExe(conf: ConfigRef): string = + # xxx consider defining `conf.getConfigVar("nimrun.exe")` to allow users to + # customize the binary to run the command with, e.g. for custom `nodejs` or `wine`. + if conf.isDefined("mingw"): + if conf.isDefined("i386"): result = "wine" + elif conf.isDefined("amd64"): result = "wine64" + else: result = "" + else: + result = "" + +proc handleCmdLine(cache: IdentCache; conf: ConfigRef) = + let self = NimProg( + supportsStdinFile: true, + processCmdLine: processCmdLine + ) + self.initDefinesProg(conf, "nim_compiler") + if paramCount() == 0: + 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: + # support as needed + rawMessage(conf, errGenerated, "'$1 cannot handle --run" % [$conf.cmd]) + +when declared(GC_setMaxPause): + GC_setMaxPause 2_000 + +when compileOption("gc", "refc"): + # the new correct mark&sweet collector is too slow :-/ + GC_disableMarkAndSweep() + +when not defined(selftest): + let conf = newConfigRef() + handleCmdLine(newIdentCache(), conf) + when declared(GC_setMaxPause): + echo GC_getStatistics() + msgQuit(int8(conf.errorCounter > 0)) diff --git a/compiler/nimblecmd.nim b/compiler/nimblecmd.nim new file mode 100644 index 000000000..a5324ea76 --- /dev/null +++ b/compiler/nimblecmd.nim @@ -0,0 +1,171 @@ +# +# +# The Nim Compiler +# (c) Copyright 2012 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Implements some helper procs for Nimble (Nim's package manager) support. + +import options, msgs, lineinfos, pathutils + +import std/[parseutils, strutils, os, tables, sequtils] + +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] + +import ../dist/checksums/src/checksums/sha1 + +proc addPath*(conf: ConfigRef; path: AbsoluteDir, info: TLineInfo) = + if not conf.searchPaths.contains(path): + conf.searchPaths.insert(path, 0) + +type + Version* = distinct string + PackageInfo = Table[string, tuple[version, checksum: string]] + +proc `$`*(ver: Version): string {.borrow.} + +proc newVersion*(ver: string): Version = + doAssert(ver.len == 0 or ver[0] in {'#', '\0'} + Digits, + "Wrong version: " & ver) + return Version(ver) + +proc isSpecial(ver: Version): bool = + return ($ver).len > 0 and ($ver)[0] == '#' + +proc isValidVersion(v: string): bool = + if v.len > 0: + 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": + return ($ver).normalize != "#head" + + if not ver2.isSpecial: + # `#aa111 < 1.1` + return ($ver).normalize != "#head" + + # 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): + var sVerI = 0 + if i < sVer.len: + discard parseInt(sVer[i], sVerI) + var sVerI2 = 0 + if i < sVer2.len: + discard parseInt(sVer2[i], sVerI2) + if sVerI < sVerI2: + return true + elif sVerI == sVerI2: + discard + else: + return false + +proc getPathVersionChecksum*(p: string): tuple[name, version, checksum: string] = + ## Splits path ``p`` in the format + ## ``/home/user/.nimble/pkgs/package-0.1-febadeaea2345e777f0f6f8433f7f0a52edd5d1b`` into + ## ``("/home/user/.nimble/pkgs/package", "0.1", "febadeaea2345e777f0f6f8433f7f0a52edd5d1b")`` + + result = ("", "", "") + + const checksumSeparator = '-' + const versionSeparator = '-' + const specialVersionSepartator = "-#" + const separatorNotFound = -1 + + 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() + + var versionSeparatorIndex = p.rfind( + specialVersionSepartator, 0, checksumSeparatorIndex - 1) + if versionSeparatorIndex != separatorNotFound: + result.version = p.substr( + versionSeparatorIndex + 1, checksumSeparatorIndex - 1) + else: + versionSeparatorIndex = p.rfind( + versionSeparator, 0, checksumSeparatorIndex - 1) + if versionSeparatorIndex != separatorNotFound: + result.version = p.substr( + versionSeparatorIndex + 1, checksumSeparatorIndex - 1) + else: + versionSeparatorIndex = checksumSeparatorIndex + + result.name = p[0..<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).version.newVersion < version or + (not packages.hasKey(name)): + if checksum.isValidSha1Hash(): + packages[name] = ($version, checksum) + else: + packages[name] = ($version, "") + else: + localError(conf, info, "invalid package name: " & p) + +iterator chosen(packages: PackageInfo): string = + for key, val in pairs(packages): + 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) = + var path = p + let nimbleLinks = toSeq(walkPattern(p / "*.nimble-link")) + if nimbleLinks.len > 0: + # If the user has more than one .nimble-link file then... we just ignore it. + # Spec for these files is available in Nimble's readme: + # https://github.com/nim-lang/nimble#nimble-link + let nimbleLinkLines = readFile(nimbleLinks[0]).splitLines() + path = nimbleLinkLines[1] + if not path.isAbsolute(): + path = p / path + + if not contains(conf.searchPaths, AbsoluteDir path): + message(conf, info, hintPath, path) + conf.lazyPaths.insert(AbsoluteDir path, 0) + +proc addPathRec(conf: ConfigRef; dir: string, info: TLineInfo) = + 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): + if k == pcDir and p[pos] != '.': + addPackage(conf, packages, p, info) + for p in packages.chosen: + addNimblePath(conf, p, info) + +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 3bd97ccb2..5417cd1e9 100644 --- a/compiler/nimconf.nim +++ b/compiler/nimconf.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -9,242 +9,312 @@ # This module handles the reading of the config file. -import - llstream, nversion, commands, os, strutils, msgs, platform, condsyms, lexer, - options, idents, wordrecg +import + 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 Nimrod's scanner here to safe 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): bool -proc parseAtom(L: var TLexer, tok: var TToken): bool = - if tok.tokType == tkParLe: + +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) + result = parseExpr(L, tok, config) if tok.tokType == tkParRi: ppGetTok(L, tok) - else: lexMessage(L, errTokenExpected, "\')\'") - elif tok.ident.id == ord(wNot): + else: lexMessage(L, errGenerated, "expected closing ')'") + elif tok.tokType == tkNot: ppGetTok(L, tok) - result = not parseAtom(L, tok) + result = not parseAtom(L, tok, config) else: - result = isDefined(tok.ident) + result = isDefined(config, tok.ident.s) ppGetTok(L, tok) -proc parseAndExpr(L: var TLexer, tok: var TToken): bool = - result = parseAtom(L, tok) - while tok.ident.id == ord(wAnd): +proc parseAndExpr(L: var Lexer, tok: var Token; config: ConfigRef): bool = + result = parseAtom(L, tok, config) + while tok.tokType == tkAnd: ppGetTok(L, tok) # skip "and" - var b = parseAtom(L, tok) + var b = parseAtom(L, tok, config) result = result and b -proc parseExpr(L: var TLexer, tok: var TToken): bool = - result = parseAndExpr(L, tok) - while tok.ident.id == ord(wOr): +proc parseExpr(L: var Lexer, tok: var Token; config: ConfigRef): bool = + result = parseAndExpr(L, tok, config) + while tok.tokType == tkOr: ppGetTok(L, tok) # skip "or" - var b = parseAndExpr(L, tok) + var b = parseAndExpr(L, tok, config) result = result or b -proc EvalppIf(L: var TLexer, tok: var TToken): bool = +proc evalppIf(L: var Lexer, tok: var Token; config: ConfigRef): bool = ppGetTok(L, tok) # skip 'if' or 'elif' - result = parseExpr(L, tok) + result = parseExpr(L, tok, config) if tok.tokType == tkColon: ppGetTok(L, tok) - else: lexMessage(L, errTokenExpected, "\':\'") - -var condStack: seq[bool] = @[] + else: lexMessage(L, errGenerated, "expected ':'") + +#var condStack: seq[bool] = @[] -proc doEnd(L: var TLexer, tok: var TToken) = - if high(condStack) < 0: lexMessage(L, errTokenExpected, "@if") +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)) + setLen(condStack, high(condStack)) -type - TJumpDest = enum +type + TJumpDest = enum jdEndif, jdElseEndif -proc jumpToDirective(L: var TLexer, tok: var TToken, dest: TJumpDest) -proc doElse(L: var TLexer, tok: var TToken) = - if high(condStack) < 0: lexMessage(L, errTokenExpected, "@if") +proc jumpToDirective(L: var Lexer, tok: var Token, dest: TJumpDest; config: ConfigRef; + condStack: var seq[bool]) +proc doElse(L: var Lexer, tok: var Token; config: ConfigRef; condStack: var seq[bool]) = + if high(condStack) < 0: lexMessage(L, errGenerated, "expected @if") ppGetTok(L, tok) if tok.tokType == tkColon: ppGetTok(L, tok) - if condStack[high(condStack)]: jumpToDirective(L, tok, jdEndif) - -proc doElif(L: var TLexer, tok: var TToken) = - if high(condStack) < 0: lexMessage(L, errTokenExpected, "@if") - var res = EvalppIf(L, tok) - if condStack[high(condStack)] or not res: jumpToDirective(L, tok, jdElseEndif) + if condStack[high(condStack)]: jumpToDirective(L, tok, jdEndif, config, condStack) + +proc doElif(L: var Lexer, tok: var Token; config: ConfigRef; condStack: var seq[bool]) = + if high(condStack) < 0: lexMessage(L, errGenerated, "expected @if") + 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) = + +proc jumpToDirective(L: var Lexer, tok: var Token, dest: TJumpDest; config: ConfigRef; + condStack: var seq[bool]) = var nestedIfs = 0 - while True: - if (tok.ident != nil) and (tok.ident.s == "@"): + while true: + if tok.ident != nil and tok.ident.s == "@": ppGetTok(L, tok) case whichKeyword(tok.ident) - of wIf: - Inc(nestedIfs) - of wElse: - if (dest == jdElseEndif) and (nestedIfs == 0): - doElse(L, tok) - break - of wElif: - if (dest == jdElseEndif) and (nestedIfs == 0): - doElif(L, tok) - break - of wEnd: - if nestedIfs == 0: - doEnd(L, tok) - break - if nestedIfs > 0: Dec(nestedIfs) - else: - nil + of wIf: + inc(nestedIfs) + of wElse: + if dest == jdElseEndif and nestedIfs == 0: + doElse(L, tok, config, condStack) + break + of wElif: + if dest == jdElseEndif and nestedIfs == 0: + doElif(L, tok, config, condStack) + break + of wEnd: + if nestedIfs == 0: + doEnd(L, tok, condStack) + break + if nestedIfs > 0: dec(nestedIfs) + else: + discard ppGetTok(L, tok) - elif tok.tokType == tkEof: - lexMessage(L, errTokenExpected, "@end") - else: + elif tok.tokType == tkEof: + lexMessage(L, errGenerated, "expected @end") + else: ppGetTok(L, tok) - -proc parseDirective(L: var TLexer, tok: var TToken) = + +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) - var res = EvalppIf(L, tok) + setLen(condStack, condStack.len + 1) + let res = evalppIf(L, tok, config) condStack[high(condStack)] = res - if not res: jumpToDirective(L, tok, jdElseEndif) - of wElif: doElif(L, tok) - of wElse: doElse(L, tok) - of wEnd: doEnd(L, tok) - of wWrite: + if not res: jumpToDirective(L, tok, jdElseEndif, config, condStack) + of wElif: doElif(L, tok, config, condStack) + of wElse: doElse(L, tok, config, condStack) + of wEnd: doEnd(L, tok, condStack) + of wWrite: ppGetTok(L, tok) - msgs.MsgWriteln(tokToStr(tok)) + msgs.msgWriteln(config, strtabs.`%`($tok, config.configVars, + {useEnvironment, useKey})) ppGetTok(L, tok) else: case tok.ident.s.normalize - of "putenv": + 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": + 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, errInvalidDirectiveX, tokToStr(tok)) - -proc confTok(L: var TLexer, tok: var TToken) = + else: + lexMessage(L, errGenerated, "invalid directive: '$1'" % $tok) + +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) # else: give the token to the parser - -proc checkSymbol(L: TLexer, tok: TToken) = - if tok.tokType notin {tkSymbol..pred(tkIntLit), tkStrLit..tkTripleStrLit}: - lexMessage(L, errIdentifierExpected, tokToStr(tok)) - -proc parseAssignment(L: var TLexer, tok: var TToken) = - if tok.ident.id == getIdent("-").id or tok.ident.id == getIdent("--").id: - confTok(L, tok) # skip unnecessary prefix - var info = getLineInfo(L) # safe for later in case of an error + while tok.ident != nil and tok.ident.s == "@": + parseDirective(L, tok, config, condStack) # else: give the token to the parser + +proc checkSymbol(L: Lexer, tok: Token) = + if tok.tokType notin {tkSymbol..tkInt64Lit, tkStrLit..tkTripleStrLit}: + lexMessage(L, errGenerated, "expected identifier, but got: " & $tok) + +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) - confTok(L, tok) # skip symbol + var s = $tok + confTok(L, tok, config, condStack) # skip symbol var val = "" - while tok.tokType == tkDot: - add(s, '.') - confTok(L, tok) + while tok.tokType == tkDot: + s.add('.') + confTok(L, tok, config, condStack) checkSymbol(L, tok) - add(s, tokToStr(tok)) - confTok(L, tok) - if tok.tokType == tkBracketLe: + s.add($tok) + confTok(L, tok, config, condStack) + if tok.tokType == tkBracketLe: # BUGFIX: val, not s! - # BUGFIX: do not copy '['! - confTok(L, tok) + confTok(L, tok, config, condStack) checkSymbol(L, tok) - add(val, tokToStr(tok)) - confTok(L, tok) - if tok.tokType == tkBracketRi: confTok(L, tok) - else: lexMessage(L, errTokenExpected, "\']\'") - add(val, ']') - if tok.tokType in {tkColon, tkEquals}: - if len(val) > 0: add(val, ':') - confTok(L, tok) # skip ':' or '=' + 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 ']'") + val.add(']') + let percent = tok.ident != nil and tok.ident.s == "%=" + if tok.tokType in {tkColon, tkEquals} or percent: + if val.len > 0: val.add(':') + confTok(L, tok, config, condStack) # skip ':' or '=' or '%' checkSymbol(L, tok) - add(val, tokToStr(tok)) - confTok(L, tok) # skip symbol - while tok.ident != nil and tok.ident.id == getIdent("&").id: - confTok(L, 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) - add(val, tokToStr(tok)) - confTok(L, tok) - processSwitch(s, val, passPP, info) + 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) + 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) = +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) + stream = llStreamOpen(filename, fmRead) if stream != nil: - initToken(tok) - openLexer(L, filename, stream) - tok.tokType = tkEof # to avoid a pointless warning - confTok(L, tok) # read in the first token - while tok.tokType != tkEof: parseAssignment(L, tok) - if len(condStack) > 0: lexMessage(L, errTokenExpected, "@end") + openLexer(L, filename, stream, cache, config) + 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, filename, condStack) + if condStack.len > 0: lexMessage(L, errGenerated, "expected @end") closeLexer(L) - if gVerbosity >= 1: rawMessage(hintConf, filename) + 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(filename: string): string = +proc getSystemConfigPath*(conf: ConfigRef; filename: RelativeFile): AbsoluteFile = # try standard configuration file (installation did not distribute files # the UNIX way) - result = joinPath([getPrefixDir(), "config", filename]) - if not ExistsFile(result): result = "/etc/" & filename - -proc LoadConfigs*(cfg: string) = - # set default value (can be overwritten): - if libpath == "": - # choose default libpath: - var prefix = getPrefixDir() - if prefix == "/usr": libpath = "/usr/lib/nimrod" - elif prefix == "/usr/local": libpath = "/usr/local/lib/nimrod" - else: libpath = joinPath(prefix, "lib") - - if optSkipConfigFile notin gGlobalOptions: - readConfigFile(getSystemConfigPath(cfg)) - - if optSkipUserConfigFile notin gGlobalOptions: + let p = getPrefixDir(conf) + result = p / RelativeDir"config" / filename + when defined(unix): + if not fileExists(result): result = p / RelativeDir"etc/nim" / filename + if not fileExists(result): result = AbsoluteDir"/etc/nim" / filename + +proc loadConfigs*(cfg: RelativeFile; cache: IdentCache; conf: ConfigRef; idgen: IdGenerator) = + setDefaultLibpath(conf) + template readConfigFile(path) = + let configPath = path + if readConfigFile(configPath, cache, conf): + 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 optSkipSystemConfigFile notin conf.globalOptions: + readConfigFile(getSystemConfigPath(conf, cfg)) + + if cfg == DefaultConfig: + runNimScriptIfExists(getSystemConfigPath(conf, DefaultConfigNims)) + + if optSkipUserConfigFile notin conf.globalOptions: readConfigFile(getUserConfigPath(cfg)) - var pd = if gProjectPath.len > 0: gProjectPath else: getCurrentDir() - if optSkipParentConfigFiles notin gGlobalOptions: - for dir in parentDirs(pd, fromRoot=true, inclusive=false): - readConfigFile(dir / cfg) - - if optSkipProjConfigFile notin gGlobalOptions: + 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.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 gProjectName.len != 0: - var conffile = changeFileExt(gProjectFull, "cfg") - if conffile != pd / cfg and existsFile(conffile): - readConfigFile(conffile) - rawMessage(warnConfigDeprecated, conffile) - + if cfg == DefaultConfig: + runNimScriptIfExists(pd / DefaultConfigNims) + + if conf.projectName.len != 0: # new project wide config file: - readConfigFile(changeFileExt(gProjectFull, "nimrod.cfg")) - + var projectConfig = changeFileExt(conf.projectFull, "nimcfg") + if not fileExists(projectConfig): + projectConfig = changeFileExt(conf.projectFull, "nim.cfg") + readConfigFile(projectConfig) + + + 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 new file mode 100644 index 000000000..0833cfeb3 --- /dev/null +++ b/compiler/nimeval.nim @@ -0,0 +1,177 @@ +# +# +# The Nim Compiler +# (c) Copyright 2018 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## exposes the Nim VM to clients. +import + 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" + for s in modulegraphs.allSyms(i.graph, i.mainModule): + yield s + +proc selectUniqueSymbol*(i: Interpreter; name: string; + symKinds: set[TSymKind] = {skLet, skVar}): PSym = + ## Can be used to access a unique symbol of ``name`` and + ## the given ``symKinds`` filter. + assert i != nil + assert i.mainModule != nil, "no main module selected" + let n = getIdent(i.graph.cache, name) + 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 = nextModuleIter(it, i.graph) + +proc selectRoutine*(i: Interpreter; name: string): PSym = + ## 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, + skMethod, skProc, skConverter}) + +proc callRoutine*(i: Interpreter; routine: PSym; args: openArray[PNode]): PNode = + assert i != nil + result = vm.execProc(PCtx i.graph.vm, routine, args) + +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 + let vm = PCtx(i.graph.vm) + vm.registerCallback(pkg & "." & module & "." & name, impl) + +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" + 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) + 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"): + when defined(unix): + result = nimexe.expandSymlink.splitPath()[0] /../ "lib" + if not fileExists(result / "system.nim"): return "" + 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 = {}, + defines = @[("nimscript", "true")], + registerOps = true): Interpreter = + var conf = newConfigRef() + var cache = newIdentCache() + var graph = newModuleGraph(cache, conf) + connectPipelineCallbacks(graph) + initDefines(conf.symbols) + for define in defines: + defineSymbol(conf.symbols, define[0], define[1]) + + for p in searchPaths: + conf.searchPaths.add(AbsoluteDir p) + if conf.libpath.isEmpty: conf.libpath = AbsoluteDir p + + var m = graph.makeModule(scriptName) + incl(m.flags, sfMainModule) + 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 + 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/nimlexbase.nim b/compiler/nimlexbase.nim index 6d45a825a..6708b57f8 100644 --- a/compiler/nimlexbase.nim +++ b/compiler/nimlexbase.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -12,10 +12,14 @@ # handling that exists! Only at line endings checks are necessary # if the buffer needs refilling. -import - llstream, strutils +import llstream -const +import std/strutils + +when defined(nimPreviewSlimSystem): + import std/assertions + +const Lrz* = ' ' Apo* = '\'' Tabulator* = '\x09' @@ -27,7 +31,7 @@ const BACKSPACE* = '\x08' VT* = '\x0B' -const +const EndOfFile* = '\0' # end of file marker # A little picture makes everything clear :-) # buf: @@ -36,43 +40,41 @@ const # NewLines* = {CR, LF} -type - TBaseLexer* = object of TObject +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 + lineNumber*: int # the current line number # private data: sentinel*: int lineStart*: int # index of last line start in buffer - + offsetBase*: int # use ``offsetBase + bufpos`` to get the offset + -proc openBaseLexer*(L: var TBaseLexer, inputstream: PLLStream, +proc openBaseLexer*(L: var TBaseLexer, inputstream: PLLStream, bufLen: int = 8192) # 8K is a reasonable buffer size proc closeBaseLexer*(L: var TBaseLexer) proc getCurrentLine*(L: TBaseLexer, marker: bool = true): string proc getColNumber*(L: TBaseLexer, pos: int): int -proc HandleCR*(L: var TBaseLexer, pos: int): int +proc handleCR*(L: var TBaseLexer, pos: int): int # Call this if you scanned over CR in the buffer; it returns the # 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 +proc handleLF*(L: var TBaseLexer, pos: int): int + # 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) = + llStreamClose(L.stream) -proc closeBaseLexer(L: var TBaseLexer) = - dealloc(L.buf) - LLStreamClose(L.stream) - -proc FillBuffer(L: var TBaseLexer) = - var +proc fillBuffer(L: var TBaseLexer) = + var charsRead, toCopy, s: int # all are in characters, # not bytes (in case this # is not the same) @@ -80,91 +82,93 @@ proc FillBuffer(L: var TBaseLexer) = # we know here that pos == L.sentinel, but not if this proc # is called the first time by initBaseLexer() assert(L.sentinel < L.bufLen) - toCopy = L.BufLen - L.sentinel - 1 + toCopy = L.bufLen - L.sentinel - 1 assert(toCopy >= 0) - if toCopy > 0: - MoveMem(L.buf, addr(L.buf[L.sentinel + 1]), toCopy * chrSize) + if toCopy > 0: + 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: + if charsRead < L.sentinel + 1: L.buf[s] = EndOfFile # set end marker L.sentinel = s - else: + else: # compute sentinel: dec(s) # BUGFIX (valgrind) - while true: + while true: assert(s < L.bufLen) - while (s >= 0) and not (L.buf[s] in NewLines): Dec(s) - if s >= 0: + while (s >= 0) and not (L.buf[s] in NewLines): dec(s) + if s >= 0: # we found an appropriate character for a sentinel: L.sentinel = s - break - else: + break + else: # rather than to give up here because the line is too long, # 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)) - assert(L.bufLen - oldBuflen == oldBufLen) - charsRead = LLStreamRead(L.stream, addr(L.buf[oldBufLen]), - oldBufLen * chrSize) div chrSize - if charsRead < oldBufLen: + oldBufLen = L.bufLen + L.bufLen = L.bufLen * 2 + L.bufStorage.setLen(L.bufLen) + L.buf = L.bufStorage.cstring + assert(L.bufLen - oldBufLen == oldBufLen) + charsRead = llStreamRead(L.stream, addr(L.buf[oldBufLen]), + oldBufLen) + if charsRead < oldBufLen: L.buf[oldBufLen + charsRead] = EndOfFile L.sentinel = oldBufLen + charsRead - break + break s = L.bufLen - 1 -proc fillBaseLexer(L: var TBaseLexer, pos: int): int = +proc fillBaseLexer(L: var TBaseLexer, pos: int): int = assert(pos <= L.sentinel) - if pos < L.sentinel: + if pos < L.sentinel: result = pos + 1 # nothing to do - else: + else: fillBuffer(L) - L.bufpos = 0 # XXX: is this really correct? + L.offsetBase += pos + 1 + L.bufpos = 0 result = 0 L.lineStart = result -proc HandleCR(L: var TBaseLexer, pos: int): int = +proc handleCR(L: var TBaseLexer, pos: int): int = assert(L.buf[pos] == CR) - inc(L.linenumber) + inc(L.lineNumber) result = fillBaseLexer(L, pos) - if L.buf[result] == LF: + if L.buf[result] == LF: result = fillBaseLexer(L, result) -proc HandleLF(L: var TBaseLexer, pos: int): int = +proc handleLF(L: var TBaseLexer, pos: int): int = assert(L.buf[pos] == LF) - inc(L.linenumber) + inc(L.lineNumber) result = fillBaseLexer(L, pos) #L.lastNL := result-1; // BUGFIX: was: result; - -proc skip_UTF_8_BOM(L: var TBaseLexer) = - if (L.buf[0] == '\xEF') and (L.buf[1] == '\xBB') and (L.buf[2] == '\xBF'): + +proc skipUTF8BOM(L: var TBaseLexer) = + if L.buf[0] == '\xEF' and L.buf[1] == '\xBB' and L.buf[2] == '\xBF': inc(L.bufpos, 3) inc(L.lineStart, 3) -proc openBaseLexer(L: var TBaseLexer, inputstream: PLLStream, bufLen = 8192) = +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 + L.lineNumber = 1 # lines start at 1 L.stream = inputstream fillBuffer(L) - skip_UTF_8_BOM(L) + skipUTF8BOM(L) -proc getColNumber(L: TBaseLexer, pos: int): int = +proc getColNumber(L: TBaseLexer, pos: int): int = result = abs(pos - L.lineStart) -proc getCurrentLine(L: TBaseLexer, marker: bool = true): string = +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") - if marker: - result.add(RepeatChar(getColNumber(L, L.bufpos)) & '^' & "\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" 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/nimrod.cfg b/compiler/nimrod.cfg deleted file mode 100644 index a0e59aa09..000000000 --- a/compiler/nimrod.cfg +++ /dev/null @@ -1,12 +0,0 @@ -# Special configuration file for the Nimrod project - -mainModule:"nimrod.nim" - -hint[XDeclaredButNotUsed]:off -path:"llvm" -path:"$projectPath/.." - -path:"$lib/packages/docutils" - -define:booting - diff --git a/compiler/nimrod.dot b/compiler/nimrod.dot deleted file mode 100644 index e9663d7c5..000000000 --- a/compiler/nimrod.dot +++ /dev/null @@ -1,591 +0,0 @@ -digraph nimrod { -times -> strutils; -os -> strutils; -os -> times; -posix -> times; -os -> posix; -nhashes -> strutils; -nstrtabs -> os; -nstrtabs -> nhashes; -nstrtabs -> strutils; -options -> os; -options -> lists; -options -> strutils; -options -> nstrtabs; -msgs -> options; -msgs -> strutils; -msgs -> os; -crc -> strutils; -platform -> strutils; -ropes -> msgs; -ropes -> strutils; -ropes -> platform; -ropes -> nhashes; -ropes -> crc; -idents -> nhashes; -idents -> strutils; -ast -> msgs; -ast -> nhashes; -ast -> nversion; -ast -> options; -ast -> strutils; -ast -> crc; -ast -> ropes; -ast -> idents; -ast -> lists; -astalgo -> ast; -astalgo -> nhashes; -astalgo -> strutils; -astalgo -> options; -astalgo -> msgs; -astalgo -> ropes; -astalgo -> idents; -condsyms -> ast; -condsyms -> astalgo; -condsyms -> msgs; -condsyms -> nhashes; -condsyms -> platform; -condsyms -> strutils; -condsyms -> idents; -hashes -> strutils; -strtabs -> os; -strtabs -> hashes; -strtabs -> strutils; -osproc -> strutils; -osproc -> os; -osproc -> strtabs; -osproc -> streams; -osproc -> posix; -extccomp -> lists; -extccomp -> ropes; -extccomp -> os; -extccomp -> strutils; -extccomp -> osproc; -extccomp -> platform; -extccomp -> condsyms; -extccomp -> options; -extccomp -> msgs; -wordrecg -> nhashes; -wordrecg -> strutils; -wordrecg -> idents; -commands -> os; -commands -> msgs; -commands -> options; -commands -> nversion; -commands -> condsyms; -commands -> strutils; -commands -> extccomp; -commands -> platform; -commands -> lists; -commands -> wordrecg; -llstream -> strutils; -lexbase -> llstream; -lexbase -> strutils; -scanner -> nhashes; -scanner -> options; -scanner -> msgs; -scanner -> strutils; -scanner -> platform; -scanner -> idents; -scanner -> lexbase; -scanner -> llstream; -scanner -> wordrecg; -nimconf -> llstream; -nimconf -> nversion; -nimconf -> commands; -nimconf -> os; -nimconf -> strutils; -nimconf -> msgs; -nimconf -> platform; -nimconf -> condsyms; -nimconf -> scanner; -nimconf -> options; -nimconf -> idents; -nimconf -> wordrecg; -pnimsyn -> llstream; -pnimsyn -> scanner; -pnimsyn -> idents; -pnimsyn -> strutils; -pnimsyn -> ast; -pnimsyn -> msgs; -pbraces -> llstream; -pbraces -> scanner; -pbraces -> idents; -pbraces -> strutils; -pbraces -> ast; -pbraces -> msgs; -pbraces -> pnimsyn; -rnimsyn -> scanner; -rnimsyn -> options; -rnimsyn -> idents; -rnimsyn -> strutils; -rnimsyn -> ast; -rnimsyn -> msgs; -rnimsyn -> lists; -filters -> llstream; -filters -> os; -filters -> wordrecg; -filters -> idents; -filters -> strutils; -filters -> ast; -filters -> astalgo; -filters -> msgs; -filters -> options; -filters -> rnimsyn; -ptmplsyn -> llstream; -ptmplsyn -> os; -ptmplsyn -> wordrecg; -ptmplsyn -> idents; -ptmplsyn -> strutils; -ptmplsyn -> ast; -ptmplsyn -> astalgo; -ptmplsyn -> msgs; -ptmplsyn -> options; -ptmplsyn -> rnimsyn; -ptmplsyn -> filters; -syntaxes -> strutils; -syntaxes -> llstream; -syntaxes -> ast; -syntaxes -> astalgo; -syntaxes -> idents; -syntaxes -> scanner; -syntaxes -> options; -syntaxes -> msgs; -syntaxes -> pnimsyn; -syntaxes -> pbraces; -syntaxes -> ptmplsyn; -syntaxes -> filters; -syntaxes -> rnimsyn; -paslex -> nhashes; -paslex -> options; -paslex -> msgs; -paslex -> strutils; -paslex -> platform; -paslex -> idents; -paslex -> lexbase; -paslex -> wordrecg; -paslex -> scanner; -pasparse -> os; -pasparse -> llstream; -pasparse -> scanner; -pasparse -> paslex; -pasparse -> idents; -pasparse -> wordrecg; -pasparse -> strutils; -pasparse -> ast; -pasparse -> astalgo; -pasparse -> msgs; -pasparse -> options; -rodread -> os; -rodread -> options; -rodread -> strutils; -rodread -> nversion; -rodread -> ast; -rodread -> astalgo; -rodread -> msgs; -rodread -> platform; -rodread -> condsyms; -rodread -> ropes; -rodread -> idents; -rodread -> crc; -trees -> ast; -trees -> astalgo; -trees -> scanner; -trees -> msgs; -trees -> strutils; -types -> ast; -types -> astalgo; -types -> trees; -types -> msgs; -types -> strutils; -types -> platform; -magicsys -> ast; -magicsys -> astalgo; -magicsys -> nhashes; -magicsys -> msgs; -magicsys -> platform; -magicsys -> nversion; -magicsys -> times; -magicsys -> idents; -magicsys -> rodread; -nimsets -> ast; -nimsets -> astalgo; -nimsets -> trees; -nimsets -> nversion; -nimsets -> msgs; -nimsets -> platform; -nimsets -> bitsets; -nimsets -> types; -nimsets -> rnimsyn; -passes -> strutils; -passes -> lists; -passes -> options; -passes -> ast; -passes -> astalgo; -passes -> llstream; -passes -> msgs; -passes -> platform; -passes -> os; -passes -> condsyms; -passes -> idents; -passes -> rnimsyn; -passes -> types; -passes -> extccomp; -passes -> math; -passes -> magicsys; -passes -> nversion; -passes -> nimsets; -passes -> syntaxes; -passes -> times; -passes -> rodread; -treetab -> nhashes; -treetab -> ast; -treetab -> astalgo; -treetab -> types; -semdata -> strutils; -semdata -> lists; -semdata -> options; -semdata -> scanner; -semdata -> ast; -semdata -> astalgo; -semdata -> trees; -semdata -> treetab; -semdata -> wordrecg; -semdata -> ropes; -semdata -> msgs; -semdata -> platform; -semdata -> os; -semdata -> condsyms; -semdata -> idents; -semdata -> rnimsyn; -semdata -> types; -semdata -> extccomp; -semdata -> math; -semdata -> magicsys; -semdata -> nversion; -semdata -> nimsets; -semdata -> pnimsyn; -semdata -> times; -semdata -> passes; -semdata -> rodread; -lookups -> ast; -lookups -> astalgo; -lookups -> idents; -lookups -> semdata; -lookups -> types; -lookups -> msgs; -lookups -> options; -lookups -> rodread; -lookups -> rnimsyn; -importer -> strutils; -importer -> os; -importer -> ast; -importer -> astalgo; -importer -> msgs; -importer -> options; -importer -> idents; -importer -> rodread; -importer -> lookups; -importer -> semdata; -importer -> passes; -rodwrite -> os; -rodwrite -> options; -rodwrite -> strutils; -rodwrite -> nversion; -rodwrite -> ast; -rodwrite -> astalgo; -rodwrite -> msgs; -rodwrite -> platform; -rodwrite -> condsyms; -rodwrite -> ropes; -rodwrite -> idents; -rodwrite -> crc; -rodwrite -> rodread; -rodwrite -> passes; -rodwrite -> importer; -semfold -> strutils; -semfold -> lists; -semfold -> options; -semfold -> ast; -semfold -> astalgo; -semfold -> trees; -semfold -> treetab; -semfold -> nimsets; -semfold -> times; -semfold -> nversion; -semfold -> platform; -semfold -> math; -semfold -> msgs; -semfold -> os; -semfold -> condsyms; -semfold -> idents; -semfold -> rnimsyn; -semfold -> types; -evals -> strutils; -evals -> magicsys; -evals -> lists; -evals -> options; -evals -> ast; -evals -> astalgo; -evals -> trees; -evals -> treetab; -evals -> nimsets; -evals -> msgs; -evals -> os; -evals -> condsyms; -evals -> idents; -evals -> rnimsyn; -evals -> types; -evals -> passes; -evals -> semfold; -procfind -> ast; -procfind -> astalgo; -procfind -> msgs; -procfind -> semdata; -procfind -> types; -procfind -> trees; -pragmas -> os; -pragmas -> platform; -pragmas -> condsyms; -pragmas -> ast; -pragmas -> astalgo; -pragmas -> idents; -pragmas -> semdata; -pragmas -> msgs; -pragmas -> rnimsyn; -pragmas -> wordrecg; -pragmas -> ropes; -pragmas -> options; -pragmas -> strutils; -pragmas -> lists; -pragmas -> extccomp; -pragmas -> math; -pragmas -> magicsys; -pragmas -> trees; -sem -> strutils; -sem -> nhashes; -sem -> lists; -sem -> options; -sem -> scanner; -sem -> ast; -sem -> astalgo; -sem -> trees; -sem -> treetab; -sem -> wordrecg; -sem -> ropes; -sem -> msgs; -sem -> os; -sem -> condsyms; -sem -> idents; -sem -> rnimsyn; -sem -> types; -sem -> platform; -sem -> math; -sem -> magicsys; -sem -> pnimsyn; -sem -> nversion; -sem -> nimsets; -sem -> semdata; -sem -> evals; -sem -> semfold; -sem -> importer; -sem -> procfind; -sem -> lookups; -sem -> rodread; -sem -> pragmas; -sem -> passes; -rst -> os; -rst -> msgs; -rst -> strutils; -rst -> platform; -rst -> nhashes; -rst -> ropes; -rst -> options; -highlite -> nhashes; -highlite -> options; -highlite -> msgs; -highlite -> strutils; -highlite -> platform; -highlite -> idents; -highlite -> lexbase; -highlite -> wordrecg; -highlite -> scanner; -docgen -> ast; -docgen -> astalgo; -docgen -> strutils; -docgen -> nhashes; -docgen -> options; -docgen -> nversion; -docgen -> msgs; -docgen -> os; -docgen -> ropes; -docgen -> idents; -docgen -> wordrecg; -docgen -> math; -docgen -> syntaxes; -docgen -> rnimsyn; -docgen -> scanner; -docgen -> rst; -docgen -> times; -docgen -> highlite; -ccgutils -> ast; -ccgutils -> astalgo; -ccgutils -> ropes; -ccgutils -> lists; -ccgutils -> nhashes; -ccgutils -> strutils; -ccgutils -> types; -ccgutils -> msgs; -cgmeth -> options; -cgmeth -> ast; -cgmeth -> astalgo; -cgmeth -> msgs; -cgmeth -> idents; -cgmeth -> rnimsyn; -cgmeth -> types; -cgmeth -> magicsys; -cgen -> ast; -cgen -> astalgo; -cgen -> strutils; -cgen -> nhashes; -cgen -> trees; -cgen -> platform; -cgen -> magicsys; -cgen -> extccomp; -cgen -> options; -cgen -> nversion; -cgen -> nimsets; -cgen -> msgs; -cgen -> crc; -cgen -> bitsets; -cgen -> idents; -cgen -> lists; -cgen -> types; -cgen -> ccgutils; -cgen -> os; -cgen -> times; -cgen -> ropes; -cgen -> math; -cgen -> passes; -cgen -> rodread; -cgen -> wordrecg; -cgen -> rnimsyn; -cgen -> treetab; -cgen -> cgmeth; -jsgen -> ast; -jsgen -> astalgo; -jsgen -> strutils; -jsgen -> nhashes; -jsgen -> trees; -jsgen -> platform; -jsgen -> magicsys; -jsgen -> extccomp; -jsgen -> options; -jsgen -> nversion; -jsgen -> nimsets; -jsgen -> msgs; -jsgen -> crc; -jsgen -> bitsets; -jsgen -> idents; -jsgen -> lists; -jsgen -> types; -jsgen -> os; -jsgen -> times; -jsgen -> ropes; -jsgen -> math; -jsgen -> passes; -jsgen -> ccgutils; -jsgen -> wordrecg; -jsgen -> rnimsyn; -jsgen -> rodread; -interact -> llstream; -interact -> strutils; -interact -> ropes; -interact -> nstrtabs; -interact -> msgs; -passaux -> strutils; -passaux -> ast; -passaux -> astalgo; -passaux -> passes; -passaux -> msgs; -passaux -> options; -depends -> os; -depends -> options; -depends -> ast; -depends -> astalgo; -depends -> msgs; -depends -> ropes; -depends -> idents; -depends -> passes; -depends -> importer; -transf -> strutils; -transf -> lists; -transf -> options; -transf -> ast; -transf -> astalgo; -transf -> trees; -transf -> treetab; -transf -> evals; -transf -> msgs; -transf -> os; -transf -> idents; -transf -> rnimsyn; -transf -> types; -transf -> passes; -transf -> semfold; -transf -> magicsys; -transf -> cgmeth; -main -> llstream; -main -> strutils; -main -> ast; -main -> astalgo; -main -> scanner; -main -> syntaxes; -main -> rnimsyn; -main -> options; -main -> msgs; -main -> os; -main -> lists; -main -> condsyms; -main -> paslex; -main -> pasparse; -main -> rodread; -main -> rodwrite; -main -> ropes; -main -> trees; -main -> wordrecg; -main -> sem; -main -> semdata; -main -> idents; -main -> passes; -main -> docgen; -main -> extccomp; -main -> cgen; -main -> jsgen; -main -> platform; -main -> interact; -main -> nimconf; -main -> importer; -main -> passaux; -main -> depends; -main -> transf; -main -> evals; -main -> types; -parseopt -> os; -parseopt -> strutils; -nimrod -> times; -nimrod -> commands; -nimrod -> scanner; -nimrod -> condsyms; -nimrod -> options; -nimrod -> msgs; -nimrod -> nversion; -nimrod -> nimconf; -nimrod -> ropes; -nimrod -> extccomp; -nimrod -> strutils; -nimrod -> os; -nimrod -> platform; -nimrod -> main; -nimrod -> parseopt; -} diff --git a/compiler/nimrod.ini b/compiler/nimrod.ini deleted file mode 100644 index 49dcd25ba..000000000 --- a/compiler/nimrod.ini +++ /dev/null @@ -1,145 +0,0 @@ -[Project] -Name: "Nimrod" -Version: "$version" -; Windows and i386 must be first! -OS: "windows;linux;macosx;solaris;freebsd;netbsd;openbsd" -CPU: "i386;amd64;powerpc64;arm" # ;sparc -Authors: "Andreas Rumpf" -Description: """This is the Nimrod Compiler. Nimrod is a new statically typed, -imperative programming language, that supports procedural, functional, object -oriented and generic programming styles while remaining simple and efficient. -A special feature that Nimrod inherited from Lisp is that Nimrod's abstract -syntax tree (AST) is part of the specification - this allows a powerful macro -system which can be used to create domain specific languages. - -Nimrod is a compiled, garbage-collected systems programming language -which has an excellent productivity/performance ratio. Nimrod's design -focuses on the 3E: efficiency, expressiveness, elegance (in the order of -priority).""" - -App: Console -License: "copying.txt" - -[Config] -Files: "config/nimrod.cfg" -Files: "config/nimdoc.cfg" -Files: "config/nimdoc.tex.cfg" - -[Documentation] -Files: "doc/*.txt" -Files: "doc/*.html" -Files: "doc/*.cfg" -Files: "doc/*.pdf" -Files: "doc/*.ini" -Start: "doc/overview.html" - - -[Other] -Files: "readme.txt;install.txt;contributors.txt;copying.txt" -Files: "configure;makefile" -Files: "*.ini" -Files: "koch.nim" - -Files: "icons/nimrod.ico" -Files: "icons/nimrod.rc" -Files: "icons/nimrod.res" -Files: "icons/nimrod_icon.o" -Files: "icons/koch.ico" -Files: "icons/koch.rc" -Files: "icons/koch.res" -Files: "icons/koch_icon.o" - -Files: "compiler/readme.txt" -Files: "compiler/nimrod.ini" -Files: "compiler/nimrod.cfg" -Files: "compiler/*.nim" -Files: "compiler/c2nim/*.nim" -Files: "compiler/c2nim/*.cfg" -Files: "compiler/pas2nim/*.nim" -Files: "compiler/pas2nim/*.cfg" - -Files: "build/empty.txt" -Files: "bin/empty.txt" - - -[Lib] -Files: "lib/nimbase.h" -Files: "lib/*.nim" -Files: "lib/*.cfg" - -Files: "lib/system/*.nim" -Files: "lib/core/*.nim" -Files: "lib/pure/*.nim" -Files: "lib/pure/collections/*.nim" -Files: "lib/impure/*.nim" -Files: "lib/wrappers/*.nim" - -Files: "lib/wrappers/cairo/*.nim" -Files: "lib/wrappers/gtk/*.nim" -Files: "lib/wrappers/lua/*.nim" -Files: "lib/wrappers/opengl/*.nim" -Files: "lib/wrappers/readline/*.nim" -Files: "lib/wrappers/sdl/*.nim" -Files: "lib/wrappers/x11/*.nim" -Files: "lib/wrappers/zip/*.nim" -Files: "lib/wrappers/zip/libzip_all.c" - -Files: "lib/windows/*.nim" -Files: "lib/posix/*.nim" -Files: "lib/js/*.nim" -Files: "lib/packages/docutils/*.nim" - - -[Other] -Files: "examples/*.nim" -Files: "examples/gtk/*.nim" -Files: "examples/0mq/*.nim" -Files: "examples/c++iface/*.nim" -Files: "examples/objciface/*.nim" -Files: "examples/cross_calculator/" - -Files: "examples/*.html" -Files: "examples/*.txt" -Files: "examples/*.cfg" -Files: "examples/*.tmpl" - - -[Windows] -Files: "bin/nimrod.exe" -Files: "bin/c2nim.exe" -Files: "bin/niminst.exe" -Files: "bin/nimgrep.exe" - -Files: "dist/*.dll" -Files: "koch.exe" -Files: "dist/mingw" -Files: "start.bat" -BinPath: r"bin;dist\mingw\bin;dist" -InnoSetup: "Yes" - - -[UnixBin] -Files: "bin/nimrod" - - -[Unix] -InstallScript: "yes" -UninstallScript: "yes" - - -[InnoSetup] -path = r"c:\Program Files (x86)\Inno Setup 5\iscc.exe" -flags = "/Q" - - -[C_Compiler] -path = r"" -flags = "-w" - - -[deb] -buildDepends: "gcc (>= 4:4.3.2)" -pkgDepends: "gcc (>= 4:4.3.2)" -shortDesc: "The Nimrod Compiler" -licenses: "bin/nimrod,MIT;lib/*,MIT;" - diff --git a/compiler/nimrod.nim b/compiler/nimrod.nim deleted file mode 100644 index 3fa80cebb..000000000 --- a/compiler/nimrod.nim +++ /dev/null @@ -1,80 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -when defined(gcc) and defined(windows): - when defined(x86): - {.link: "icons/nimrod.res".} - else: - {.link: "icons/nimrod_icon.o".} - -import - commands, lexer, condsyms, options, msgs, nversion, nimconf, ropes, - extccomp, strutils, os, platform, main, parseopt, service - -when hasTinyCBackend: - import tccgen - -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 HandleCmdLine() = - if paramCount() == 0: - writeCommandLineUsage() - else: - # Process command line arguments: - ProcessCmdLine(passCmd1, "") - if gProjectName != "": - try: - gProjectFull = canonicalizePath(gProjectName) - except EOS: - gProjectFull = gProjectName - var p = splitFile(gProjectFull) - gProjectPath = p.dir - gProjectName = p.name - else: - gProjectPath = getCurrentDir() - LoadConfigs(DefaultConfig) # 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, "") - MainCommand() - if gVerbosity >= 2: echo(GC_getStatistics()) - #echo(GC_getStatistics()) - if msgs.gErrorCounter == 0: - when hasTinyCBackend: - if gCmd == cmdRun: - tccgen.run() - if optRun in gGlobalOptions: - if gCmd == cmdCompileToJS: - var ex = quoteIfContainsWhite( - completeCFilePath(changeFileExt(gProjectFull, "js").prependCurDir)) - execExternalProgram("node " & ex & ' ' & service.arguments) - else: - var ex = quoteIfContainsWhite( - changeFileExt(gProjectFull, exeExt).prependCurDir) - execExternalProgram(ex & ' ' & service.arguments) - -when defined(GC_setMaxPause): - GC_setMaxPause 2_000 - -when compileOption("gc", "v2") or compileOption("gc", "refc"): - # the new correct mark&sweet collector is too slow :-/ - GC_disableMarkAndSweep() -condsyms.InitDefines() -HandleCmdLine() -quit(int8(msgs.gErrorCounter > 0)) diff --git a/compiler/nimsets.nim b/compiler/nimsets.nim index f874ccdca..7edf55278 100644 --- a/compiler/nimsets.nim +++ b/compiler/nimsets.nim @@ -1,187 +1,157 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # -# this unit handles Nimrod sets; it implements symbolic sets - -import - ast, astalgo, trees, nversion, msgs, platform, bitsets, types, renderer - -proc toBitSet*(s: PNode, b: var TBitSet) - # this function is used for case statement checking: -proc overlap*(a, b: PNode): bool -proc inSet*(s: PNode, elem: PNode): bool -proc someInSet*(s: PNode, a, b: PNode): bool -proc emptyRange*(a, b: PNode): bool -proc SetHasRange*(s: PNode): bool - # returns true if set contains a range (needed by the code generator) - # these are used for constant folding: -proc unionSets*(a, b: PNode): PNode -proc diffSets*(a, b: PNode): PNode -proc intersectSets*(a, b: PNode): PNode -proc symdiffSets*(a, b: PNode): PNode -proc containsSets*(a, b: PNode): bool -proc equalSets*(a, b: PNode): bool -proc cardSet*(s: PNode): BiggestInt -# implementation - -proc inSet(s: PNode, elem: PNode): bool = - if s.kind != nkCurly: - InternalError(s.info, "inSet") +# this unit handles Nim sets; it implements symbolic sets + +import + ast, astalgo, lineinfos, bitsets, types, options + +when defined(nimPreviewSlimSystem): + import std/assertions + +proc inSet*(s: PNode, elem: PNode): bool = + assert s.kind == nkCurly + if s.kind != nkCurly: + #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): + else: + if sameValue(s[i], elem): return true result = false -proc overlap(a, b: PNode): bool = +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) -proc SomeInSet(s: PNode, a, b: PNode): bool = +proc someInSet*(s: PNode, a, b: PNode): bool = # checks if some element of a..b is in the set s + assert s.kind == nkCurly if s.kind != nkCurly: - InternalError(s.info, "SomeInSet") + #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: + 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(s: PNode, b: var TBitSet) = - var first, j: BiggestInt - first = firstOrd(s.typ.sons[0]) - bitSetInit(b, int(getSize(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) - -proc ToTreeSet(s: TBitSet, settype: PType, info: TLineInfo): PNode = - var + else: + 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(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: - if bitSetIn(s, e): + 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 - Dec(b) - if a == b: - addSon(result, newIntTypeNode(nkIntLit, a + first, elemType)) - else: + while true: + inc(b) + if (b >= s.len * ElemSize) or not bitSetIn(s, b): break + dec(b) + let aa = newIntTypeNode(a + first, elemType) + aa.info = info + if a == b: + result.add aa + else: n = newNodeI(nkRange, info) n.typ = elemType - addSon(n, newIntTypeNode(nkIntLit, a + first, elemType)) - addSon(n, newIntTypeNode(nkIntLit, b + first, elemType)) - addSon(result, n) + n.add aa + let bb = newIntTypeNode(b + first, elemType) + bb.info = info + n.add bb + result.add n e = b - Inc(e) - -type - TSetOP = enum - soUnion, soDiff, soSymDiff, soIntersect - -proc nodeSetOp(a, b: PNode, op: TSetOp): PNode = - var x, y: TBitSet - toBitSet(a, x) - toBitSet(b, y) - case op - of soUnion: BitSetUnion(x, y) - of soDiff: BitSetDiff(x, y) - of soSymDiff: BitSetSymDiff(x, y) - of soIntersect: BitSetIntersect(x, y) - result = toTreeSet(x, a.typ, a.info) - -proc unionSets(a, b: PNode): PNode = - result = nodeSetOp(a, b, soUnion) - -proc diffSets(a, b: PNode): PNode = - result = nodeSetOp(a, b, soDiff) - -proc intersectSets(a, b: PNode): PNode = - result = nodeSetOp(a, b, soIntersect) - -proc symdiffSets(a, b: PNode): PNode = - result = nodeSetOp(a, b, soSymDiff) - -proc containsSets(a, b: PNode): bool = - var x, y: TBitSet - toBitSet(a, x) - toBitSet(b, y) + inc(e) + +template nodeSetOp(a, b: PNode, op: untyped) {.dirty.} = + var x = toBitSet(conf, a) + let y = toBitSet(conf, b) + op(x, y) + result = toTreeSet(conf, x, a.typ, a.info) + +proc unionSets*(conf: ConfigRef; a, b: PNode): PNode = nodeSetOp(a, b, bitSetUnion) +proc diffSets*(conf: ConfigRef; a, b: PNode): PNode = nodeSetOp(a, b, bitSetDiff) +proc intersectSets*(conf: ConfigRef; a, b: PNode): PNode = nodeSetOp(a, b, bitSetIntersect) +proc symdiffSets*(conf: ConfigRef; a, b: PNode): PNode = nodeSetOp(a, b, bitSetSymDiff) + +proc containsSets*(conf: ConfigRef; a, b: PNode): bool = + let x = toBitSet(conf, a) + let y = toBitSet(conf, b) result = bitSetContains(x, y) -proc equalSets(a, b: PNode): bool = - var x, y: TBitSet - toBitSet(a, x) - toBitSet(b, y) +proc equalSets*(conf: ConfigRef; a, b: PNode): bool = + let x = toBitSet(conf, a) + let y = toBitSet(conf, b) result = bitSetEquals(x, y) -proc complement*(a: PNode): PNode = - var x: TBitSet - toBitSet(a, x) - for i in countup(0, high(x)): x[i] = not x[i] - result = toTreeSet(x, a.typ, a.info) - -proc cardSet(s: PNode): BiggestInt = - # here we can do better than converting it into a compact set - # we just count the elements directly - result = 0 - for i in countup(0, sonsLen(s) - 1): - if s.sons[i].kind == nkRange: - result = result + getOrdValue(s.sons[i].sons[1]) - - getOrdValue(s.sons[i].sons[0]) + 1 - else: - Inc(result) - -proc SetHasRange(s: PNode): bool = +proc complement*(conf: ConfigRef; a: PNode): PNode = + 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 = + let x = toBitSet(conf, a) + result = toTreeSet(conf, x, a.typ, a.info) + +proc cardSet*(conf: ConfigRef; a: PNode): BiggestInt = + let x = toBitSet(conf, a) + result = bitSetCard(x) + +proc setHasRange*(s: PNode): bool = + assert s.kind == nkCurly if s.kind != nkCurly: - InternalError(s.info, "SetHasRange") 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 -proc emptyRange(a, b: PNode): bool = +proc emptyRange*(a, b: PNode): bool = result = not leValue(a, b) # a > b iff not (a <= b) - diff --git a/compiler/nodejs.nim b/compiler/nodejs.nim new file mode 100644 index 000000000..9753e1c99 --- /dev/null +++ b/compiler/nodejs.nim @@ -0,0 +1,10 @@ +import std/os + +proc findNodeJs*(): string {.inline.} = + ## Find NodeJS executable and return it as a string. + result = findExe("nodejs") + if result.len == 0: + result = findExe("node") + if result.len == 0: + echo "Please install NodeJS first, see https://nodejs.org/en/download" + raise newException(IOError, "NodeJS not found in PATH") diff --git a/compiler/nodekinds.nim b/compiler/nodekinds.nim new file mode 100644 index 000000000..ccdbbd26d --- /dev/null +++ b/compiler/nodekinds.nim @@ -0,0 +1,211 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## NodeKind enum. + +type + TNodeKind* = enum # order is extremely important, because ranges are used + # to check whether a node belongs to a certain class + nkNone, # unknown node kind: indicates an error + # Expressions: + # Atoms: + nkEmpty, # the node is empty + nkIdent, # node is an identifier + nkSym, # node is a symbol + nkType, # node is used for its typ field + + nkCharLit, # a character literal '' + nkIntLit, # an integer literal + nkInt8Lit, + nkInt16Lit, + nkInt32Lit, + nkInt64Lit, + nkUIntLit, # an unsigned integer literal + nkUInt8Lit, + nkUInt16Lit, + nkUInt32Lit, + nkUInt64Lit, + nkFloatLit, # a floating point literal + nkFloat32Lit, + nkFloat64Lit, + nkFloat128Lit, + nkStrLit, # a string literal "" + nkRStrLit, # a raw string literal r"" + nkTripleStrLit, # a triple string literal """ + nkNilLit, # the nil literal + # end of atoms + nkComesFrom, # "comes from" template/macro information for + # better stack trace generation + nkDotCall, # used to temporarily flag a nkCall node; + # this is used + # for transforming ``s.len`` to ``len(s)`` + + nkCommand, # a call like ``p 2, 4`` without parenthesis + nkCall, # a call like p(x, y) or an operation like +(a, b) + nkCallStrLit, # a call with a string literal + # x"abc" has two sons: nkIdent, nkRStrLit + # x"""abc""" has two sons: nkIdent, nkTripleStrLit + nkInfix, # a call like (a + b) + nkPrefix, # a call like !a + nkPostfix, # something like a! (also used for visibility) + nkHiddenCallConv, # an implicit type conversion via a type converter + + nkExprEqExpr, # a named parameter with equals: ''expr = expr'' + nkExprColonExpr, # a named parameter with colon: ''expr: expr'' + nkIdentDefs, # a definition like `a, b: typeDesc = expr` + # either typeDesc or expr may be nil; used in + # formal parameters, var statements, etc. + nkVarTuple, # a ``var (a, b) = expr`` construct + nkPar, # syntactic (); may be a tuple constructor + nkObjConstr, # object constructor: T(a: 1, b: 2) + nkCurly, # syntactic {} + nkCurlyExpr, # an expression like a{i} + nkBracket, # syntactic [] + nkBracketExpr, # an expression like a[i..j, k] + nkPragmaExpr, # an expression like a{.pragmas.} + nkRange, # an expression like i..j + nkDotExpr, # a.b + nkCheckedFieldExpr, # a.b, but b is a field that needs to be checked + nkDerefExpr, # a^ + nkIfExpr, # if as an expression + nkElifExpr, + nkElseExpr, + nkLambda, # lambda expression + nkDo, # lambda block appering as trailing proc param + nkAccQuoted, # `a` as a node + + nkTableConstr, # a table constructor {expr: expr} + nkBind, # ``bind expr`` node + nkClosedSymChoice, # symbol choice node; a list of nkSyms (closed) + nkOpenSymChoice, # symbol choice node; a list of nkSyms (open) + nkHiddenStdConv, # an implicit standard type conversion + nkHiddenSubConv, # an implicit type conversion from a subtype + # to a supertype + nkConv, # a type conversion + nkCast, # a type cast + nkStaticExpr, # a static expr + nkAddr, # a addr expression + nkHiddenAddr, # implicit address operator + nkHiddenDeref, # implicit ^ operator + nkObjDownConv, # down conversion between object types + nkObjUpConv, # up conversion between object types + nkChckRangeF, # range check for floats + nkChckRange64, # range check for 64 bit ints + nkChckRange, # range check for ints + nkStringToCString, # string to cstring + nkCStringToString, # cstring to string + # end of expressions + + nkAsgn, # a = b + nkFastAsgn, # internal node for a fast ``a = b`` + # (no string copy) + nkGenericParams, # generic parameters + nkFormalParams, # formal parameters + nkOfInherit, # inherited from symbol + + nkImportAs, # a 'as' b in an import statement + nkProcDef, # a proc + nkMethodDef, # a method + nkConverterDef, # a converter + nkMacroDef, # a macro + nkTemplateDef, # a template + nkIteratorDef, # an iterator + + nkOfBranch, # used inside case statements + # for (cond, action)-pairs + nkElifBranch, # used in if statements + nkExceptBranch, # an except section + nkElse, # an else part + nkAsmStmt, # an assembler block + nkPragma, # a pragma statement + nkPragmaBlock, # a pragma with a block + nkIfStmt, # an if statement + nkWhenStmt, # a when expression or statement + nkForStmt, # a for statement + nkParForStmt, # a parallel for statement + nkWhileStmt, # a while statement + nkCaseStmt, # a case statement + nkTypeSection, # a type section (consists of type definitions) + nkVarSection, # a var section + nkLetSection, # a let section + nkConstSection, # a const section + nkConstDef, # a const definition + nkTypeDef, # a type definition + nkYieldStmt, # the yield statement as a tree + nkDefer, # the 'defer' statement + nkTryStmt, # a try statement + nkFinally, # a finally section + nkRaiseStmt, # a raise statement + nkReturnStmt, # a return statement + nkBreakStmt, # a break statement + nkContinueStmt, # a continue statement + nkBlockStmt, # a block statement + nkStaticStmt, # a static statement + nkDiscardStmt, # a discard statement + nkStmtList, # a list of statements + nkImportStmt, # an import statement + nkImportExceptStmt, # an import x except a statement + nkExportStmt, # an export statement + nkExportExceptStmt, # an 'export except' statement + nkFromStmt, # a from * import statement + nkIncludeStmt, # an include statement + nkBindStmt, # a bind statement + nkMixinStmt, # a mixin statement + nkUsingStmt, # an using statement + nkCommentStmt, # a comment statement + nkStmtListExpr, # a statement list followed by an expr; this is used + # to allow powerful multi-line templates + nkBlockExpr, # a statement block ending in an expr; this is used + # to allow powerful multi-line templates that open a + # temporary scope + nkStmtListType, # a statement list ending in a type; for macros + nkBlockType, # a statement block ending in a type; for macros + # types as syntactic trees: + + nkWith, # distinct with `foo` + nkWithout, # distinct without `foo` + + nkTypeOfExpr, # type(1+2) + nkObjectTy, # object body + nkTupleTy, # tuple body + nkTupleClassTy, # tuple type class + nkTypeClassTy, # user-defined type class + nkStaticTy, # ``static[T]`` + nkRecList, # list of object parts + nkRecCase, # case section of object + nkRecWhen, # when section of object + nkRefTy, # ``ref T`` + nkPtrTy, # ``ptr T`` + nkVarTy, # ``var T`` + nkConstTy, # ``const T`` + nkOutTy, # ``out T`` + nkDistinctTy, # distinct type + nkProcTy, # proc type + nkIteratorTy, # iterator type + nkSinkAsgn, # '=sink(x, y)' + nkEnumTy, # enum body + nkEnumFieldDef, # `ident = expr` in an enumeration + nkArgList, # argument list + nkPattern, # a special pattern; used for matching + nkHiddenTryStmt, # a hidden try statement + nkClosure, # (prc, env)-pair (internally used for code gen) + nkGotoState, # used for the state machine (for iterators) + nkState, # give a label to a code section (for iterators) + nkBreakState, # special break statement for easier code generation + nkFuncDef, # a func + nkTupleConstr # a tuple constructor + nkError # erroneous AST node + nkModuleRef # for .rod file support: A (moduleId, itemId) pair + nkReplayAction # for .rod file support: A replay action + nkNilRodNode # for .rod file support: a 'nil' PNode + nkOpenSym # container for captured sym that can be overriden by local symbols + +const + nkCallKinds* = {nkCall, nkInfix, nkPrefix, nkPostfix, + nkCommand, nkCallStrLit, nkHiddenCallConv} diff --git a/compiler/nversion.nim b/compiler/nversion.nim index 498f418ab..811008989 100644 --- a/compiler/nversion.nim +++ b/compiler/nversion.nim @@ -1,22 +1,22 @@ # # -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # -# This module contains Nimrod's version. It is the only place where it needs +# This module contains Nim's version. It is the only place where it needs # to be changed. -const +const MaxSetElements* = 1 shl 16 # (2^16) to support unicode character sets? - defaultAsmMarkerSymbol* = '!' - VersionMajor* = 0 - VersionMinor* = 9 - VersionPatch* = 3 - VersionAsString* = $VersionMajor & "." & $VersionMinor & "." & $VersionPatch - - RodFileVersion* = "1212" # modify this if the rod-format changes! + 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* = 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 5f173d240..b77bdd2a3 100644 --- a/compiler/options.nim +++ b/compiler/options.nim @@ -1,277 +1,1017 @@ # # -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # import - os, lists, strutils, strtabs - + 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] + + const hasTinyCBackend* = defined(tinyc) useEffectSystem* = true - hasFFI* = defined(useFFI) - newScopeForIf* = true + useWriteTracking* = false + 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, - optAssert, optLineDir, optWarns, optHints, - optOptimizeSpeed, optOptimizeSize, optStackTrace, # stack tracing support + optNone, optObjCheck, optFieldCheck, optRangeCheck, optBoundsCheck, + optOverflowCheck, optRefCheck, + optNaNCheck, optInfCheck, optStaticBoundsCheck, optStyleCheck, + optAssert, optLineDir, optWarns, optHints, + optOptimizeSpeed, optOptimizeSize, + optStackTrace, # stack tracing support + optStackTraceMsgs, # enable custom runtime msgs via `setFrameMsg` optLineTrace, # line tracing support (includes stack tracing) - 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, + optSinkInference # 'sink T' inference + optCursorInference + optImportHidden + optQuirky TOptions* = set[TOption] - TGlobalOption* = enum # **keep binary compatible** - gloptNone, optForceFullMake, optDeadCodeElim, - optListCmd, optCompileOnly, optNoLinking, - optSafeCode, # only allow safe code + TGlobalOption* = enum + gloptNone, optForceFullMake, + 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 - optSymbolFiles, # use symbol files for speeding up compilation - optCaasEnabled # compiler-as-a-service is running - 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 - optSuggest, # ideTools: 'suggest' - optContext, # ideTools: 'context' - optDef, # ideTools: 'def' - optUsages, # ideTools: 'usages' 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 + optIdeExceptionInlayHints + optExcessiveStackTrace # fully qualified module filenames + optShowAllMismatches # show all overloading resolution candidates + optWholeProject # for 'doc': output any dependency + optDocInternal # generate documentation for non-exported symbols + optMixedMode # true if some module triggered C++ codegen + optDeclaredLocs # show declaration locations in messages + optNoNimblePath + optHotCodeReloading + optDynlibOverrideAll + optSeqDestructors # active if the implementation uses the new + # string/seq implementation based on destructors + optTinyRtti # active if we use the new "tiny RTTI" + # implementation + optOwnedRefs # active if the Nim compiler knows about 'owned'. + 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] - TCommands* = enum # Nimrod'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 - TStringSeq* = seq[string] - TGCMode* = enum # the selected GC - gcNone, gcBoehm, gcMarkAndSweep, gcRefc, gcV2, gcGenerational const - ChecksOptions* = {optObjCheck, optFieldCheck, optRangeCheck, optNilCheck, - optOverflowCheck, optBoundsCheck, optAssert, optNaNCheck, optInfCheck} - -var - gOptions*: TOptions = {optObjCheck, optFieldCheck, optRangeCheck, - optBoundsCheck, optOverflowCheck, optAssert, optWarns, - optHints, optStackTrace, optLineTrace, - optPatterns, optNilCheck} - gGlobalOptions*: TGlobalOptions = {optThreadAnalysis} - gExitcode*: int8 - gCmd*: TCommands = cmdNone # the command - gSelectedGC* = gcRefc # the selected GC - searchPaths*, lazyPaths*: TLinkedList - outFile*: string = "" - headerFile*: string = "" - gVerbosity* = 1 # how verbose the compiler is - gNumberOfProcessors*: int # number of processors - gWholeProject*: bool # for 'doc2': output any dependency - gEvalExpr* = "" # expression for idetools --eval - gLastCmdTime*: float # when caas is enabled, we measure each command - gListFullPaths*: bool - isServing*: bool = false - gDirtyBufferIdx* = 0'i32 # indicates the fileIdx of the dirty version of - # the tracked source X, saved by the CAAS client. - gDirtyOriginalIdx* = 0'i32 # the original source file of the dirtified buffer. - -proc importantComments*(): bool {.inline.} = gCmd in {cmdDoc, cmdIdeTools} -proc usesNativeGC*(): bool {.inline.} = gSelectedGC >= gcRefc - -template isWorkingWithDirtyBuffer*: expr = - gDirtyBufferIdx != 0 - -template compilationCachePresent*: expr = - {optCaasEnabled, optSymbolFiles} * gGlobalOptions != {} - -template optPreserveOrigSource*: expr = - optEmbedOrigSrc in gGlobalOptions - -template optPrintSurroundingSrc*: expr = - gVerbosity >= 2 - -const - genSubDir* = "nimcache" + harmlessOptions* = {optForceFullMake, optNoLinking, optRun, optUseColors, optStdout} + genSubDir* = RelativeDir"nimcache" NimExt* = "nim" RodExt* = "rod" HtmlExt* = "html" + JsonExt* = "json" + TagsExt* = "tags" TexExt* = "tex" IniExt* = "ini" - DefaultConfig* = "nimrod.cfg" - DocConfig* = "nimdoc.cfg" - DocTexConfig* = "nimdoc.tex.cfg" - -# additional configuration variables: -var - gConfigVars* = newStringTable(modeStyleInsensitive) - gDllOverrides = newStringtable(modeCaseInsensitive) - libpath* = "" - gProjectName* = "" # holds a name like 'nimrod' - gProjectPath* = "" # holds a path like /home/alice/projects/nimrod/compiler/ - gProjectFull* = "" # projectPath/projectName - gProjectMainIdx*: int32 # the canonical path id of the main module - optMainModule* = "" # the main module that should be used for idetools commands - nimcacheDir* = "" - command* = "" # the main command (e.g. cc, check, scan, etc) - commandArgs*: seq[string] = @[] # any arguments after the main command - gKeepComments*: bool = true # whether the parser needs to keep comments - implicitImports*: seq[string] = @[] # modules that are to be implicitly imported - implicitIncludes*: seq[string] = @[] # modules that are to be implicitly included - -const oKeepVariableNames* = true - -proc mainCommandArg*: string = + 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 + TStringSeq* = seq[string] + TGCMode* = enum # the selected GC + 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, ideChkFile, ideMod, + ideHighlight, ideOutline, ideKnown, ideMsg, ideProject, ideGlobalSymbols, + ideRecompile, ideChanged, ideType, ideDeclaration, ideExpand, ideInlayHints + + Feature* = enum ## experimental features; DO NOT RENAME THESE! + dotOperators, + callOperator, + parallel, + destructor, + 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, stressTest + + TSystemCC* = enum + 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 + nimname*: string + cname*, obj*: AbsoluteFile + flags*: set[CfileFlag] + customArgs*: string + CfileList* = seq[Cfile] + + Suggest* = ref object + section*: IdeCmd + qualifiedPath*: seq[string] + name*: ptr string # not used beyond sorting purposes; name is also + # part of 'qualifiedPath' + filePath*: string + line*: int # Starts at 1 + column*: int # Starts at 0 + doc*: string # Not escaped (yet) + forth*: string # type + quality*: range[0..100] # matching quality + isGlobal*: bool # is a global variable + contextFits*: bool # type/non-type context matches + prefix*: PrefixMatch + symkind*: byte + scope*, localUsages*, globalUsages*: int # more usages is better + tokenLen*: int + version*: int + endLine*: uint16 + endCol*: int + inlayHintInfo*: SuggestInlayHint + + Suggestions* = seq[Suggest] + + SuggestInlayHintKind* = enum + sihkType = "Type", + sihkParameter = "Parameter" + sihkException = "Exception" + + SuggestInlayHint* = ref object + kind*: SuggestInlayHintKind + line*: int # Starts at 1 + column*: int # Starts at 0 + label*: string + paddingLeft*: bool + paddingRight*: bool + allowInsert*: bool + tooltip*: string + + ProfileInfo* = object + time*: float + count*: int + + 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 + 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*: Command # raw command parsed as enum + cmdInput*: string # input command + projectIsCmd*: bool # whether we're compiling from a command input + implicitCmd*: bool # whether some flag triggered an implicit `command` + selectedGC*: TGCMode # the selected GC (+) + exc*: ExceptionSystem + hintProcessingDots*: bool # true for dots, false for filenames + verbosity*: int # how verbose the compiler is + numberOfProcessors*: int # number of processors + lastCmdTime*: float # when caas is enabled, we measure each command + 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 + ideCmd*: IdeCmd + cCompiler*: TSystemCC # the used compiler + modifiedyNotes*: TNoteKinds # notes that have been set/unset from either cmdline/configs + cmdlineNotes*: TNoteKinds # notes that have been set/unset from cmdline + foreignPackageNotes*: TNoteKinds + notes*: TNoteKinds # notes after resolving all logic(defaults, verbosity)/cmdline/configs + warningAsErrors*: TNoteKinds + mainPackageNotes*: TNoteKinds + 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 + 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*: AbsoluteDir # holds a path like /home/alice/projects/nim/compiler/ + projectFull*: AbsoluteFile # projectPath/projectName + projectIsStdin*: bool # whether we're compiling from stdin + lastMsgWasDot*: set[StdOrrKind] # the last compiler message was a single '.' + projectMainIdx*: FileIndex # the canonical path id of the main module + projectMainIdx2*: FileIndex # consider merging with projectMainIdx + command*: string # the main command (e.g. cc, check, scan, etc) + commandArgs*: seq[string] # any arguments after the main command + commandLine*: string + extraCmds*: seq[string] # for writeJsonBuildInstructions + implicitImports*: seq[string] # modules that are to be implicitly imported + implicitIncludes*: seq[string] # modules that are to be implicitly included + docSeeSrcUrl*: string # if empty, no seeSrc will be generated. \ + # The string uses the formatting variables `path` and `line`. + docRoot*: string ## see nim --fullhelp for --docRoot + docCmd*: string ## see nim --fullhelp for --docCmd + + configFiles*: seq[AbsoluteFile] # config files (cfg,nims) + cIncludes*: seq[AbsoluteDir] # directories to search for included files + cLibs*: seq[AbsoluteDir] # directories to search for lib files + cLinkedLibs*: seq[string] # libraries to link + + externalToLink*: seq[string] # files to link in addition to the file + # we compiled (*) + linkOptionsCmd*: string + compileOptionsCmd*: seq[string] + linkOptions*: string # (*) + compileOptions*: string # (*) + cCompilerPath*: string + toCompile*: CfileList # (*) + suggestionResultHook*: proc (result: Suggest) {.closure.} + suggestVersion*: int + suggestMaxResults*: int + lastLineInfo*: TLineInfo + writelnHook*: proc (output: string) {.closure, gcsafe.} + structuredErrorHook*: proc (config: ConfigRef; info: TLineInfo; msg: string; + severity: Severity) {.closure, gcsafe.} + cppCustomNamespace*: string + nimMainPrefix*: string + vmProfileData*: ProfileData + + expandProgress*: bool + expandLevels*: int + expandNodeResult*: string + expandPosition*: TLineInfo + + currentConfigDir*: string # used for passPP only; absolute dir + clientProcessId*: int + + + +proc assignIfDefault*[T](result: var T, val: T, def = default(T)) = + ## if `result` was already assigned to a value (that wasn't `def`), this is a noop. + if result == def: result = val + +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) + +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) + +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, + optOverflowCheck, optBoundsCheck, optAssert, optNaNCheck, optInfCheck, + optStyleCheck} + + DefaultOptions* = {optObjCheck, optFieldCheck, optRangeCheck, + 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: + modeCaseInsensitive + 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( + cCompiler: ccGcc, + macrosToExpand: newStringTable(modeStyleInsensitive), + arcToExpand: newStringTable(modeStyleInsensitive), + m: initMsgConfig(), + cppDefines: initHashSet[string](), + headerFile: "", features: {}, legacyFeatures: {}, + configVars: newStringTable(modeStyleInsensitive), + symbols: newStringTable(modeStyleInsensitive), + packageCache: newPackageCache(), + searchPaths: @[], + lazyPaths: @[], + 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: 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 + 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: @[], + linkOptions: "", + compileOptions: "", + ccompilerpath: "", + toCompile: @[], + arguments: "", + 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. + 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 = true + elif cmpIgnoreStyle(symbol, CPU[conf.target.targetCPU].name) == 0: + result = true + elif cmpIgnoreStyle(symbol, platform.OS[conf.target.targetOS].name) == 0: + result = true + else: + case symbol.normalize + of "x86": result = conf.target.targetCPU == cpuI386 + of "itanium": result = conf.target.targetCPU == cpuIa64 + of "x8664": result = conf.target.targetCPU == cpuAmd64 + of "posix", "unix": + result = conf.target.targetOS in {osLinux, osMorphos, osSkyos, osIrix, osPalmos, + osQnx, osAtari, osAix, + osHaiku, osVxWorks, osSolaris, osNetbsd, + 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, 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, osIos} + of "osx", "macosx": + result = conf.target.targetOS in {osMacosx, osIos} + of "sunos": result = conf.target.targetOS == osSolaris + 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 + of "cpu64": result = CPU[conf.target.targetCPU].bit == 64 + of "nimrawsetjmp": + result = conf.target.targetOS in {osSolaris, osNetbsd, osFreebsd, osOpenbsd, + osDragonfly, osMacosx} + else: result = false + +template quitOrRaise*(conf: ConfigRef, msg = "") = + # xxx in future work, consider whether to also intercept `msgQuit` calls + if conf.isDefined("nimDebug"): + raiseAssert msg + else: + quit(msg) # quits with QuitFailure + +proc importantComments*(conf: ConfigRef): bool {.inline.} = conf.cmd in cmdDocLike + {cmdIdeTools} +proc usesWriteBarrier*(conf: ConfigRef): bool {.inline.} = conf.selectedGC >= gcRefc + +template compilationCachePresent*(conf: ConfigRef): untyped = + false +# conf.symbolFiles in {v2Sf, writeOnlySf} + +template optPreserveOrigSource*(conf: ConfigRef): untyped = + optEmbedOrigSrc in conf.globalOptions + +proc mainCommandArg*(conf: ConfigRef): string = ## This is intended for commands like check or parse ## which will work on the main project file unless ## explicitly given a specific file argument - if commandArgs.len > 0: - result = commandArgs[0] + if conf.commandArgs.len > 0: + result = conf.commandArgs[0] + else: + result = conf.projectName + +proc existsConfigVar*(conf: ConfigRef; key: string): bool = + result = hasKey(conf.configVars, 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: 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`` + ## 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.isEmpty: + # choose default libpath: + var prefix = getPrefixDir(conf) + 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.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 (path.len > 0) and (path[^1] == DirSep): + result = substr(path, 0, path.len - 2) else: - result = gProjectName - -proc existsConfigVar*(key: string): bool = - result = hasKey(gConfigVars, key) - -proc getConfigVar*(key: string): string = - result = gConfigVars[key] - -proc setConfigVar*(key, val: string) = - gConfigVars[key] = val - -proc getOutFile*(filename, ext: string): string = - if options.outFile != "": result = options.outFile - else: result = changeFileExt(filename, ext) - -proc getPrefixDir*(): string = - ## gets the application directory - result = SplitPath(getAppDir()).head - -proc canonicalizePath*(path: string): string = - result = path.expandFilename - when not FileSystemCaseSensitive: result = result.toLower - -proc shortenDir*(dir: string): string = - ## returns the interesting part of a dir - var prefix = getPrefixDir() & dirSep - if startsWith(dir, prefix): - return substr(dir, len(prefix)) - prefix = gProjectPath & dirSep - if startsWith(dir, prefix): - return substr(dir, len(prefix)) - result = dir - -proc removeTrailingDirSep*(path: string): string = - if (len(path) > 0) and (path[len(path) - 1] == dirSep): - result = substr(path, 0, len(path) - 2) - else: result = path - -proc getGeneratedPath: string = - result = if nimcacheDir.len > 0: nimcacheDir else: gProjectPath.shortenDir / - genSubDir - -proc toGeneratedFile*(path, ext: string): string = + +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 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).string, + "lib", conf.libpath.string, + "home", home, + "config", config, + "projectname", conf.projectName, + "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: 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([getGeneratedPath(), changeFileExt(tail, ext)]) - #echo "toGeneratedFile(", path, ", ", ext, ") = ", result - -proc completeGeneratedFilePath*(f: string, createSubDir: bool = true): string = - var (head, tail) = splitPath(f) - #if len(head) > 0: head = removeTrailingDirSep(shortenDir(head & dirSep)) - var subdir = getGeneratedPath() # / 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) - except EOS: - writeln(stdout, "cannot create directory: " & subdir) - quit(1) - result = joinPath(subdir, tail) - #echo "completeGeneratedFilePath(", f, ") = ", result - -iterator iterSearchPath*(SearchPaths: TLinkedList): string = - var it = PStrEntry(SearchPaths.head) - while it != nil: - yield it.data - it = PStrEntry(it.Next) - -proc rawFindFile(f: string): string = - for it in iterSearchPath(SearchPaths): - result = JoinPath(it, f) - if existsFile(result): - return result.canonicalizePath - result = "" - -proc rawFindFile2(f: string): string = - var it = PStrEntry(lazyPaths.head) - while it != nil: - result = JoinPath(it.data, f) - if existsFile(result): - bringToFront(lazyPaths, it) - return result.canonicalizePath - it = PStrEntry(it.Next) - result = "" - -proc FindFile*(f: string): string {.procvar.} = - result = f.rawFindFile - if result.len == 0: - result = f.toLower.rawFindFile - if result.len == 0: - result = f.rawFindFile2 - if result.len == 0: - result = f.toLower.rawFindFile2 - -proc findModule*(modulename: string): string {.inline.} = + try: + createDir(subdir.string) + except OSError: + conf.quitOrRaise "cannot create directory: " & subdir.string + result = subdir / RelativeFile f.string.splitPath.tail + +proc rawFindFile(conf: ConfigRef; f: RelativeFile; suppressStdlib: bool): AbsoluteFile = + for it in conf.searchPaths: + if suppressStdlib and it.string.startsWith(conf.libpath.string): + continue + result = it / f + if fileExists(result): + return canonicalizePath(conf, result) + result = AbsoluteFile"" + +proc rawFindFile2(conf: ConfigRef; f: RelativeFile): AbsoluteFile = + for i, it in conf.lazyPaths: + result = it / f + if fileExists(result): + # bring to front + for j in countdown(i, 1): + swap(conf.lazyPaths[j], conf.lazyPaths[j-1]) + + return canonicalizePath(conf, result) + result = AbsoluteFile"" + +template patchModule(conf: ConfigRef) {.dirty.} = + 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 = AbsoluteFile(ov) + +const stdlibDirs* = [ + "pure", "core", "arch", + "pure/collections", + "pure/concurrency", + "pure/unidecode", "impure", + "wrappers", "wrappers/linenoise", + "windows", "posix", "js", + "deprecated/pure"] + +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.fileExists: AbsoluteFile(f) else: AbsoluteFile"" + else: + 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): AbsoluteFile = # returns path to module - result = FindFile(AddFileExt(modulename, nimExt)) - -proc libCandidates*(s: string, dest: var seq[string]) = - var le = strutils.find(s, '(') - var ri = strutils.find(s, ')', le+1) - if le >= 0 and ri > le: - var prefix = substr(s, 0, le - 1) - var suffix = substr(s, ri + 1) - for middle in split(substr(s, le + 1, ri - 1), '|'): - libCandidates(prefix & middle & suffix, dest) - else: - add(dest, s) + var m = addFileExt(modulename, NimExt) + var hasRelativeDot = false + if m.startsWith(pkgPrefix): + result = findFile(conf, m.substr(pkgPrefix.len), suppressStdlib = true) + else: + if m.startsWith(stdPrefix): + result = AbsoluteFile("") + let stripped = m.substr(stdPrefix.len) + for candidate in stdlibDirs: + let path = (conf.libpath.string / candidate / stripped) + if fileExists(path): + 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] = @[] + 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 @@ -281,28 +1021,70 @@ proc canonDynlibName(s: string): string = else: result = s.substr(start) -proc inclDynlibOverride*(lib: string) = - gDllOverrides[lib.canonDynlibName] = "true" - -proc isDynlibOverride*(lib: string): bool = - result = gDllOverrides.hasKey(lib.canonDynlibName) - -proc binaryStrSearch*(x: openarray[string], y: string): int = - var a = 0 - var b = len(x) - 1 - while a <= b: - var mid = (a + b) div 2 - var c = cmpIgnoreCase(x[mid], y) - if c < 0: - a = mid + 1 - elif c > 0: - b = mid - 1 - else: - return mid - result = - 1 - -template nimdbg*: expr = c.module.fileIdx == gProjectMainIdx -template cnimdbg*: expr = p.module.module.fileIdx == gProjectMainIdx -template pnimdbg*: expr = p.lex.fileIdx == gProjectMainIdx -template lnimdbg*: expr = L.fileIdx == gProjectMainIdx +proc inclDynlibOverride*(conf: ConfigRef; lib: string) = + conf.dllOverrides[lib.canonDynlibName] = "true" + +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 + of "con": ideCon + of "def": ideDef + 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 = + case c: + of ideSug: "sug" + of ideCon: "con" + of ideDef: "def" + 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 new file mode 100644 index 000000000..30f407792 --- /dev/null +++ b/compiler/packagehandling.nim @@ -0,0 +1,44 @@ +# +# +# The Nim Compiler +# (c) Copyright 2017 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +iterator myParentDirs(p: string): string = + # XXX os's parentDirs is stupid (multiple yields) and triggers an old bug... + var current = p + while true: + current = current.parentDir + if current.len == 0: break + yield current + +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): + if conf.packageCache.hasKey(d): + #echo "from cache ", d, " |", packageCache[d], "|", path.splitFile.name + return conf.packageCache[d] + inc parents + for file in walkFiles(d / "*.nimble"): + result = file + break packageSearch + # we also store if we didn't find anything: + for d in myParentDirs(path): + #echo "set cache ", d, " |", result, "|", parents + conf.packageCache[d] = result + dec parents + if parents <= 0: break + +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: + 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 283f83906..e8ec22fe1 100644 --- a/compiler/parampatterns.nim +++ b/compiler/parampatterns.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -10,7 +10,10 @@ ## This module implements the pattern matching features for term rewriting ## macro support. -import strutils, ast, astalgo, types, msgs, idents, renderer, wordrecg +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 @@ -24,7 +27,7 @@ type ppEof = 1, # end of compiled pattern ppOr, # we could short-cut the evaluation for 'and' and 'or', ppAnd, # but currently we don't - ppNot, + ppNot, ppSym, ppAtom, ppLit, @@ -41,11 +44,11 @@ type const MaxStackSize* = 64 ## max required stack size by the VM -proc patternError(n: PNode) = - LocalError(n.info, errIllFormedAstX, renderTree(n, {renderNoComments})) +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: @@ -53,42 +56,42 @@ proc whichAlias*(p: PSym): TAliasRequest = else: result = aqNone -proc compileConstraints(p: PNode, result: var TPatternCode) = +proc compileConstraints(p: PNode, result: var TPatternCode; conf: ConfigRef) = case p.kind of nkCallKinds: - if p.sons[0].kind != nkIdent: - patternError(p.sons[0]) + 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) - compileConstraints(p.sons[2], result) + 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) - compileConstraints(p.sons[2], result) + compileConstraints(p[1], result, conf) + compileConstraints(p[2], result, conf) result.add(ppAnd) else: - patternError(p) + patternError(p, conf) elif p.len == 2 and (op.s == "~" or op.id == ord(wNot)): - compileConstraints(p.sons[1], result) + compileConstraints(p[1], result, conf) result.add(ppNot) else: - patternError(p) + patternError(p, conf) of nkAccQuoted, nkPar: if p.len == 1: - compileConstraints(p.sons[0], result) + compileConstraints(p[0], result, conf) else: - patternError(p) + patternError(p, conf) of nkIdent: let spec = p.ident.s.normalize case spec - of "atom": result.add(ppAtom) - of "lit": result.add(ppLit) - of "sym": result.add(ppSym) + of "atom": result.add(ppAtom) + of "lit": result.add(ppLit) + of "sym": result.add(ppSym) of "ident": result.add(ppIdent) - of "call": result.add(ppCall) + of "call": result.add(ppCall) of "alias": result[0] = chr(aqShouldAlias.ord) of "noalias": result[0] = chr(aqNoAlias.ord) of "lvalue": result.add(ppLValue) @@ -97,55 +100,56 @@ proc compileConstraints(p: PNode, result: var TPatternCode) = of "nosideeffect": result.add(ppNoSideEffect) else: # check all symkinds: - InternalAssert int(high(TSymKind)) < 255 - for i in low(TSymKind)..high(TSymKind): - if cmpIgnoreStyle(($i).substr(2), spec) == 0: + internalAssert conf, int(high(TSymKind)) < 255 + for i in TSymKind: + if cmpIgnoreStyle(i.toHumanStr, spec) == 0: result.add(ppSymKind) result.add(chr(i.ord)) return # check all nodekinds: - InternalAssert int(high(TNodeKind)) < 255 - for i in low(TNodeKind)..high(TNodeKind): + internalAssert conf, int(high(TNodeKind)) < 255 + for i in TNodeKind: if cmpIgnoreStyle($i, spec) == 0: result.add(ppNodeKind) result.add(chr(i.ord)) return - patternError(p) + patternError(p, conf) else: - patternError(p) + patternError(p, conf) -proc semNodeKindConstraints*(p: PNode): 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) - if result.strVal.len > maxStackSize-1: - InternalError(p.info, "parameter pattern too complex") + if n.len >= 2: + for i in start..<n.len: + compileConstraints(n[i], result.strVal, conf) + if result.strVal.len > MaxStackSize-1: + internalError(conf, n.info, "parameter pattern too complex") else: - patternError(p) + patternError(n, conf) result.strVal.add(ppEof) type - TSideEffectAnalysis = enum + TSideEffectAnalysis* = enum seUnknown, seSideEffect, seNoSideEffect -proc checkForSideEffects(n: PNode): TSideEffectAnalysis = - # XXX is 'raise' a side effect? +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 @@ -162,80 +166,172 @@ proc checkForSideEffects(n: PNode): TSideEffectAnalysis = # an atom cannot produce a side effect: result = seNoSideEffect else: - for i in 0 .. <n.len: - let ret = checkForSideEffects(n.sons[i]) + # assume no side effect: + result = seNoSideEffect + for i in 0..<n.len: + let ret = checkForSideEffects(n[i]) if ret == seSideEffect: return ret elif ret == seUnknown and result == seNoSideEffect: result = seUnknown -type - TAssignableResult* = enum +type + TAssignableResult* = enum arNone, # no l-value and no discriminant arLValue, # is an l-value arLocalLValue, # is an l-value, but local var; must not escape # its stack frame! - arDiscriminant # is a discriminant + 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; allowCalls = true): PSym = + result = nil + var it = n + while true: + case it.kind + of nkSym: return it.sym + of nkHiddenDeref, nkDerefExpr: + if it[0].typ.skipTypes(abstractInst).kind in {tyPtr, tyRef}: + # 'ptr' is unsafe anyway and 'ref' is always on the heap, + # so allow these derefs: + break + else: + it = it[0] + of nkDotExpr, nkBracketExpr, nkHiddenAddr, + nkObjUpConv, nkObjDownConv, nkCheckedFieldExpr: + it = it[0] + of nkHiddenStdConv, nkHiddenSubConv, nkConv: + it = it[1] + of nkStmtList, nkStmtListExpr: + if it.len > 0 and it.typ != nil: it = it.lastSon + else: break + of nkCallKinds: + 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] + else: + break + else: + break 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 in {tyVar}: + result = arLValue of nkSym: - # don't list 'skLet' here: - if n.sym.kind in {skVar, skResult, skTemp}: - if owner != nil and owner.id == n.sym.owner.id 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 - of nkDotExpr: - if skipTypes(n.sons[0].typ, abstractInst-{tyTypeDesc}).kind in - {tyVar, tyPtr, tyRef}: + if owner != nil and owner == n.sym.owner and + sfGlobal notin n.sym.flags: + result = arLocalLValue + else: + result = arLValue + elif n.sym.kind == skType: + let t = n.sym.typ.skipTypes({tyTypeDesc}) + if t.kind in {tyVar}: result = arStrange + of nkDotExpr: + 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]) - if result != arNone and sfDiscriminant in n.sons[1].sym.flags: + 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}: + of nkBracketExpr: + 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]) - of nkHiddenStdConv, nkHiddenSubConv, nkConv: + 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]) - 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]) - of nkHiddenDeref, nkDerefExpr: + result = isAssignable(owner, n[1]) + of nkHiddenDeref: + 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[0]) + of nkCallKinds: + 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) + 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)" + # within concepts. Semantically, it's not correct to say that + # nkVarTy denotes an lvalue, but the example above is the only + # possible code which will get us here result = arLValue - of nkObjUpConv, nkObjDownConv, nkCheckedFieldExpr: - result = isAssignable(owner, n.sons[0]) else: - nil + discard + +proc isLValue*(n: PNode): bool = + isAssignable(nil, n) in {arLValue, arLocalLValue, arStrange} proc matchNodeKinds*(p, n: PNode): bool = - # matches the parameter constraint 'p' against the concrete AST 'n'. + # matches the parameter constraint 'p' against the concrete AST 'n'. # Efficiency matters here. - var stack {.noinit.}: array[0..maxStackSize, bool] + var stack {.noinit.}: array[0..MaxStackSize, bool] # empty patterns are true: stack[0] = true var sp = 1 - + template push(x: bool) = stack[sp] = x inc sp - + let code = p.strVal var pc = 1 while true: case TOpcode(code[pc]) of ppEof: break - of ppOr: + of ppOr: stack[sp-2] = stack[sp-1] or stack[sp-2] dec sp of ppAnd: @@ -261,4 +357,4 @@ proc matchNodeKinds*(p, n: PNode): bool = of ppNoSideEffect: push checkForSideEffects(n) != seSideEffect inc pc result = stack[sp-1] - + diff --git a/compiler/parsecfg.nim b/compiler/parsecfg.nim deleted file mode 100644 index e0d1afff1..000000000 --- a/compiler/parsecfg.nim +++ /dev/null @@ -1,346 +0,0 @@ -# -# -# Nimrod's Runtime Library -# (c) Copyright 2012 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# A HIGH-PERFORMANCE configuration file parser; -# the Nimrod version of this file is part of the -# standard library. - -import - llstream, nhashes, strutils, nimlexbase - -type - TCfgEventKind* = enum - cfgEof, # end of file reached - cfgSectionStart, # a ``[section]`` has been parsed - cfgKeyValuePair, # a ``key=value`` pair has been detected - cfgOption, # a ``--key=value`` command line option - cfgError # an error ocurred during parsing; msg contains the - # error message - TCfgEvent* = object of TObject - case kind*: TCfgEventKind - of cfgEof: - nil - - of cfgSectionStart: - section*: string - - of cfgKeyValuePair, cfgOption: - key*, value*: string - - of cfgError: - msg*: string - - - TTokKind* = enum - tkInvalid, tkEof, # order is important here! - tkSymbol, tkEquals, tkColon, tkBracketLe, tkBracketRi, tkDashDash - TToken*{.final.} = object # a token - kind*: TTokKind # the type of the token - literal*: string # the parsed (string) literal - - TParserState* = enum - startState, commaState - TCfgParser* = object of TBaseLexer - tok*: TToken - state*: TParserState - filename*: string - - -proc Open*(c: var TCfgParser, filename: string, inputStream: PLLStream) -proc Close*(c: var TCfgParser) -proc next*(c: var TCfgParser): TCfgEvent -proc getColumn*(c: TCfgParser): int -proc getLine*(c: TCfgParser): int -proc getFilename*(c: TCfgParser): string -proc errorStr*(c: TCfgParser, msg: string): string -# implementation - -const - SymChars: TCharSet = {'a'..'z', 'A'..'Z', '0'..'9', '_', '\x80'..'\xFF'} # - # ---------------------------------------------------------------------------- - -proc rawGetTok(c: var TCfgParser, tok: var TToken) -proc open(c: var TCfgParser, filename: string, inputStream: PLLStream) = - openBaseLexer(c, inputStream) - c.filename = filename - c.state = startState - c.tok.kind = tkInvalid - c.tok.literal = "" - rawGetTok(c, c.tok) - -proc close(c: var TCfgParser) = - closeBaseLexer(c) - -proc getColumn(c: TCfgParser): int = - result = getColNumber(c, c.bufPos) - -proc getLine(c: TCfgParser): int = - result = c.linenumber - -proc getFilename(c: TCfgParser): string = - result = c.filename - -proc handleHexChar(c: var TCfgParser, xi: var int) = - case c.buf[c.bufpos] - of '0'..'9': - xi = (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('0')) - inc(c.bufpos) - of 'a'..'f': - xi = (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('a') + 10) - inc(c.bufpos) - of 'A'..'F': - xi = (xi shl 4) or (ord(c.buf[c.bufpos]) - ord('A') + 10) - inc(c.bufpos) - else: - nil - -proc handleDecChars(c: var TCfgParser, xi: var int) = - while c.buf[c.bufpos] in {'0'..'9'}: - xi = (xi * 10) + (ord(c.buf[c.bufpos]) - ord('0')) - inc(c.bufpos) - -proc getEscapedChar(c: var TCfgParser, tok: var TToken) = - var xi: int - inc(c.bufpos) # skip '\' - case c.buf[c.bufpos] - of 'n', 'N': - tok.literal = tok.literal & "\n" - Inc(c.bufpos) - of 'r', 'R', 'c', 'C': - add(tok.literal, CR) - Inc(c.bufpos) - of 'l', 'L': - add(tok.literal, LF) - Inc(c.bufpos) - of 'f', 'F': - add(tok.literal, FF) - inc(c.bufpos) - of 'e', 'E': - add(tok.literal, ESC) - Inc(c.bufpos) - of 'a', 'A': - add(tok.literal, BEL) - Inc(c.bufpos) - of 'b', 'B': - add(tok.literal, BACKSPACE) - Inc(c.bufpos) - of 'v', 'V': - add(tok.literal, VT) - Inc(c.bufpos) - of 't', 'T': - add(tok.literal, Tabulator) - Inc(c.bufpos) - of '\'', '\"': - add(tok.literal, c.buf[c.bufpos]) - Inc(c.bufpos) - of '\\': - add(tok.literal, '\\') - Inc(c.bufpos) - of 'x', 'X': - inc(c.bufpos) - xi = 0 - handleHexChar(c, xi) - handleHexChar(c, xi) - add(tok.literal, Chr(xi)) - of '0'..'9': - xi = 0 - handleDecChars(c, xi) - if (xi <= 255): add(tok.literal, Chr(xi)) - else: tok.kind = tkInvalid - else: tok.kind = tkInvalid - -proc HandleCRLF(c: var TCfgParser, pos: int): int = - case c.buf[pos] - of CR: result = lexbase.HandleCR(c, pos) - of LF: result = lexbase.HandleLF(c, pos) - else: result = pos - -proc getString(c: var TCfgParser, tok: var TToken, rawMode: bool) = - var - pos: int - ch: Char - buf: cstring - pos = c.bufPos + 1 # skip " - buf = c.buf # put `buf` in a register - tok.kind = tkSymbol - if (buf[pos] == '\"') and (buf[pos + 1] == '\"'): - # long string literal: - inc(pos, 2) # skip "" - # skip leading newline: - pos = HandleCRLF(c, pos) - buf = c.buf - while true: - case buf[pos] - of '\"': - if (buf[pos + 1] == '\"') and (buf[pos + 2] == '\"'): break - add(tok.literal, '\"') - Inc(pos) - of CR, LF: - pos = HandleCRLF(c, pos) - buf = c.buf - tok.literal = tok.literal & "\n" - of lexbase.EndOfFile: - tok.kind = tkInvalid - break - else: - add(tok.literal, buf[pos]) - Inc(pos) - c.bufpos = pos + - 3 # skip the three """ - else: - # ordinary string literal - while true: - ch = buf[pos] - if ch == '\"': - inc(pos) # skip '"' - break - if ch in {CR, LF, lexbase.EndOfFile}: - tok.kind = tkInvalid - break - if (ch == '\\') and not rawMode: - c.bufPos = pos - getEscapedChar(c, tok) - pos = c.bufPos - else: - add(tok.literal, ch) - Inc(pos) - c.bufpos = pos - -proc getSymbol(c: var TCfgParser, tok: var TToken) = - var - pos: int - buf: cstring - pos = c.bufpos - buf = c.buf - while true: - add(tok.literal, buf[pos]) - Inc(pos) - if not (buf[pos] in SymChars): break - c.bufpos = pos - tok.kind = tkSymbol - -proc skip(c: var TCfgParser) = - var - buf: cstring - pos: int - pos = c.bufpos - buf = c.buf - while true: - case buf[pos] - of ' ': - Inc(pos) - of Tabulator: - inc(pos) - of '#', ';': - while not (buf[pos] in {CR, LF, lexbase.EndOfFile}): inc(pos) - of CR, LF: - pos = HandleCRLF(c, pos) - buf = c.buf - else: - break # EndOfFile also leaves the loop - c.bufpos = pos - -proc rawGetTok(c: var TCfgParser, tok: var TToken) = - tok.kind = tkInvalid - setlen(tok.literal, 0) - skip(c) - case c.buf[c.bufpos] - of '=': - tok.kind = tkEquals - inc(c.bufpos) - tok.literal = "=" - of '-': - inc(c.bufPos) - if c.buf[c.bufPos] == '-': inc(c.bufPos) - tok.kind = tkDashDash - tok.literal = "--" - of ':': - tok.kind = tkColon - inc(c.bufpos) - tok.literal = ":" - of 'r', 'R': - if c.buf[c.bufPos + 1] == '\"': - Inc(c.bufPos) - getString(c, tok, true) - else: - getSymbol(c, tok) - of '[': - tok.kind = tkBracketLe - inc(c.bufpos) - tok.literal = "[" - of ']': - tok.kind = tkBracketRi - Inc(c.bufpos) - tok.literal = "]" - of '\"': - getString(c, tok, false) - of lexbase.EndOfFile: - tok.kind = tkEof - else: getSymbol(c, tok) - -proc errorStr(c: TCfgParser, msg: string): string = - result = `%`("$1($2, $3) Error: $4", - [c.filename, $(getLine(c)), $(getColumn(c)), msg]) - -proc getKeyValPair(c: var TCfgParser, kind: TCfgEventKind): TCfgEvent = - if c.tok.kind == tkSymbol: - result.kind = kind - result.key = c.tok.literal - result.value = "" - rawGetTok(c, c.tok) - while c.tok.literal == ".": - add(result.key, '.') - rawGetTok(c, c.tok) - if c.tok.kind == tkSymbol: - add(result.key, c.tok.literal) - rawGetTok(c, c.tok) - else: - result.kind = cfgError - result.msg = errorStr(c, "symbol expected, but found: " & c.tok.literal) - break - if c.tok.kind in {tkEquals, tkColon}: - rawGetTok(c, c.tok) - if c.tok.kind == tkSymbol: - result.value = c.tok.literal - else: - result.kind = cfgError - result.msg = errorStr(c, "symbol expected, but found: " & c.tok.literal) - rawGetTok(c, c.tok) - else: - result.kind = cfgError - result.msg = errorStr(c, "symbol expected, but found: " & c.tok.literal) - rawGetTok(c, c.tok) - -proc next(c: var TCfgParser): TCfgEvent = - case c.tok.kind - of tkEof: - result.kind = cfgEof - of tkDashDash: - rawGetTok(c, c.tok) - result = getKeyValPair(c, cfgOption) - of tkSymbol: - result = getKeyValPair(c, cfgKeyValuePair) - of tkBracketLe: - rawGetTok(c, c.tok) - if c.tok.kind == tkSymbol: - result.kind = cfgSectionStart - result.section = c.tok.literal - else: - result.kind = cfgError - result.msg = errorStr(c, "symbol expected, but found: " & c.tok.literal) - rawGetTok(c, c.tok) - if c.tok.kind == tkBracketRi: - rawGetTok(c, c.tok) - else: - result.kind = cfgError - result.msg = errorStr(c, "\']\' expected, but found: " & c.tok.literal) - of tkInvalid, tkBracketRi, tkEquals, tkColon: - result.kind = cfgError - result.msg = errorStr(c, "invalid token: " & c.tok.literal) - rawGetTok(c, c.tok) diff --git a/compiler/parser.nim b/compiler/parser.nim index 46294925d..747505097 100644 --- a/compiler/parser.nim +++ b/compiler/parser.nim @@ -1,591 +1,799 @@ # # -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# 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 parser of the standard Nimrod syntax. +# This module implements the parser of the standard Nim syntax. # The parser strictly reflects the grammar ("doc/grammar.txt"); however # it uses several helper routines to keep the parser small. A special # efficient algorithm is used for the precedence levels. The parser here can # be seen as a refinement of the grammar, as it specifies how the AST is built -# from the grammar and how comments belong to the AST. +# from the grammar and how comments belong to the AST. # In fact the grammar is generated from this file: -when isMainModule: - import pegs - var outp = open("compiler/grammar.txt", fmWrite) - for line in lines("compiler/parser.nim"): - if line =~ peg" \s* '#| ' {.*}": - outp.writeln matches[0] - outp.close +when isMainModule or defined(nimTestGrammar): + # Leave a note in grammar.txt that it is generated: + #| # This file is generated by compiler/parser.nim. + 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 + llstream, lexer, idents, msgs, options, lineinfos, + pathutils + +when not defined(nimCustomAst): + import ast +else: + import plugins / customast + +import std/strutils + +when defined(nimpretty): + import layouter + +when defined(nimPreviewSlimSystem): + import std/assertions type - TParser*{.final.} = object # a TParser object represents a module that + Parser* = object # A Parser object represents a file that # is being parsed - currInd: int # current indentation - firstTok: bool - lex*: TLexer # the lexer that is used for parsing - tok*: TToken # the current token - -proc ParseAll*(p: var TParser): PNode -proc openParser*(p: var TParser, filename: string, inputstream: PLLStream) -proc closeParser*(p: var TParser) -proc parseTopLevelStmt*(p: var TParser): PNode - # implements an iterator. Returns the next top-level statement or - # emtyNode if end of stream. - -proc parseString*(s: string, filename: string = "", line: int = 0): PNode - # filename and line could be set optionally, when the string originates - # from a certain source file. This way, the compiler could generate - # correct error messages referring to the original source. - + 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 + when not defined(nimCustomAst): + emptyNode: PNode + when defined(nimpretty): + em*: Emitter + + SymbolMode = enum + smNormal, smAllowNil, smAfterDot + + 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 getPrecedence*(tok: TToken): int -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): PNode -proc parseTry(p: var TParser): PNode -proc parseCase(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) - -proc OpenParser*(p: var TParser, fileIdx: int32, inputStream: PLLStream) = - initToken(p.tok) - OpenLexer(p.lex, fileIdx, inputstream) + p.hasProgress = true + 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 Parser, fileIdx: FileIndex, inputStream: PLLStream, + cache: IdentCache; config: ConfigRef) = + ## Open a parser, using the given arguments to set up its internal state. + ## + reset(p.tok) + openLexer(p.lex, fileIdx, inputStream, cache, config) + when defined(nimpretty): + openEmitter(p.em, cache, config, fileIdx) getTok(p) # read the first token p.firstTok = true + when not defined(nimCustomAst): + p.emptyNode = newNode(nkEmpty) + +proc openParser*(p: var Parser, filename: AbsoluteFile, inputStream: PLLStream, + cache: IdentCache; config: ConfigRef) = + openParser(p, fileInfoIdx(config, filename), inputStream, cache, config) -proc OpenParser*(p: var TParser, filename: string, inputStream: PLLStream) = - openParser(p, filename.fileInfoIdx, inputStream) +proc closeParser*(p: var Parser) = + ## Close a parser, freeing up its resources. + closeLexer(p.lex) -proc CloseParser(p: var TParser) = - CloseLexer(p.lex) +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: TMsgKind, arg: string = "") = - lexMessage(p.lex, msg, arg) +proc parMessage(p: Parser, msg: string, tok: Token) = + ## Produce and emit a parser message to output about the token `tok` + parMessage(p, errGenerated, msg % prettyTok(tok)) -proc parMessage(p: TParser, msg: TMsgKind, tok: TToken) = - lexMessage(p.lex, msg, prettyTok(tok)) +proc parMessage(p: Parser, arg: string) = + ## Produce and emit the parser message `arg` to output. + lexMessageTok(p.lex, errGenerated, p.tok, arg) -template withInd(p: expr, body: stmt) {.immediate.} = +template withInd(p, body: untyped) = let oldInd = p.currInd p.currInd = p.tok.indent 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 = "" - add(node.comment, p.tok.literal) + var rhs = node.comment + when defined(nimpretty): + if p.tok.commentOffsetB > p.tok.commentOffsetA: + rhs.add fileSection(p.lex.config, p.lex.fileIdx, p.tok.commentOffsetA, p.tok.commentOffsetB) + else: + rhs.add p.tok.literal + else: + 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 skipInd(p: var TParser) = +proc flexComment(p: var Parser, node: PNode) = + if p.tok.indent < 0 or realInd(p): rawSkipComment(p, node) + +const + errInvalidIndentation = "invalid indentation" + errIdentifierExpected = "identifier expected, but got '$1'" + errExprExpected = "expression expected, but found '$1'" + +proc skipInd(p: var Parser) = if p.tok.indent >= 0: if not realInd(p): parMessage(p, errInvalidIndentation) -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, errIdentifierExpected, prettyTok(p.tok)) - -proc ExpectIdent(p: TParser) = + lexMessage(p.lex, errGenerated, errIdentifierExpected % prettyTok(p.tok)) + +proc expectIdent(p: Parser) = if p.tok.tokType != tkSymbol: - lexMessage(p.lex, errIdentifierExpected, prettyTok(p.tok)) - -proc Eat(p: var TParser, TokType: TTokType) = - if p.tok.TokType == TokType: getTok(p) - else: lexMessage(p.lex, errTokenExpected, TokTypeToStr[tokType]) - -proc parLineInfo(p: TParser): TLineInfo = - result = getLineInfo(p.lex) - -proc indAndComment(p: var TParser, n: PNode) = + lexMessage(p.lex, errGenerated, errIdentifierExpected % prettyTok(p.tok)) + +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: '" & $tokType & "', but got: '" & prettyTok(p.tok) & "'") + +proc parLineInfo(p: Parser): TLineInfo = + ## Retrieve the line information associated with the parser's current state. + result = getLineInfo(p.lex, p.tok) + +proc indAndComment(p: var Parser, n: PNode, 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, getLineInfo(p.lex)) -proc newIntNodeP(kind: TNodeKind, intVal: BiggestInt, p: TParser): PNode = - result = newNodeP(kind, p) - result.intVal = intVal +proc newNodeP(kind: TNodeKind, p: Parser): PNode = + result = newNode(kind, parLineInfo(p)) -proc newFloatNodeP(kind: TNodeKind, floatVal: BiggestFloat, - p: TParser): PNode = - result = newNodeP(kind, p) - result.floatVal = floatVal +proc newIntNodeP(kind: TNodeKind, intVal: BiggestInt, p: Parser): PNode = + result = newAtom(kind, intVal, parLineInfo(p)) -proc newStrNodeP(kind: TNodeKind, strVal: string, p: TParser): PNode = - result = newNodeP(kind, p) - result.strVal = strVal - -proc newIdentNodeP(ident: PIdent, p: TParser): PNode = - result = newNodeP(nkIdent, p) - result.ident = ident - -proc parseExpr(p: var TParser): PNode -proc parseStmt(p: var TParser): PNode -proc parseTypeDesc(p: var TParser): PNode -proc parseDoBlocks(p: var TParser, call: PNode) -proc parseParamList(p: var TParser, retColon = true): PNode - -proc relevantOprChar(ident: PIdent): char {.inline.} = - result = ident.s[0] - var L = ident.s.len - if result == '\\' and L > 1: - result = ident.s[1] - -proc IsSigilLike(tok: TToken): bool {.inline.} = - result = tok.tokType == tkOpr and relevantOprChar(tok.ident) == '@' - -proc IsLeftAssociative(tok: TToken): bool {.inline.} = - result = tok.tokType != tkOpr or relevantOprChar(tok.ident) != '^' - -proc getPrecedence(tok: TToken): int = - case tok.tokType - of tkOpr: - let L = tok.ident.s.len - let relevantChar = relevantOprChar(tok.ident) - - template considerAsgn(value: expr) = - 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: result = 3 - else: result = - 10 - -proc isOperator(tok: TToken): bool = - result = getPrecedence(tok) >= 0 - -#| module = stmt ^* (';' / IND{=}) +proc newFloatNodeP(kind: TNodeKind, floatVal: BiggestFloat, + p: Parser): PNode = + result = newAtom(kind, floatVal, parLineInfo(p)) + +proc newStrNodeP(kind: TNodeKind, strVal: sink string, p: Parser): PNode = + result = newAtom(kind, strVal, parLineInfo(p)) + +proc newIdentNodeP(ident: PIdent, p: Parser): PNode = + result = newAtom(ident, parLineInfo(p)) + +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: Token): bool {.inline.} = + result = tok.tokType == tkOpr and tok.ident.s[0] == '@' + +proc isRightAssociative(tok: Token): bool {.inline.} = + ## Determines whether the token is right assocative. + result = tok.tokType == tkOpr and tok.ident.s[0] == '^' + # or (tok.ident.s.len > 1 and tok.ident.s[^1] == '>') + +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: 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.spacing == {tsTrailing}: + parMessage(p, warnInconsistentSpacing, prettyTok(p.tok)) + +#| module = complexOrSimpleStmt ^* (';' / IND{=}) #| #| comma = ',' COMMENT? #| semicolon = ';' COMMENT? #| colon = ':' COMMENT? #| colcom = ':' COMMENT? -#| +#| #| operator = OP0 | OP1 | OP2 | OP3 | OP4 | OP5 | OP6 | OP7 | OP8 | OP9 #| | 'or' | 'xor' | 'and' -#| | 'is' | 'isnot' | 'in' | 'notin' | 'of' -#| | 'div' | 'mod' | 'shl' | 'shr' | 'not' | 'addr' | 'static' | '..' -#| +#| | 'is' | 'isnot' | 'in' | 'notin' | 'of' | 'as' | 'from' +#| | 'div' | 'mod' | 'shl' | 'shr' | 'not' | '..' +#| #| prefixOperator = operator -#| -#| optInd = COMMENT? +#| +#| optInd = COMMENT? IND? #| optPar = (IND{>} | IND{=})? -#| -#| simpleExpr = assignExpr (OP0 optInd assignExpr)* -#| assignExpr = orExpr (OP1 optInd orExpr)* -#| orExpr = andExpr (OP2 optInd andExpr)* -#| andExpr = cmpExpr (OP3 optInd cmpExpr)* -#| cmpExpr = sliceExpr (OP4 optInd sliceExpr)* -#| sliceExpr = ampExpr (OP5 optInd ampExpr)* -#| ampExpr = plusExpr (OP6 optInd plusExpr)* -#| plusExpr = mulExpr (OP7 optInd mulExpr)* -#| mulExpr = dollarExpr (OP8 optInd dollarExpr)* -#| dollarExpr = primary (OP9 optInd primary)* - -proc colcom(p: var TParser, n: PNode) = +#| +#| simpleExpr = arrowExpr (OP0 optInd arrowExpr)* pragma? +#| arrowExpr = assignExpr (OP1 optInd assignExpr)* +#| assignExpr = orExpr (OP2 optInd orExpr)* +#| orExpr = andExpr (OP3 optInd andExpr)* +#| andExpr = cmpExpr (OP4 optInd cmpExpr)* +#| cmpExpr = sliceExpr (OP5 optInd sliceExpr)* +#| sliceExpr = ampExpr (OP6 optInd ampExpr)* +#| ampExpr = plusExpr (OP7 optInd plusExpr)* +#| plusExpr = mulExpr (OP8 optInd mulExpr)* +#| mulExpr = dollarExpr (OP9 optInd dollarExpr)* +#| dollarExpr = primary (OP10 optInd primary)* + +proc isOperator(tok: Token): bool = + #| operatorB = OP0 | OP1 | OP2 | OP3 | OP4 | OP5 | OP6 | OP7 | OP8 | OP9 | + #| 'div' | 'mod' | 'shl' | 'shr' | 'in' | 'notin' | + #| 'is' | 'isnot' | 'not' | 'of' | 'as' | 'from' | '..' | 'and' | 'or' | 'xor' + tok.tokType in {tkOpr, tkDiv, tkMod, tkShl, tkShr, tkIn, tkNotin, tkIs, + tkIsnot, tkNot, tkOf, tkAs, tkFrom, tkDotDot, tkAnd, + tkOr, tkXor} + +proc colcom(p: var Parser, n: PNode) = eat(p, tkColon) skipComment(p, n) -proc parseSymbol(p: var TParser): PNode = - #| symbol = '`' (KEYW|IDENT|operator|'(' ')'|'[' ']'|'{' '}'|'='|literal)+ '`' - #| | IDENT +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 | 'addr' | 'type' | 'static' + #| symbolOrKeyword = symbol | KEYW case p.tok.tokType - of tkSymbol: + of tkSymbol: result = newIdentNodeP(p.tok.ident, p) getTok(p) - of tkAccent: + of tokKeywordLow..tokKeywordHigh: + 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) + elif p.tok.tokType == tkNil and mode == smAllowNil: + result = newNodeP(nkNilLit, p) + getTok(p) + else: + parMessage(p, errIdentifierExpected, p.tok) + result = p.emptyNode + of tkAccent: result = newNodeP(nkAccQuoted, p) getTok(p) + # progress guaranteed while true: case p.tok.tokType - of tkBracketLe: - add(result, newIdentNodeP(getIdent"[]", p)) - getTok(p) - eat(p, tkBracketRi) - of tkEquals: - add(result, newIdentNodeP(getIdent"=", p)) - getTok(p) - of tkParLe: - add(result, newIdentNodeP(getIdent"()", p)) - getTok(p) - eat(p, tkParRi) - of tkCurlyLe: - add(result, newIdentNodeP(getIdent"{}", p)) - getTok(p) - eat(p, tkCurlyRi) - of tokKeywordLow..tokKeywordHigh, tkSymbol, tkOpr, tkDotDot: - add(result, newIdentNodeP(p.tok.ident, p)) - getTok(p) - of tkIntLit..tkCharLit: - add(result, newIdentNodeP(getIdent(tokToStr(p.tok)), p)) + of tkAccent: + 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($p.tok) + getTok(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: - if result.len == 0: - parMessage(p, errIdentifierExpected, p.tok) + parMessage(p, errIdentifierExpected, p.tok) break eat(p, tkAccent) else: parMessage(p, errIdentifierExpected, p.tok) - getTok(p) # BUGFIX: We must consume a token here to prevent endless loops! - result = ast.emptyNode - -proc indexExpr(p: var TParser): PNode = - #| indexExpr = expr - result = parseExpr(p) - -proc indexExprList(p: var TParser, first: PNode, k: TNodeKind, - endToken: TTokType): PNode = - #| indexExprList = indexExpr ^+ comma - result = newNodeP(k, p) - addSon(result, first) - getTok(p) - optInd(p, result) - while p.tok.tokType notin {endToken, tkEof}: - var a = indexExpr(p) - addSon(result, a) - if p.tok.tokType != tkComma: break + # BUGFIX: We must consume a token here to prevent endless loops! + # But: this really sucks for idetools and keywords, so we don't do it + # if it is a keyword: + #if not isKeyword(p.tok.tokType): getTok(p) + result = p.emptyNode + setEndInfo() + +proc equals(p: var Parser, a: PNode): PNode = + if p.tok.tokType == tkEquals: + result = newNodeP(nkExprEqExpr, p) getTok(p) - skipComment(p, a) - optPar(p) - eat(p, endToken) + #optInd(p, result) + result.add(a) + result.add(parseExpr(p)) + else: + result = a -proc colonOrEquals(p: var TParser, a: PNode): PNode = +proc colonOrEquals(p: var Parser, a: PNode): PNode = if p.tok.tokType == tkColon: result = newNodeP(nkExprColonExpr, p) getTok(p) + newlineWasSplitting(p) #optInd(p, result) - addSon(result, a) - addSon(result, parseExpr(p)) - elif 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 + result = equals(p, a) -proc exprColonEqExpr(p: var TParser): PNode = - #| exprColonEqExpr = expr (':'|'=' expr)? +proc exprColonEqExpr(p: var Parser): PNode = + #| exprColonEqExpr = expr ((':'|'=') expr + #| / doBlock extraPostExprBlock*)? var a = parseExpr(p) - result = colonOrEquals(p, a) + 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(nimpretty): + inc p.em.doIndentMore getTok(p) optInd(p, result) - while (p.tok.tokType != endTok) and (p.tok.tokType != tkEof): - var a = parseExpr(p) - addSon(result, a) - if p.tok.tokType != tkComma: break + # 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) - eat(p, endTok) - -proc dotExpr(p: var TParser, a: PNode): PNode = - #| dotExpr = expr '.' optInd ('type' | 'addr' | symbol) - var info = p.lex.getlineInfo + 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, a) - case p.tok.tokType - of tkType: - result = newNodeP(nkTypeOfExpr, p) - getTok(p) - addSon(result, a) - of tkAddr: - result = newNodeP(nkAddr, p) + optInd(p, result) + # progress guaranteed + while (p.tok.tokType != endTok) and (p.tok.tokType != tkEof): + var a = parseExpr(p) + result.add(a) + if p.tok.tokType != tkComma: break getTok(p) - addSon(result, a) - else: - result = newNodeI(nkDotExpr, info) - addSon(result, a) - addSon(result, parseSymbol(p)) - -proc qualifiedIdent(p: var TParser): PNode = - #| qualifiedIdent = symbol ('.' optInd ('type' | 'addr' | symbol))? - result = parseSymbol(p) - if p.tok.tokType == tkDot: result = dotExpr(p, result) + optInd(p, a) + 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) - if p.tok.tokType != tkComma: break + result.add(a) + if p.tok.tokType != tkComma: break + elif result.kind == nkPar: + result.transitionSonsKind(nkTupleConstr) getTok(p) 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 setOrTableConstr(p: var TParser): PNode = +proc dotExpr(p: var Parser, a: PNode): PNode = + var info = p.parLineInfo + getTok(p) + result = newNode(nkDotExpr, info) + optInd(p, result) + 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.secondSon + exprList(p, tkBracketRi, x) + eat(p, tkBracketRi) + var y = newNode(nkCall, p.parLineInfo) + y.add x + y.add result.firstSon + if p.tok.tokType == tkParLe and tsLeading notin p.tok.spacing: + exprColonEqExprListAux(p, tkParRi, y) + result = y + +proc dotLikeExpr(p: var Parser, a: PNode): PNode = + var info = p.parLineInfo + result = newNode(nkInfix, info) + optInd(p, result) + var opNode = newIdentNodeP(p.tok.ident, p) + getTok(p) + result.add(opNode) + result.add(a) + result.add(parseSymbol(p, smAfterDot)) + +proc qualifiedIdent(p: var Parser): PNode = + #| qualifiedIdent = symbol ('.' optInd symbolOrKeyword)? + result = parseSymbol(p) + if p.tok.tokType == tkDot: result = dotExpr(p, result) + +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 p.tok.tokType != tkComma: break + 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: nil - of base2: incl(n.flags, nfBase2) - of base8: incl(n.flags, nfBase8) - of base16: incl(n.flags, nfBase16) - -proc parseGStrLit(p: var TParser, a: PNode): PNode = + of base10: discard + of base2: setNodeFlag(n, nfBase2) + of base8: setNodeFlag(n, nfBase8) + of base16: setNodeFlag(n, nfBase16) + +proc parseGStrLit(p: var Parser, a: PNode): PNode = case p.tok.tokType - of tkGStrLit: + 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: + 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() + +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 Parser, result: PNode) = + inc p.inSemiStmtList + 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 -type - TPrimaryMode = enum pmNormal, pmTypeDesc, pmTypeDef, pmSkipSuffix - -proc complexOrSimpleStmt(p: var TParser): PNode -proc simpleExpr(p: var TParser, mode = pmNormal): PNode - -proc semiStmtList(p: var TParser, result: PNode) = - result.add(complexOrSimpleStmt(p)) - while p.tok.tokType == tkSemicolon: - getTok(p) - optInd(p, result) - result.add(complexOrSimpleStmt(p)) - result.kind = nkStmtListExpr + 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.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 ^+ ';' - #| | simpleExpr ('=' expr (';' complexOrSimpleStmt ^+ ';' )? )? - #| | (':' expr)? (',' (exprColonEqExpr comma?)*)? )? - #| optPar ')' + #| par = '(' optInd + #| ( &parKeyw (ifExpr / complexOrSimpleStmt) ^+ ';' + #| | ';' (ifExpr / complexOrSimpleStmt) ^+ ';' + #| | pragmaStmt + #| | simpleExpr ( (doBlock extraPostExprBlock*) + #| | ('=' expr (';' (ifExpr / complexOrSimpleStmt) ^+ ';' )? ) + #| | (':' expr (',' exprColonEqExpr ^+ ',' )? ) ) ) + #| optPar ')' # - # unfortunately it's ambiguous: (expr: expr) vs (exprStmt); however a + # unfortunately it's ambiguous: (expr: expr) vs (exprStmt); however a # leading ';' could be used to enforce a 'stmt' context ... result = newNodeP(nkPar, p) getTok(p) optInd(p, result) - if p.tok.tokType in {tkDiscard, tkInclude, tkIf, tkWhile, tkCase, - tkTry, tkFinally, tkExcept, tkFor, tkBlock, - tkConst, tkLet, tkWhen, tkVar, + flexComment(p, result) + if p.tok.tokType in {tkDiscard, tkInclude, tkIf, tkWhile, tkCase, + 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. semiStmtList(p, result) - elif p.tok.tokType == tkSemicolon: + elif p.tok.tokType == tkSemiColon: # '(;' enforces 'stmt' context: getTok(p) optInd(p, result) semiStmtList(p, result) - elif p.tok.tokType != tkParRi: + elif p.tok.tokType == tkCurlyDotLe: + result.add(parseStmtPragma(p)) + elif p.tok.tokType == tkParRi: + # Empty tuple '()' + result.transitionSonsKind(nkTupleConstr) + else: var a = simpleExpr(p) - if p.tok.tokType == tkEquals: + if p.tok.tokType == tkDo: + result = postExprBlocks(p, a) + elif p.tok.tokType == tkEquals: # special case: allow assignments + let asgn = newNodeP(nkAsgn, p) getTok(p) optInd(p, result) let b = parseExpr(p) - let asgn = newNodeI(nkAsgn, a.info, 2) - asgn.sons[0] = a - asgn.sons[1] = b + asgn.add a + asgn.add b result.add(asgn) - elif p.tok.tokType == tkSemicolon: + if p.tok.tokType == tkSemiColon: + semiStmtList(p, result) + elif p.tok.tokType == tkSemiColon: # stmt context: result.add(a) 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: + result.transitionSonsKind(nkTupleConstr) + # progress guaranteed while p.tok.tokType != tkParRi and p.tok.tokType != tkEof: var a = exprColonEqExpr(p) - addSon(result, a) - if p.tok.tokType != tkComma: break + result.add(a) + if p.tok.tokType != tkComma: break getTok(p) skipComment(p, a) optPar(p) eat(p, tkParRi) - -proc identOrLiteral(p: var TParser, mode: TPrimaryMode): PNode = + setEndInfo() + +proc identOrLiteral(p: var Parser, mode: PrimaryMode): PNode = + #| literal = | INT_LIT | INT8_LIT | INT16_LIT | INT32_LIT | INT64_LIT + #| | UINT_LIT | UINT8_LIT | UINT16_LIT | UINT32_LIT | UINT64_LIT + #| | FLOAT_LIT | FLOAT32_LIT | FLOAT64_LIT + #| | STR_LIT | RSTR_LIT | TRIPLESTR_LIT + #| | CHAR_LIT | CUSTOM_NUMERIC_LIT + #| | NIL #| generalizedLit = GENERALIZED_STR_LIT | GENERALIZED_TRIPLESTR_LIT - #| identOrLiteral = generalizedLit | symbol - #| | 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 - #| | NIL - #| | par | arrayConstr | setOrTableConstr + #| identOrLiteral = generalizedLit | symbol | literal + #| | par | arrayConstr | setOrTableConstr | tupleConstr #| | castExpr #| tupleConstr = '(' optInd (exprColonEqExpr comma?)* optPar ')' #| arrayConstr = '[' optInd (exprColonEqExpr comma?)* optPar ']' case p.tok.tokType - of tkSymbol: + of tkSymbol, tkBuiltInMagics, tkOut: result = newIdentNodeP(p.tok.ident, p) getTok(p) result = parseGStrLit(p, result) - of tkAccent: + of tkAccent: result = parseSymbol(p) # literals of tkIntLit: result = newIntNodeP(nkIntLit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkInt8Lit: + of tkInt8Lit: result = newIntNodeP(nkInt8Lit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkInt16Lit: + of tkInt16Lit: result = newIntNodeP(nkInt16Lit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkInt32Lit: + of tkInt32Lit: result = newIntNodeP(nkInt32Lit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkInt64Lit: + of tkInt64Lit: result = newIntNodeP(nkInt64Lit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkUIntLit: + of tkUIntLit: result = newIntNodeP(nkUIntLit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkUInt8Lit: + of tkUInt8Lit: result = newIntNodeP(nkUInt8Lit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkUInt16Lit: + of tkUInt16Lit: result = newIntNodeP(nkUInt16Lit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkUInt32Lit: + of tkUInt32Lit: result = newIntNodeP(nkUInt32Lit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkUInt64Lit: + of tkUInt64Lit: result = newIntNodeP(nkUInt64Lit, p.tok.iNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkFloatLit: + of tkFloatLit: result = newFloatNodeP(nkFloatLit, p.tok.fNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkFloat32Lit: + of tkFloat32Lit: result = newFloatNodeP(nkFloat32Lit, p.tok.fNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkFloat64Lit: + of tkFloat64Lit: result = newFloatNodeP(nkFloat64Lit, p.tok.fNumber, p) setBaseFlags(result, p.tok.base) getTok(p) @@ -593,19 +801,27 @@ proc identOrLiteral(p: var TParser, mode: TPrimaryMode): PNode = result = newFloatNodeP(nkFloat128Lit, p.tok.fNumber, p) setBaseFlags(result, p.tok.base) getTok(p) - of tkStrLit: + of tkStrLit: result = newStrNodeP(nkStrLit, p.tok.literal, p) getTok(p) - of tkRStrLit: + of tkRStrLit: result = newStrNodeP(nkRStrLit, p.tok.literal, p) getTok(p) - of tkTripleStrLit: + of tkTripleStrLit: result = newStrNodeP(nkTripleStrLit, p.tok.literal, p) getTok(p) - of tkCharLit: + of tkCharLit: result = newIntNodeP(nkCharLit, ord(p.tok.literal[0]), p) getTok(p) - of tkNil: + 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) of tkParLe: @@ -620,181 +836,270 @@ proc identOrLiteral(p: var TParser, mode: TPrimaryMode): PNode = of tkBracketLe: # [] constructor result = exprColonEqExprList(p, nkBracket, tkBracketRi) - of tkCast: + of tkCast: result = parseCast(p) else: parMessage(p, errExprExpected, p.tok) - getTok(p) # we must consume a token here to prevend endless loops! - result = ast.emptyNode - -proc primarySuffix(p: var TParser, r: PNode): PNode = - #| primarySuffix = '(' (exprColonEqExpr comma?)* ')' doBlocks? - #| | doBlocks - #| | '.' optInd ('type' | 'addr' | symbol) generalizedLit? - #| | '[' optInd indexExprList optPar ']' - #| | '{' optInd indexExprList optPar '}' + getTok(p) # we must consume a token here to prevent endless loops! + result = p.emptyNode + +proc namedParams(p: var Parser, callee: PNode, + kind: TNodeKind, endTok: TokType): PNode = + let a = callee + result = newNodeP(kind, p) + result.add(a) + # progress guaranteed + exprColonEqExprListAux(p, endTok, result) + +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 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 - while p.tok.indent < 0: + + # progress guaranteed + while p.tok.indent < 0 or + (p.tok.tokType == tkDot and p.tok.indent >= baseIndent): case p.tok.tokType - of tkParLe: - var a = result - result = newNodeP(nkCall, p) - addSon(result, a) - exprColonEqExprListAux(p, tkParRi, result) - if result.len > 1 and result.sons[1].kind == nkExprColonExpr: - result.kind = nkObjConstr - else: - parseDoBlocks(p, result) - of tkDo: - var a = result - result = newNodeP(nkCall, p) - addSon(result, a) - parseDoBlocks(p, result) + of tkParLe: + # progress guaranteed + if tsLeading in p.tok.spacing: + result = commandExpr(p, result, mode) + break + result = namedParams(p, result, nkCall, tkParRi) + 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: - result = indexExprList(p, result, nkBracketExpr, tkBracketRi) + of tkBracketLe: + # progress guaranteed + if tsLeading in p.tok.spacing: + result = commandExpr(p, result, mode) + break + result = namedParams(p, result, nkBracketExpr, tkBracketRi) of tkCurlyLe: - result = indexExprList(p, result, nkCurlyExpr, tkCurlyRi) - else: break - -proc primary(p: var TParser, mode: TPrimaryMode): PNode + # progress guaranteed + if tsLeading in p.tok.spacing: + result = commandExpr(p, result, mode) + break + result = namedParams(p, result, nkCurlyExpr, tkCurlyRi) + 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 simpleExprAux(p: var TParser, limit: int, mode: TPrimaryMode): PNode = - result = primary(p, mode) +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) let modeB = if mode == pmTypeDef: pmTypeDesc else: mode # the operator itself must not start on a new line: - while opPrec >= limit and p.tok.indent < 0: - var leftAssoc = ord(IsLeftAssociative(p.tok)) + # progress guaranteed + while opPrec >= limit and p.tok.indent < 0 and not isUnary(p.tok): + checkBinary(p) + 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, opNode) + 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) - -proc simpleExpr(p: var TParser, mode = pmNormal): PNode = + setEndInfo() + +proc simpleExprAux(p: var Parser, limit: int, mode: PrimaryMode): PNode = + var mode = mode + result = primary(p, mode) + if mode == pmTrySimple: + mode = pmNormal + if p.tok.tokType == tkCurlyDotLe and (p.tok.indent < 0 or realInd(p)) and + mode == pmNormal: + var pragmaExp = newNodeP(nkPragmaExpr, p) + pragmaExp.add result + pragmaExp.add p.parsePragma + result = pragmaExp + result = parseOperators(p, result, limit, mode) + +proc simpleExpr(p: var Parser, mode = pmNormal): PNode = + when defined(nimpretty): + inc p.em.doIndentMore result = simpleExprAux(p, -1, mode) + 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 - result = newNodeP(kind, p) - while true: - getTok(p) # skip `if`, `elif` - var branch = newNodeP(nkElifExpr, p) - addSon(branch, parseExpr(p)) - colcom(p, branch) - addSon(branch, parseExpr(p)) - optInd(p, branch) - addSon(result, branch) - if p.tok.tokType != tkElif: break - var branch = newNodeP(nkElseExpr, p) - eat(p, tkElse) - colcom(p, branch) - addSon(branch, parseExpr(p)) - addSon(result, branch) - -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) - addSon(result, a) + if not p.hasProgress: break + result.add(a) if p.tok.tokType == tkComma: getTok(p) skipComment(p, a) optPar(p) - if p.tok.tokType in {tkCurlyDotRi, tkCurlyRi}: getTok(p) - else: parMessage(p, errTokenExpected, ".}") - -proc identVis(p: var TParser): PNode = - #| identVis = symbol opr? # postfix position + if p.tok.tokType in {tkCurlyDotRi, tkCurlyRi}: + 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 Parser; allowDot=false): PNode = + #| identVis = symbol OPR? # postfix position + #| identVisDot = symbol '.' optInd symbolOrKeyword OPR? var a = parseSymbol(p) - if p.tok.tokType == tkOpr: + if p.tok.tokType == tkOpr: + 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) - else: + elif p.tok.tokType == tkDot and allowDot: + result = dotExpr(p, a) + else: result = a - -proc identWithPragma(p: var TParser): PNode = + +proc identWithPragma(p: var Parser; allowDot=false): PNode = #| identWithPragma = identVis pragma? - var a = identVis(p) - if p.tok.tokType == tkCurlyDotLe: + #| identWithPragmaDot = identVisDot pragma? + var a = identVis(p, allowDot) + if p.tok.tokType == tkCurlyDotLe: result = newNodeP(nkPragmaExpr, p) - addSon(result, a) - addSon(result, parsePragma(p)) - else: + 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 - TDeclaredIdentFlags = set[TDeclaredIdentFlag] + withDot # allow 'var ident.ident = value' + 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) - while true: + # progress guaranteed + while true: case p.tok.tokType - of tkSymbol, tkAccent: - if withPragma in flags: a = identWithPragma(p) + of tkSymbol, tkAccent: + 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) - if p.tok.tokType != tkComma: break + if a.kind == nkEmpty: return + else: break + result.add(a) + if p.tok.tokType != tkComma: break getTok(p) optInd(p, a) - if p.tok.tokType == tkColon: + if p.tok.tokType == tkColon: getTok(p) optInd(p, result) - addSon(result, parseTypeDesc(p)) - else: - addSon(result, ast.emptyNode) - if (p.tok.tokType != tkEquals) and not (withBothOptional in flags): - parMessage(p, errColonOrEqualsExpected, p.tok) - if p.tok.tokType == tkEquals: + result.add(parseTypeDesc(p, fullExpr = true)) + else: + 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)) - else: - addSon(result, ast.emptyNode) - -proc parseTuple(p: var TParser, indentAllowed = false): PNode = - #| inlTupleDecl = 'tuple' - #| [' optInd (identColonEquals (comma/semicolon)?)* optPar ']' - #| extTupleDecl = 'tuple' - #| COMMENT? (IND{>} identColonEquals (IND{=} identColonEquals)*)? + result.add(parseExpr(p)) + else: + 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: getTok(p) optInd(p, result) + # progress guaranteed while p.tok.tokType in {tkSymbol, tkAccent}: var a = parseIdentColonEquals(p, {}) - addSon(result, a) - if p.tok.tokType notin {tkComma, tkSemicolon}: break + result.add(a) + if p.tok.tokType notin {tkComma, tkSemiColon}: break + when defined(nimpretty): + commaWasSemicolon(p.em) getTok(p) skipComment(p, a) optPar(p) @@ -803,364 +1108,604 @@ proc parseTuple(p: var TParser, indentAllowed = false): PNode = skipComment(p, result) if realInd(p): withInd(p): - skipComment(p, result) + rawSkipComment(p, result) + # progress guaranteed while true: case p.tok.tokType of tkSymbol, tkAccent: var a = parseIdentColonEquals(p, {}) - skipComment(p, a) - addSon(result, a) + if p.tok.indent < 0 or p.tok.indent >= p.currInd: + rawSkipComment(p, a) + result.add(a) of tkEof: break else: parMessage(p, errIdentifierExpected, p.tok) break if not sameInd(p): break + elif p.tok.tokType == tkParLe: + parMessage(p, errGenerated, "the syntax for tuple types is 'tuple[...]', not 'tuple(...)'") + 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, ast.emptyNode) # return type - if p.tok.tokType == tkParLe and p.tok.indent < 0: + 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) optInd(p, result) + # progress guaranteed while true: case p.tok.tokType - of tkSymbol, tkAccent: + of tkSymbol, tkAccent: a = parseIdentColonEquals(p, {withBothOptional, withPragma}) - of tkParRi: - break - else: - parMessage(p, errTokenExpected, ")") - break - addSon(result, a) - if p.tok.tokType notin {tkComma, tkSemicolon}: break + of tkParRi: + break + of tkVar: + parMessage(p, errGenerated, "the syntax is 'parameter: var T', not 'var parameter: T'") + break + else: + parMessage(p, "expected closing ')'") + break + result.add(a) + if p.tok.tokType notin {tkComma, tkSemiColon}: break + when defined(nimpretty): + commaWasSemicolon(p.em) getTok(p) skipComment(p, a) optPar(p) eat(p, tkParRi) let hasRet = if retColon: p.tok.tokType == tkColon - else: p.tok.tokType == tkOpr and IdentEq(p.tok.ident, "->") + else: p.tok.tokType == tkOpr and p.tok.ident.s == "->" if hasRet and p.tok.indent < 0: getTok(p) optInd(p, result) - result.sons[0] = parseTypeDesc(p) - -proc optPragmas(p: var TParser): PNode = + result.replaceFirstSon parseTypeDesc(p) + elif not retColon and not hasParLe: + # Mark as "not there" in order to mark for deprecation in the semantic pass: + result = p.emptyNode + when defined(nimpretty): + dec p.em.doIndentMore + dec p.em.keepIndents + setEndInfo() + +proc optPragmas(p: var Parser): PNode = if p.tok.tokType == tkCurlyDotLe and (p.tok.indent < 0 or realInd(p)): result = parsePragma(p) else: - result = ast.emptyNode + result = p.emptyNode -proc parseDoBlock(p: var TParser): PNode = - #| doBlock = 'do' paramListArrow pragmas? colcom stmt - let info = parLineInfo(p) - getTok(p) - 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) - eat(p, tkColon) - skipComment(p, result) - result = newProcNode(nkDo, info, parseStmt(p), - params = params, - pragmas = pragmas) - -proc parseDoBlocks(p: var TParser, call: PNode) = - #| doBlocks = doBlock ^* IND{=} - if p.tok.tokType == tkDo: - addSon(call, parseDoBlock(p)) - while sameInd(p) and p.tok.tokType == tkDo: - addSon(call, parseDoBlock(p)) - -proc parseProcExpr(p: var TParser, isExpr: bool): PNode = - #| procExpr = 'proc' paramListColon pragmas? ('=' COMMENT? stmt)? + colcom(p, result) + result = parseStmt(p) + if params.kind != nkEmpty or pragmas.kind != nkEmpty: + if params.kind == nkEmpty: + params = newNodeP(nkFormalParams, p) + params.add(p.emptyNode) # return type + result = newProcNode(nkDo, info, + body = result, params = params, name = p.emptyNode, pattern = p.emptyNode, + genericParams = p.emptyNode, pragmas = pragmas, exceptions = p.emptyNode) + setEndInfo() + +proc parseProcExpr(p: var Parser; isExpr: bool; kind: TNodeKind): PNode = + #| 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: + if p.tok.tokType == tkEquals and isExpr: getTok(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 = newProcNode(nkLambda, info, parseStmt(p), - params = params, - pragmas = pragmas) + 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, tkIterator, tkBind, tkAddr, - tkParLe, tkBracketLe, tkCurlyLe, tkIntLit..tkCharLit, tkVar, tkRef, tkPtr, - tkTuple, tkObject, tkType, tkWhen, tkCase, tkShared: + 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 parseTypeDescKAux(p: var TParser, kind: TNodeKind, - mode: TPrimaryMode): PNode = + +proc parseSymbolList(p: var Parser, result: PNode) = + # progress guaranteed + while true: + var s = parseSymbol(p, smAllowNil) + if s.kind == nkEmpty: break + result.add(s) + if p.tok.tokType != tkComma: break + getTok(p) + optInd(p, s) + setEndInfo() + +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 + if p.tok.ident.s == "with": + nodeKind = nkWith + elif p.tok.ident.s == "without": + nodeKind = nkWithout + else: + return result + getTok(p) + let list = newNodeP(nodeKind, p) + result.add list + parseSymbolList(p, list) + if mode == pmTypeDef and not isTypedef: + result = parseOperators(p, result, -1, mode) + setEndInfo() + +proc parseVarTuple(p: var Parser): PNode + +proc parseFor(p: var Parser): PNode = + #| forStmt = 'for' ((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() -proc parseExpr(p: var TParser): PNode = - #| expr = (ifExpr +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 - #| | tryStmt) + #| | caseStmt + #| | forExpr + #| | tryExpr) #| / simpleExpr - case p.tok.tokType: - of tkIf: result = parseIfExpr(p, nkIfExpr) - of tkWhen: result = parseIfExpr(p, nkWhenExpr) - of tkCase: result = parseCase(p) - of tkTry: result = parseTry(p) + 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 parseObject(p: var TParser): PNode -proc parseDistinct(p: var TParser): PNode -proc parseEnum(p: var TParser): PNode - -proc primary(p: var TParser, mode: TPrimaryMode): PNode = - #| typeKeyw = 'var' | 'ref' | 'ptr' | 'shared' | 'type' | 'tuple' - #| | 'proc' | 'iterator' | 'distinct' | 'object' | 'enum' - #| primary = typeKeyw typeDescK - #| / prefixOperator* identOrLiteral primarySuffix* - #| / 'addr' primary - #| / '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): - let isSigil = IsSigilLike(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 - addSon(result, primary(p, pmSkipSuffix)) - result = primarySuffix(p, result) + const identOrLiteralKinds = tkBuiltInMagics + {tkSymbol, tkAccent, tkNil, + tkIntLit..tkCustomLit, tkCast, tkOut, tkParLe, tkBracketLe, tkCurlyLe} + if isSigil and p.tok.tokType in identOrLiteralKinds: + let baseInd = p.lex.currLineIndent + result.add(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 tkVar: result = parseTypeDescKAux(p, nkVarTy, mode) - of tkRef: result = parseTypeDescKAux(p, nkRefTy, mode) - of tkPtr: result = parseTypeDescKAux(p, nkPtrTy, mode) - of tkShared: result = parseTypeDescKAux(p, nkSharedTy, mode) - of tkType: result = parseTypeDescKAux(p, nkTypeOfExpr, mode) - of tkTuple: result = parseTuple(p, mode == pmTypeDef) - of tkProc: result = parseProcExpr(p, mode notin {pmTypeDesc, pmTypeDef}) + + 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: - if mode in {pmTypeDesc, pmTypeDef}: - result = parseProcExpr(p, false) - result.kind = nkIteratorTy - else: - # no anon iterators for now: - parMessage(p, errExprExpected, p.tok) - getTok(p) # we must consume a token here to prevend endless loops! - result = ast.emptyNode - 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 tkDistinct: - if mode == pmTypeDef: - result = parseDistinct(p) - else: - result = newNodeP(nkDistinctTy, p) - getTok(p) - of tkAddr: - result = newNodeP(nkAddr, p) - getTokNoInd(p) - addSon(result, primary(p, pmNormal)) - of tkStatic: - result = newNodeP(nkStaticExpr, p) - getTokNoInd(p) - addSon(result, primary(p, pmNormal)) + 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)) + 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) + 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 - 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 parseExprStmt(p: var TParser): PNode = - #| exprStmt = simpleExpr - #| (( '=' optInd expr ) - #| / ( expr ^+ comma - #| doBlocks - #| / ':' stmt? ( IND{=} 'of' exprList ':' stmt - #| | IND{=} 'elif' expr ':' stmt - #| | IND{=} 'except' exprList ':' stmt - #| | IND{=} 'else' ':' stmt )* - #| ))? - var a = simpleExpr(p) - if p.tok.tokType == tkEquals: +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 + + var + openingParams = p.emptyNode + openingPragmas = p.emptyNode + + if p.tok.tokType == tkDo: + getTok(p) + openingParams = parseParamList(p, retColon=false) + openingPragmas = optPragmas(p) + + if p.tok.tokType == tkColon: + result = makeCall(result) + getTok(p) + skipComment(p, result) + 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.firstSon.kind == nkStmtList: stmtList = stmtList.firstSon + + 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, + genericParams = p.emptyNode, + pragmas = openingPragmas, + exceptions = p.emptyNode) + else: + result.add stmtList + + while sameInd(p): + var nextBlock: PNode + let nextToken = p.tok.tokType + if nextToken == tkDo: + let info = parLineInfo(p) + getTok(p) + nextBlock = parseDoBlock(p, info) + else: + case nextToken + of tkOf: + nextBlock = newNodeP(nkOfBranch, p) + exprList(p, tkColon, nextBlock) + of tkElif: + nextBlock = newNodeP(nkElifBranch, p) + getTok(p) + optInd(p, nextBlock) + nextBlock.add parseExpr(p) + of tkExcept: + nextBlock = newNodeP(nkExceptBranch, p) + 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.add parseStmt(p) + + setNodeFlag nextBlock, nfBlockArg + result.add nextBlock + + if nextBlock.kind in {nkElse, nkFinally}: break + else: + if openingParams.kind != nkEmpty: + parMessage(p, "expected ':'") + +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) - result = newNodeI(nkAsgn, a.info) - addSon(result, a) - addSon(result, b) + b = postExprBlocks(p, b) + result.add(a) + result.add(b) else: + var isFirstParam = false + # 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 = newNode(nkCommand, a.info, @[a]) + result = newTree(nkCommand, a.info, a) + let baseIndent = p.currInd while true: - var e = parseExpr(p) - addSon(result, e) - 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 - if p.tok.tokType == tkDo and p.tok.indent < 0: - result = makeCall(result) - parseDoBlocks(p, result) - return result - if p.tok.tokType == tkColon and p.tok.indent < 0: - result = makeCall(result) + result = postExprBlocks(p, result) + setEndInfo() + +proc parseModuleName(p: var Parser, kind: TNodeKind): PNode = + result = parseExpr(p) + when false: + # parseExpr already handles 'as' syntax ... + if p.tok.tokType == tkAs and kind == nkImportStmt: + let a = result + result = newNodeP(nkImportAs, p) getTok(p) - skipComment(p, result) - if p.tok.TokType notin {tkOf, tkElif, tkElse, tkExcept}: - let body = parseStmt(p) - addSon(result, newProcNode(nkDo, body.info, body)) - while sameInd(p): - var b: PNode - case p.tok.tokType - of tkOf: - b = newNodeP(nkOfBranch, p) - exprList(p, tkColon, b) - of tkElif: - b = newNodeP(nkElifBranch, p) - getTok(p) - optInd(p, b) - addSon(b, parseExpr(p)) - eat(p, tkColon) - of tkExcept: - b = newNodeP(nkExceptBranch, p) - exprList(p, tkColon, b) - skipComment(p, b) - of tkElse: - b = newNodeP(nkElse, p) - getTok(p) - eat(p, tkColon) - else: break - addSon(b, parseStmt(p)) - addSon(result, b) - if b.kind == nkElse: break + 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 = parseExpr(p) - addSon(result, a) + var a = parseModuleName(p, kind) + 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: # was: while p.tok.tokType notin {tkEof, tkSad, tkDed}: - a = parseExpr(p) - if a.kind == nkEmpty: break - addSon(result, a) - if p.tok.tokType != tkComma: break + p.hasProgress = false + a = parseModuleName(p, kind) + if a.kind == nkEmpty or not p.hasProgress: break + 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` optInd(p, result) while true: # was: while p.tok.tokType notin {tkEof, tkSad, tkDed}: + p.hasProgress = false var a = parseExpr(p) - if a.kind == nkEmpty: break - addSon(result, a) - if p.tok.tokType != tkComma: break + if a.kind == nkEmpty or not p.hasProgress: break + result.add(a) + if p.tok.tokType != tkComma: break getTok(p) optInd(p, a) #expectNl(p) + setEndInfo() -proc parseFromStmt(p: var TParser): PNode = +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 = parseExpr(p) - addSon(result, a) #optInd(p, a); + var a = parseModuleName(p, nkImportStmt) + result.add(a) #optInd(p, a); eat(p, tkImport) optInd(p, result) while true: # p.tok.tokType notin {tkEof, tkSad, tkDed}: + p.hasProgress = false a = parseExpr(p) - if a.kind == nkEmpty: break - addSon(result, a) - if p.tok.tokType != tkComma: break + if a.kind == nkEmpty or not p.hasProgress: break + 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, ast.emptyNode) - elif p.tok.indent >= 0 and p.tok.indent <= p.currInd or - p.tok.tokType == tkEof: + result.add(p.emptyNode) + elif p.tok.indent >= 0 and p.tok.indent <= p.currInd or not isExprStart(p): # NL terminates: - addSon(result, ast.emptyNode) + result.add(p.emptyNode) + # nimpretty here! else: - addSon(result, parseExpr(p)) + var e = parseExpr(p) + e = postExprBlocks(p, 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)? @@ -1171,31 +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)) - eat(p, tkColon) - skipComment(p, branch) - addSon(branch, parseStmt(p)) + branch.add(parseExpr(p)) + colcom(p, branch) + 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) - eat(p, tkColon) + colcom(p, 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) - addSon(branch, parseStmt(p)) - addSon(result, 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)* @@ -1205,19 +1775,19 @@ 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) - + let oldInd = p.currInd if realInd(p): p.currInd = p.tok.indent wasIndented = true - + while sameInd(p): case p.tok.tokType of tkOf: @@ -1229,349 +1799,366 @@ proc parseCase(p: var TParser): PNode = b = newNodeP(nkElifBranch, p) getTok(p) optInd(p, b) - addSon(b, parseExpr(p)) - eat(p, tkColon) + b.add(parseExpr(p)) of tkElse: b = newNodeP(nkElse, p) getTok(p) - eat(p, tkColon) else: break - skipComment(p, b) - addSon(b, parseStmt(p)) - addSon(result, b) + colcom(p, b) + b.add(parseStmt(p)) + result.add(b) if b.kind == nkElse: break - + if wasIndented: p.currInd = oldInd - -proc parseTry(p: var TParser): PNode = + setEndInfo() + +proc parseTry(p: var Parser; isExpr: bool): PNode = #| tryStmt = 'try' colcom stmt &(IND{=}? 'except'|'finally') - #| (IND{=}? 'except' exprList colcom stmt)* + #| (IND{=}? 'except' optionalExprList colcom stmt)* #| (IND{=}? 'finally' colcom stmt)? + #| tryExpr = 'try' colcom stmt &(optInd 'except'|'finally') + #| (optInd 'except' optionalExprList colcom stmt)* + #| (optInd 'finally' colcom stmt)? result = newNodeP(nkTryStmt, p) + let parentIndent = p.currInd # isExpr getTok(p) - eat(p, tkColon) - skipComment(p, result) - addSon(result, parseStmt(p)) + colcom(p, result) + result.add(parseStmt(p)) var b: PNode = nil - while sameOrNoInd(p): + + while sameOrNoInd(p) or (isExpr and parentIndent <= p.tok.indent): case p.tok.tokType - of tkExcept: + of tkExcept: b = newNodeP(nkExceptBranch, p) - exprList(p, tkColon, b) - of tkFinally: + optionalExprList(p, tkColon, b) + of tkFinally: b = newNodeP(nkFinally, p) - getTokNoInd(p) - eat(p, tkColon) + getTok(p) else: break - skipComment(p, b) - addSon(b, parseStmt(p)) - addSon(result, b) - if b.kind == nkFinally: break - if b == nil: parMessage(p, errTokenExpected, "except") - -proc parseExceptBlock(p: var TParser, kind: TNodeKind): PNode = - #| exceptBlock = 'except' colcom stmt - result = newNodeP(kind, p) - getTokNoInd(p) - colcom(p, result) - addSon(result, parseStmt(p)) + colcom(p, b) + b.add(parseStmt(p)) + result.add(b) + if b == nil: parMessage(p, "expected 'except'") + 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)) +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 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, ast.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 parseStatic(p: var TParser): PNode = +proc parseStaticOrDefer(p: var Parser; k: TNodeKind): PNode = #| staticStmt = 'static' colcom stmt - result = newNodeP(nkStaticStmt, p) - getTokNoInd(p) + #| deferStmt = 'defer' colcom stmt + result = newNodeP(k, p) + getTok(p) colcom(p, result) - addSon(result, parseStmt(p)) - -proc parseAsm(p: var TParser): PNode = - #| asmStmt = 'asm' pragma? (STR_LIT | RSTR_LIT | TRIPLE_STR_LIT) + result.add(parseStmt(p)) + setEndInfo() + +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, ast.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)) - else: - parMessage(p, errStringLiteralExpected) - addSon(result, ast.emptyNode) - return + 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") + 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) - while true: + # progress guaranteed + while true: case p.tok.tokType - of tkSymbol, tkAccent: + of tkIn, tkOut: + let x = p.lex.cache.getIdent(if p.tok.tokType == tkIn: "in" else: "out") + a = newNodeP(nkPrefix, p) + a.add newIdentNodeP(x, p) + getTok(p) + expectIdent(p) + a.add(parseSymbol(p)) + of tkSymbol, tkAccent: a = parseSymbol(p) - if a.kind == nkEmpty: return - else: break - addSon(result, a) - if p.tok.tokType != tkComma: break + if a.kind == nkEmpty: return + else: break + result.add(a) + if p.tok.tokType != tkComma: break getTok(p) optInd(p, a) - if p.tok.tokType == tkColon: + if p.tok.tokType == tkColon: getTok(p) optInd(p, result) - addSon(result, parseExpr(p)) - else: - addSon(result, ast.emptyNode) - if p.tok.tokType == tkEquals: + result.add(parseExpr(p)) + else: + result.add(p.emptyNode) + if p.tok.tokType == tkEquals: getTok(p) optInd(p, result) - addSon(result, parseExpr(p)) - else: - addSon(result, ast.emptyNode) + result.add(parseExpr(p)) + else: + 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) getTok(p) optInd(p, result) - while p.tok.tokType in {tkSymbol, tkAccent}: + # progress guaranteed + while p.tok.tokType in {tkSymbol, tkAccent, tkIn, tkOut}: var a = parseGenericParam(p) - addSon(result, a) - if p.tok.tokType notin {tkComma, tkSemicolon}: break + result.add(a) + if p.tok.tokType notin {tkComma, tkSemiColon}: break + 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, ast.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, ast.emptyNode) - addSon(result, p.parseParamList) - if p.tok.tokType == tkCurlyDotLe and p.validInd: addSon(result, p.parsePragma) - else: addSon(result, ast.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, ast.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, ast.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.info.line = result.info.line - int16(1) - int16(p.tok.iNumber) 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) - getTok(p) + if kind != nkTypeSection: getTok(p) skipComment(p, result) if realInd(p): withInd(p): skipComment(p, result) + # progress guaranteed while sameInd(p): case p.tok.tokType - of tkSymbol, tkAccent: + of tkSymbol, tkAccent, tkParLe: var a = defparser(p) skipComment(p, a) - addSon(result, a) - of tkComment: + result.add(a) + of tkComment: var a = newCommentStmt(p) - addSon(result, a) - else: + 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)) - else: + result.add(defparser(p)) + else: parMessage(p, errIdentifierExpected, p.tok) - -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, ast.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?)+ + setEndInfo() + +proc parseEnum(p: var Parser): PNode = + #| enumDecl = 'enum' optInd (symbol pragma? optInd ('=' optInd expr COMMENT?)? comma?)+ result = newNodeP(nkEnumTy, p) getTok(p) - addSon(result, ast.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: + + 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)) - skipComment(p, a) + 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, symPragma) if p.tok.tokType == tkComma and p.tok.indent < 0: getTok(p) - rawSkipComment(p, a) + rawSkipComment(p, symPragma) else: - skipComment(p, a) - addSon(result, a) + if p.tok.indent < 0 or p.tok.indent >= p.currInd: + 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: - lexMessage(p.lex, errIdentifierExpected, prettyTok(p.tok)) + 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?)? result = newNodeP(nkRecWhen, p) - while sameInd(p): + # progress guaranteed + while sameInd(p): 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)) - skipComment(p, branch) - addSon(result, branch) + branch.add(parseObjectPart(p)) + flexComment(p, 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)) - skipComment(p, branch) - addSon(result, branch) + branch.add(parseObjectPart(p)) + flexComment(p, 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, ast.emptyNode) - addSon(result, a) + var a = parseIdentColonEquals(p, {withPragma}) + result.add(a) if p.tok.tokType == tkColon: getTok(p) - skipComment(p, result) + flexComment(p, result) var wasIndented = false let oldInd = p.currInd if realInd(p): p.currInd = p.tok.indent wasIndented = true + # progress guaranteed while sameInd(p): var b: PNode case p.tok.tokType - of tkOf: + of tkOf: b = newNodeP(nkOfBranch, p) exprList(p, tkColon, b) - of tkElse: + of tkElse: b = newNodeP(nkElse, p) getTok(p) - eat(p, tkColon) - else: break - skipComment(p, b) + else: break + colcom(p, b) var fields = parseObjectPart(p) 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 - -proc parseObjectPart(p: var TParser): PNode = + setEndInfo() + +proc parseObjectPart(p: var Parser): PNode = #| objectPart = IND{>} objectPart^+IND{=} DED - #| / objectWhen / objectCase / 'nil' / declColonEquals + #| / objectWhen / objectCase / 'nil' / 'discard' / declColonEquals if realInd(p): result = newNodeP(nkRecList, p) withInd(p): rawSkipComment(p, result) while sameInd(p): case p.tok.tokType - of tkCase, tkWhen, tkSymbol, tkAccent, tkNil: - addSon(result, parseObjectPart(p)) + of tkCase, tkWhen, tkSymbol, tkAccent, tkNil, tkDiscard: + result.add(parseObjectPart(p)) else: parMessage(p, errIdentifierExpected, p.tok) break - else: + elif sameOrNoInd(p): case p.tok.tokType of tkWhen: result = parseObjectWhen(p) @@ -1579,110 +2166,225 @@ proc parseObjectPart(p: var TParser): PNode = result = parseObjectCase(p) of tkSymbol, tkAccent: result = parseIdentColonEquals(p, {withPragma}) - skipComment(p, result) - of tkNil: + if p.tok.indent < 0 or p.tok.indent >= p.currInd: + rawSkipComment(p, result) + of tkNil, tkDiscard: result = newNodeP(nkNilLit, p) getTok(p) else: - result = ast.emptyNode - -proc parseObject(p: var TParser): PNode = - #| object = 'object' pragma? ('of' typeDesc)? COMMENT? objectPart + result = p.emptyNode + else: + result = p.emptyNode + setEndInfo() + +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, ast.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) - else: - addSon(result, ast.emptyNode) + a.add(parseTypeDesc(p)) + result.add(a) + else: + result.add(p.emptyNode) if p.tok.tokType == tkComment: skipComment(p, result) # an initial IND{>} HAS to follow: if not realInd(p): - addSon(result, emptyNode) - return - addSon(result, parseObjectPart(p)) + result.add(p.emptyNode) + else: + result.add(parseObjectPart(p)) + setEndInfo() -proc parseDistinct(p: var TParser): PNode = - #| distinct = 'distinct' optInd typeDesc - result = newNodeP(nkDistinctTy, p) +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 + of tkType: nkTypeOfExpr + else: nkEmpty + + if modifier != nkEmpty: + result = newNodeP(modifier, p) + getTok(p) + result.add(p.parseSymbol) + else: + result = p.parseSymbol + setEndInfo() + +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) - optInd(p, result) - addSon(result, parseTypeDesc(p)) + 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: + result.add(parsePragma(p)) + else: + 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: + a.add(parseTypeDesc(p)) + if p.tok.tokType != tkComma: break + getTok(p) + result.add(a) + else: + result.add(p.emptyNode) + if p.tok.tokType == tkComment: + skipComment(p, result) + # an initial IND{>} HAS to follow: + if not realInd(p): + if result.isNewStyleConcept: + parMessage(p, "routine expected, but found '$1' (empty new-styled concepts are not allowed)", p.tok) + result.add(p.emptyNode) + else: + result.add(parseStmt(p)) + setEndInfo() -proc parseTypeDef(p: var TParser): PNode = - #| typeDef = identWithPragma genericParamList? '=' optInd typeDefAux +proc parseTypeDef(p: var Parser): PNode = + #| + #| typeDef = identVisDot genericParamList? pragma '=' optInd typeDefValue #| indAndComment? result = newNodeP(nkTypeDef, p) - addSon(result, identWithPragma(p)) + 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, ast.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, ast.emptyNode) + result.add(p.emptyNode) indAndComment(p, result) # special extension! - -proc parseVarTuple(p: var TParser): PNode = - #| varTuple = '(' optInd identWithPragma ^+ comma optPar ')' '=' optInd expr + setEndInfo() + +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) - while p.tok.tokType in {tkSymbol, tkAccent}: - var a = identWithPragma(p) - addSon(result, a) - if p.tok.tokType != tkComma: break + # progress guaranteed + 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, ast.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 Parser): PNode = + #| colonBody = colcom stmt postExprBlocks? + #| variable = (varTuple / identColonEquals) colonBody? indAndComment + 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.setLastSon postExprBlocks(p, result.lastSon) + indAndComment(p, result) + setEndInfo() -proc parseVariable(p: var TParser): PNode = - #| variable = (varTuple / identColonEquals) indAndComment +proc parseConstant(p: var Parser): PNode = + #| constant = (varTuple / identWithPragma) (colon typeDesc)? '=' optInd expr indAndComment if p.tok.tokType == tkParLe: result = parseVarTuple(p) - else: result = parseIdentColonEquals(p, {withPragma}) + 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) - -proc parseBind(p: var TParser, k: TNodeKind): PNode = + setEndInfo() + +proc parseBind(p: var Parser, k: TNodeKind): PNode = #| bindStmt = 'bind' optInd qualifiedIdent ^+ comma #| mixinStmt = 'mixin' optInd qualifiedIdent ^+ comma result = newNodeP(k, p) getTok(p) optInd(p, result) + # 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) - -proc parseStmtPragma(p: var TParser): PNode = + setEndInfo() + +proc parseStmtPragma(p: var Parser): PNode = #| pragmaStmt = pragma (':' COMMENT? stmt)? result = parsePragma(p) if p.tok.tokType == tkColon and p.tok.indent < 0: let a = result - result = newNodeI(nkPragmaBlock, a.info) + result = newNode(nkPragmaBlock, a.info) getTok(p) skipComment(p, result) result.add a result.add parseStmt(p) + setEndInfo() -proc simpleStmt(p: var TParser): PNode = +proc simpleStmt(p: var Parser): PNode = #| simpleStmt = ((returnStmt | raiseStmt | yieldStmt | discardStmt | breakStmt #| | continueStmt | pragmaStmt | importStmt | exportStmt | fromStmt #| | includeStmt | commentStmt) / exprStmt) COMMENT? @@ -1702,126 +2404,187 @@ proc simpleStmt(p: var TParser): PNode = of tkComment: result = newCommentStmt(p) else: if isExprStart(p): result = parseExprStmt(p) - else: result = ast.emptyNode + 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 | finallyStmt | exceptStmt | forStmt - #| | blockStmt | staticStmt | asmStmt + #| | tryStmt | forStmt + #| | blockStmt | staticStmt | deferStmt | asmStmt #| | 'proc' routine #| | 'method' routine + #| | 'func' routine #| | 'iterator' routine #| | 'macro' routine #| | 'template' routine #| | 'converter' routine #| | 'type' section(typeDef) #| | 'const' section(constant) - #| | ('let' | 'var') section(variable) + #| | ('let' | 'var' | 'using') section(variable) #| | bindStmt | mixinStmt) #| / simpleStmt case p.tok.tokType of tkIf: result = parseIfOrWhen(p, nkIfStmt) of tkWhile: result = parseWhile(p) of tkCase: result = parseCase(p) - of tkTry: result = parseTry(p) + of tkTry: result = parseTry(p, isExpr=false) of tkFinally: result = parseExceptBlock(p, nkFinally) of tkExcept: result = parseExceptBlock(p, nkExceptBranch) of tkFor: result = parseFor(p) of tkBlock: result = parseBlock(p) - of tkStatic: result = parseStatic(p) + of tkStatic: result = parseStaticOrDefer(p, nkStaticStmt) + of tkDefer: result = parseStaticOrDefer(p, nkDefer) of tkAsm: result = parseAsm(p) of tkProc: result = parseRoutine(p, nkProcDef) + of tkFunc: result = parseRoutine(p, nkFuncDef) of tkMethod: result = parseRoutine(p, nkMethodDef) of tkIterator: result = parseRoutine(p, nkIteratorDef) of tkMacro: result = parseRoutine(p, nkMacroDef) of tkTemplate: result = parseRoutine(p, nkTemplateDef) of tkConverter: result = parseRoutine(p, nkConverterDef) - of tkType: result = parseSection(p, nkTypeSection, parseTypeDef) - of tkConst: result = parseSection(p, nkConstSection, parseConstant) - of tkLet: result = parseSection(p, nkLetSection, parseVariable) + of tkType: + getTok(p) + if p.tok.tokType == tkParLe: + getTok(p) + result = newNodeP(nkTypeOfExpr, p) + result.add(primary(p, pmTypeDesc)) + eat(p, tkParRi) + result = parseOperators(p, result, -1, pmNormal) + else: + result = parseSection(p, nkTypeSection, parseTypeDef) + 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: if p.tok.indent == p.currInd: - nil - elif p.tok.tokType == tkSemicolon: - while p.tok.tokType == tkSemicolon: getTok(p) + discard + elif p.tok.tokType == tkSemiColon: + getTok(p) + if p.tok.indent < 0 or p.tok.indent == p.currInd: discard + else: break else: - if p.tok.indent > p.currInd: + if p.tok.indent > p.currInd and p.tok.tokType != tkDot: parMessage(p, errInvalidIndentation) break - if p.tok.toktype in {tkCurlyRi, tkParRi, tkCurlyDotRi, tkBracketRi}: + if p.tok.tokType in {tkCurlyRi, tkParRi, tkCurlyDotRi, tkBracketRi}: # XXX this ensures tnamedparamanonproc still compiles; # deprecate this syntax later break - var a = complexOrSimpleStmt(p) - if a.kind != nkEmpty: - addSon(result, a) - else: + p.hasProgress = false + 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) - getTok(p) + break + else: + 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, tkIterator, - tkMacro, tkType, tkConst, tkWhen, tkVar: - parMessage(p, errComplexStmtRequiresInd) - result = ast.emptyNode + of tkIf, tkWhile, tkCase, tkTry, tkFor, tkBlock, tkAsm, tkProc, tkFunc, + tkIterator, tkMacro, tkType, tkConst, tkWhen, tkVar: + parMessage(p, "nestable statement requires indentation") + result = p.emptyNode else: - result = newNodeP(nkStmtList, p) - while true: - if p.tok.indent >= 0: parMessage(p, errInvalidIndentation) - let a = simpleStmt(p) - if a.kind == nkEmpty: parMessage(p, errExprExpected, p.tok) - result.add(a) - if p.tok.tokType != tkSemicolon: break - getTok(p) - -proc parseAll(p: var TParser): PNode = - result = newNodeP(nkStmtList, p) - while p.tok.tokType != tkEof: - var a = complexOrSimpleStmt(p) - if a.kind != nkEmpty: - 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 parseTopLevelStmt(p: var TParser): PNode = - result = ast.emptyNode + if p.inSemiStmtList > 0: + result = simpleStmt(p) + if result.kind == nkEmpty: parMessage(p, errExprExpected, p.tok) + else: + result = newNodeP(nkStmtList, p) + while true: + if p.tok.indent >= 0: + parMessage(p, errInvalidIndentation) + p.hasProgress = false + let a = simpleStmt(p) + let err = not p.hasProgress + if a.kind == nkEmpty: parMessage(p, errExprExpected, p.tok) + result.add(a) + if p.tok.tokType != tkSemiColon: break + getTok(p) + if err and p.tok.tokType == tkEof: break + setEndInfo() + +proc checkFirstLineIndentation*(p: var Parser) = + if p.tok.indent != 0 and tsLeading in p.tok.spacing: + parMessage(p, errInvalidIndentation) + +proc parseTopLevelStmt*(p: var Parser): PNode = + ## 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: - if p.tok.indent != 0: - if p.firstTok and p.tok.indent < 0: nil - else: parMessage(p, errInvalidIndentation) + # nimpretty support here + if p.tok.indent != 0: + if p.firstTok and p.tok.indent < 0: discard + elif p.tok.tokType != tkSemiColon: + # special casing for better error messages: + if p.tok.tokType == tkOpr and p.tok.ident.s == "*": + parMessage(p, errGenerated, + "invalid indentation; an export marker '*' follows the declared identifier") + else: + parMessage(p, errInvalidIndentation) p.firstTok = false case p.tok.tokType - of tkSemicolon: getTok(p) + of tkSemiColon: + getTok(p) + if p.tok.indent <= 0: discard + else: parMessage(p, errInvalidIndentation) + p.firstTok = true of tkEof: break else: result = complexOrSimpleStmt(p) if result.kind == nkEmpty: parMessage(p, errExprExpected, p.tok) break + setEndInfo() -proc parseString(s: string, filename: string = "", line: int = 0): PNode = - var stream = LLStreamOpen(s) +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: 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 + ## source. + var stream = llStreamOpen(s) stream.lineOffset = line - var parser: TParser - OpenParser(parser, filename, stream) + 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/pas2nim/nimrod.cfg b/compiler/pas2nim/nimrod.cfg deleted file mode 100644 index cfeda63ed..000000000 --- a/compiler/pas2nim/nimrod.cfg +++ /dev/null @@ -1,4 +0,0 @@ -# Use the modules of the compiler - -path: "$nimrod/compiler" - diff --git a/compiler/pas2nim/pas2nim.nim b/compiler/pas2nim/pas2nim.nim deleted file mode 100644 index ce5eb5c1a..000000000 --- a/compiler/pas2nim/pas2nim.nim +++ /dev/null @@ -1,64 +0,0 @@ -# -# -# Pas2nim - Pascal to Nimrod source converter -# (c) Copyright 2012 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -import - strutils, os, parseopt, llstream, ast, renderer, options, msgs, - paslex, pasparse - -const - Version = "0.8" - Usage = """ -pas2nim - Pascal to Nimrod source converter - (c) 2012 Andreas Rumpf -Usage: pas2nim [options] inputfile [options] -Options: - -o, --out:FILE set output filename - --ref convert ^typ to ref typ (default: ptr typ) - --boot use special translation rules for the Nimrod compiler - -v, --version write pas2nim's version - -h, --help show this help -""" - -proc main(infile, outfile: string, flags: set[TParserFlag]) = - var stream = LLStreamOpen(infile, fmRead) - if stream == nil: rawMessage(errCannotOpenFile, infile) - var p: TParser - openParser(p, infile, stream, flags) - var module = parseUnit(p) - closeParser(p) - renderModule(module, outfile) - -var - infile = "" - outfile = "" - flags: set[TParserFlag] = {} -for kind, key, val in getopt(): - case kind - of cmdArgument: infile = key - of cmdLongOption, cmdShortOption: - case key - of "help", "h": - stdout.write(Usage) - quit(0) - of "version", "v": - stdout.write(Version & "\n") - quit(0) - of "o", "out": outfile = val - of "ref": incl(flags, pfRefs) - of "boot": flags = flags + {pfRefs, pfMoreReplacements, pfImportBlackList} - else: stdout.writeln("[Error] unknown option: " & key) - of cmdEnd: assert(false) -if infile.len == 0: - # no filename has been given, so we show the help: - stdout.write(Usage) -else: - if outfile.len == 0: - outfile = changeFileExt(infile, "nim") - infile = addFileExt(infile, "pas") - main(infile, outfile, flags) diff --git a/compiler/pas2nim/paslex.nim b/compiler/pas2nim/paslex.nim deleted file mode 100644 index 94e664832..000000000 --- a/compiler/pas2nim/paslex.nim +++ /dev/null @@ -1,570 +0,0 @@ -# -# -# Pas2nim - Pascal to Nimrod source converter -# (c) Copyright 2012 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements a FreePascal scanner. This is an adaption from -# the scanner module. - -import - hashes, options, msgs, strutils, platform, idents, nimlexbase, llstream - -const - MaxLineLength* = 80 # lines longer than this lead to a warning - numChars*: TCharSet = {'0'..'9', 'a'..'z', 'A'..'Z'} - SymChars*: TCharSet = {'a'..'z', 'A'..'Z', '0'..'9', '\x80'..'\xFF'} - SymStartChars*: TCharSet = {'a'..'z', 'A'..'Z', '\x80'..'\xFF'} - OpChars*: TCharSet = {'+', '-', '*', '/', '<', '>', '!', '?', '^', '.', '|', - '=', ':', '%', '&', '$', '@', '~', '\x80'..'\xFF'} - -# keywords are sorted! - -type - TTokKind* = enum - pxInvalid, pxEof, - pxAnd, pxArray, pxAs, pxAsm, pxBegin, pxCase, pxClass, pxConst, - pxConstructor, pxDestructor, pxDiv, pxDo, pxDownto, pxElse, pxEnd, pxExcept, - pxExports, pxFinalization, pxFinally, pxFor, pxFunction, pxGoto, pxIf, - pxImplementation, pxIn, pxInherited, pxInitialization, pxInline, - pxInterface, pxIs, pxLabel, pxLibrary, pxMod, pxNil, pxNot, pxObject, pxOf, - pxOr, pxOut, pxPacked, pxProcedure, pxProgram, pxProperty, pxRaise, - pxRecord, pxRepeat, pxResourcestring, pxSet, pxShl, pxShr, pxThen, - pxThreadvar, pxTo, pxTry, pxType, pxUnit, pxUntil, pxUses, pxVar, pxWhile, - pxWith, pxXor, - pxComment, # ordinary comment - pxCommand, # {@} - pxAmp, # {&} - pxPer, # {%} - pxStrLit, pxSymbol, # a symbol - pxIntLit, pxInt64Lit, # long constant like 0x70fffffff or out of int range - pxFloatLit, pxParLe, pxParRi, pxBracketLe, pxBracketRi, pxComma, - pxSemiColon, pxColon, # operators - pxAsgn, pxEquals, pxDot, pxDotDot, pxHat, pxPlus, pxMinus, pxStar, pxSlash, - pxLe, pxLt, pxGe, pxGt, pxNeq, pxAt, pxStarDirLe, pxStarDirRi, pxCurlyDirLe, - pxCurlyDirRi - TTokKinds* = set[TTokKind] - -const - Keywords = ["and", "array", "as", "asm", "begin", "case", "class", "const", - "constructor", "destructor", "div", "do", "downto", "else", "end", "except", - "exports", "finalization", "finally", "for", "function", "goto", "if", - "implementation", "in", "inherited", "initialization", "inline", - "interface", "is", "label", "library", "mod", "nil", "not", "object", "of", - "or", "out", "packed", "procedure", "program", "property", "raise", - "record", "repeat", "resourcestring", "set", "shl", "shr", "then", - "threadvar", "to", "try", "type", "unit", "until", "uses", "var", "while", - "with", "xor"] - - firstKeyword = pxAnd - lastKeyword = pxXor - -type - TNumericalBase* = enum base10, base2, base8, base16 - TToken* = object - xkind*: TTokKind # the type of the token - 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 - literal*: string # the parsed (string) literal - - TLexer* = object of TBaseLexer - filename*: string - - -proc getTok*(L: var TLexer, tok: var TToken) -proc PrintTok*(tok: TToken) -proc `$`*(tok: TToken): string -# implementation - -var - dummyIdent: PIdent - gLinesCompiled: int - -proc fillToken(L: var TToken) = - L.xkind = pxInvalid - L.iNumber = 0 - L.literal = "" - L.fNumber = 0.0 - L.base = base10 - L.ident = dummyIdent # this prevents many bugs! - -proc openLexer*(lex: var TLexer, filename: string, inputstream: PLLStream) = - openBaseLexer(lex, inputstream) - lex.filename = filename - -proc closeLexer*(lex: var TLexer) = - inc(gLinesCompiled, lex.LineNumber) - closeBaseLexer(lex) - -proc getColumn(L: TLexer): int = - result = getColNumber(L, L.bufPos) - -proc getLineInfo*(L: TLexer): TLineInfo = - result = newLineInfo(L.filename, L.linenumber, getColNumber(L, L.bufpos)) - -proc lexMessage*(L: TLexer, msg: TMsgKind, arg = "") = - msgs.GlobalError(getLineInfo(L), msg, arg) - -proc lexMessagePos(L: var TLexer, msg: TMsgKind, pos: int, arg = "") = - var info = newLineInfo(L.filename, L.linenumber, pos - L.lineStart) - msgs.GlobalError(info, msg, arg) - -proc TokKindToStr*(k: TTokKind): string = - case k - of pxEof: result = "[EOF]" - of firstKeyword..lastKeyword: - result = keywords[ord(k)-ord(firstKeyword)] - of pxInvalid, pxComment, pxStrLit: result = "string literal" - of pxCommand: result = "{@" - of pxAmp: result = "{&" - of pxPer: result = "{%" - of pxSymbol: result = "identifier" - of pxIntLit, pxInt64Lit: result = "integer literal" - of pxFloatLit: result = "floating point literal" - of pxParLe: result = "(" - of pxParRi: result = ")" - of pxBracketLe: result = "[" - of pxBracketRi: result = "]" - of pxComma: result = "," - of pxSemiColon: result = ";" - of pxColon: result = ":" - of pxAsgn: result = ":=" - of pxEquals: result = "=" - of pxDot: result = "." - of pxDotDot: result = ".." - of pxHat: result = "^" - of pxPlus: result = "+" - of pxMinus: result = "-" - of pxStar: result = "*" - of pxSlash: result = "/" - of pxLe: result = "<=" - of pxLt: result = "<" - of pxGe: result = ">=" - of pxGt: result = ">" - of pxNeq: result = "<>" - of pxAt: result = "@" - of pxStarDirLe: result = "(*$" - of pxStarDirRi: result = "*)" - of pxCurlyDirLe: result = "{$" - of pxCurlyDirRi: result = "}" - -proc `$`(tok: TToken): string = - case tok.xkind - of pxInvalid, pxComment, pxStrLit: result = tok.literal - of pxSymbol: result = tok.ident.s - of pxIntLit, pxInt64Lit: result = $tok.iNumber - of pxFloatLit: result = $tok.fNumber - else: result = TokKindToStr(tok.xkind) - -proc PrintTok(tok: TToken) = - writeln(stdout, $tok) - -proc setKeyword(L: var TLexer, tok: var TToken) = - var x = binaryStrSearch(keywords, toLower(tok.ident.s)) - if x < 0: tok.xkind = pxSymbol - else: tok.xKind = TTokKind(x + ord(firstKeyword)) - -proc matchUnderscoreChars(L: var TLexer, tok: var TToken, chars: TCharSet) = - # matches ([chars]_)* - var pos = L.bufpos # use registers for pos, buf - var buf = L.buf - while true: - if buf[pos] in chars: - add(tok.literal, buf[pos]) - Inc(pos) - else: - break - if buf[pos] == '_': - add(tok.literal, '_') - Inc(pos) - L.bufPos = pos - -proc isFloatLiteral(s: string): bool = - for i in countup(0, len(s)-1): - if s[i] in {'.', 'e', 'E'}: - return true - -proc getNumber2(L: var TLexer, tok: var TToken) = - var pos = L.bufpos + 1 # skip % - if not (L.buf[pos] in {'0'..'1'}): - # BUGFIX for %date% - tok.xkind = pxInvalid - add(tok.literal, '%') - inc(L.bufpos) - return - tok.base = base2 - var xi: biggestInt = 0 - var bits = 0 - while true: - case L.buf[pos] - of 'A'..'Z', 'a'..'z', '2'..'9', '.': - lexMessage(L, errInvalidNumber) - inc(pos) - of '_': - inc(pos) - of '0', '1': - xi = `shl`(xi, 1) or (ord(L.buf[pos]) - ord('0')) - inc(pos) - inc(bits) - else: break - tok.iNumber = xi - if (bits > 32): tok.xkind = pxInt64Lit - else: tok.xkind = pxIntLit - L.bufpos = pos - -proc getNumber16(L: var TLexer, tok: var TToken) = - var pos = L.bufpos + 1 # skip $ - tok.base = base16 - var xi: biggestInt = 0 - var bits = 0 - while true: - case L.buf[pos] - of 'G'..'Z', 'g'..'z', '.': - lexMessage(L, errInvalidNumber) - inc(pos) - of '_': inc(pos) - of '0'..'9': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('0')) - inc(pos) - inc(bits, 4) - of 'a'..'f': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('a') + 10) - inc(pos) - inc(bits, 4) - of 'A'..'F': - xi = `shl`(xi, 4) or (ord(L.buf[pos]) - ord('A') + 10) - inc(pos) - inc(bits, 4) - else: break - tok.iNumber = xi - if (bits > 32): - tok.xkind = pxInt64Lit - else: - tok.xkind = pxIntLit - L.bufpos = pos - -proc getNumber10(L: var TLexer, tok: var TToken) = - tok.base = base10 - matchUnderscoreChars(L, tok, {'0'..'9'}) - if (L.buf[L.bufpos] == '.') and (L.buf[L.bufpos + 1] in {'0'..'9'}): - add(tok.literal, '.') - inc(L.bufpos) - matchUnderscoreChars(L, tok, {'e', 'E', '+', '-', '0'..'9'}) - try: - if isFloatLiteral(tok.literal): - tok.fnumber = parseFloat(tok.literal) - tok.xkind = pxFloatLit - else: - tok.iNumber = ParseInt(tok.literal) - if (tok.iNumber < low(int32)) or (tok.iNumber > high(int32)): - tok.xkind = pxInt64Lit - else: - tok.xkind = pxIntLit - except EInvalidValue: - lexMessage(L, errInvalidNumber, tok.literal) - except EOverflow: - lexMessage(L, errNumberOutOfRange, tok.literal) - -proc HandleCRLF(L: var TLexer, pos: int): int = - case L.buf[pos] - of CR: result = nimlexbase.HandleCR(L, pos) - of LF: result = nimlexbase.HandleLF(L, pos) - else: result = pos - -proc getString(L: var TLexer, tok: var TToken) = - var xi: int - var pos = L.bufPos - var buf = L.buf - while true: - if buf[pos] == '\'': - inc(pos) - while true: - case buf[pos] - of CR, LF, nimlexbase.EndOfFile: - lexMessage(L, errClosingQuoteExpected) - break - of '\'': - inc(pos) - if buf[pos] == '\'': - inc(pos) - add(tok.literal, '\'') - else: - break - else: - add(tok.literal, buf[pos]) - inc(pos) - elif buf[pos] == '#': - inc(pos) - xi = 0 - case buf[pos] - of '$': - inc(pos) - xi = 0 - while true: - case buf[pos] - of '0'..'9': xi = (xi shl 4) or (ord(buf[pos]) - ord('0')) - of 'a'..'f': xi = (xi shl 4) or (ord(buf[pos]) - ord('a') + 10) - of 'A'..'F': xi = (xi shl 4) or (ord(buf[pos]) - ord('A') + 10) - else: break - inc(pos) - of '0'..'9': - xi = 0 - while buf[pos] in {'0'..'9'}: - xi = (xi * 10) + (ord(buf[pos]) - ord('0')) - inc(pos) - else: lexMessage(L, errInvalidCharacterConstant) - if (xi <= 255): add(tok.literal, Chr(xi)) - else: lexMessage(L, errInvalidCharacterConstant) - else: - break - tok.xkind = pxStrLit - L.bufpos = pos - -proc getSymbol(L: var TLexer, tok: var TToken) = - var h: THash = 0 - var pos = L.bufpos - var buf = L.buf - while true: - var c = buf[pos] - case c - of 'a'..'z', '0'..'9', '\x80'..'\xFF': - h = h +% Ord(c) - h = h +% h shl 10 - h = h xor (h shr 6) - of 'A'..'Z': - c = chr(ord(c) + (ord('a') - ord('A'))) # toLower() - h = h +% Ord(c) - h = h +% h shl 10 - h = h xor (h shr 6) - of '_': nil - else: break - Inc(pos) - h = h +% h shl 3 - h = h xor (h shr 11) - h = h +% h shl 15 - tok.ident = getIdent(addr(L.buf[L.bufpos]), pos - L.bufpos, h) - L.bufpos = pos - setKeyword(L, tok) - -proc scanLineComment(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - # a comment ends if the next line does not start with the // on the same - # column after only whitespace - tok.xkind = pxComment - var col = getColNumber(L, pos) - while true: - inc(pos, 2) # skip // - add(tok.literal, '#') - while not (buf[pos] in {CR, LF, nimlexbase.EndOfFile}): - add(tok.literal, buf[pos]) - inc(pos) - pos = handleCRLF(L, pos) - buf = L.buf - var indent = 0 - while buf[pos] == ' ': - inc(pos) - inc(indent) - if (col == indent) and (buf[pos] == '/') and (buf[pos + 1] == '/'): - tok.literal = tok.literal & "\n" - else: - break - L.bufpos = pos - -proc scanCurlyComment(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - tok.literal = "#" - tok.xkind = pxComment - while true: - case buf[pos] - of CR, LF: - pos = HandleCRLF(L, pos) - buf = L.buf - add(tok.literal, "\n#") - of '}': - inc(pos) - break - of nimlexbase.EndOfFile: lexMessage(L, errTokenExpected, "}") - else: - add(tok.literal, buf[pos]) - inc(pos) - L.bufpos = pos - -proc scanStarComment(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - tok.literal = "#" - tok.xkind = pxComment - while true: - case buf[pos] - of CR, LF: - pos = HandleCRLF(L, pos) - buf = L.buf - add(tok.literal, "\n#") - of '*': - inc(pos) - if buf[pos] == ')': - inc(pos) - break - else: - add(tok.literal, '*') - of nimlexbase.EndOfFile: - lexMessage(L, errTokenExpected, "*)") - else: - add(tok.literal, buf[pos]) - inc(pos) - L.bufpos = pos - -proc skip(L: var TLexer, tok: var TToken) = - var pos = L.bufpos - var buf = L.buf - while true: - case buf[pos] - of ' ', Tabulator: - Inc(pos) # newline is special: - of CR, LF: - pos = HandleCRLF(L, pos) - buf = L.buf - else: - break # EndOfFile also leaves the loop - L.bufpos = pos - -proc getTok(L: var TLexer, tok: var TToken) = - tok.xkind = pxInvalid - fillToken(tok) - skip(L, tok) - var c = L.buf[L.bufpos] - if c in SymStartChars: - getSymbol(L, tok) - elif c in {'0'..'9'}: - getNumber10(L, tok) - else: - case c - of ';': - tok.xkind = pxSemicolon - Inc(L.bufpos) - of '/': - if L.buf[L.bufpos + 1] == '/': - scanLineComment(L, tok) - else: - tok.xkind = pxSlash - inc(L.bufpos) - of ',': - tok.xkind = pxComma - Inc(L.bufpos) - of '(': - Inc(L.bufpos) - if (L.buf[L.bufPos] == '*'): - if (L.buf[L.bufPos + 1] == '$'): - Inc(L.bufpos, 2) - skip(L, tok) - getSymbol(L, tok) - tok.xkind = pxStarDirLe - else: - inc(L.bufpos) - scanStarComment(L, tok) - else: - tok.xkind = pxParLe - of '*': - inc(L.bufpos) - if L.buf[L.bufpos] == ')': - inc(L.bufpos) - tok.xkind = pxStarDirRi - else: - tok.xkind = pxStar - of ')': - tok.xkind = pxParRi - Inc(L.bufpos) - of '[': - Inc(L.bufpos) - tok.xkind = pxBracketLe - of ']': - Inc(L.bufpos) - tok.xkind = pxBracketRi - of '.': - inc(L.bufpos) - if L.buf[L.bufpos] == '.': - tok.xkind = pxDotDot - inc(L.bufpos) - else: - tok.xkind = pxDot - of '{': - Inc(L.bufpos) - case L.buf[L.bufpos] - of '$': - Inc(L.bufpos) - skip(L, tok) - getSymbol(L, tok) - tok.xkind = pxCurlyDirLe - of '&': - Inc(L.bufpos) - tok.xkind = pxAmp - of '%': - Inc(L.bufpos) - tok.xkind = pxPer - of '@': - Inc(L.bufpos) - tok.xkind = pxCommand - else: scanCurlyComment(L, tok) - of '+': - tok.xkind = pxPlus - inc(L.bufpos) - of '-': - tok.xkind = pxMinus - inc(L.bufpos) - of ':': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxAsgn - else: - tok.xkind = pxColon - of '<': - inc(L.bufpos) - if L.buf[L.bufpos] == '>': - inc(L.bufpos) - tok.xkind = pxNeq - elif L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxLe - else: - tok.xkind = pxLt - of '>': - inc(L.bufpos) - if L.buf[L.bufpos] == '=': - inc(L.bufpos) - tok.xkind = pxGe - else: - tok.xkind = pxGt - of '=': - tok.xkind = pxEquals - inc(L.bufpos) - of '@': - tok.xkind = pxAt - inc(L.bufpos) - of '^': - tok.xkind = pxHat - inc(L.bufpos) - of '}': - tok.xkind = pxCurlyDirRi - Inc(L.bufpos) - of '\'', '#': - getString(L, tok) - of '$': - getNumber16(L, tok) - of '%': - getNumber2(L, tok) - of nimlexbase.EndOfFile: - tok.xkind = pxEof - else: - tok.literal = c & "" - tok.xkind = pxInvalid - lexMessage(L, errInvalidToken, c & " (\\" & $(ord(c)) & ')') - Inc(L.bufpos) diff --git a/compiler/pas2nim/pasparse.nim b/compiler/pas2nim/pasparse.nim deleted file mode 100644 index 61d57dec3..000000000 --- a/compiler/pas2nim/pasparse.nim +++ /dev/null @@ -1,1513 +0,0 @@ -# -# -# Pas2nim - Pascal to Nimrod source converter -# (c) Copyright 2012 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module implements the parser of the Pascal variant Nimrod is written in. -# It transfers a Pascal module into a Nimrod AST. Then the renderer can be -# used to convert the AST to its text representation. - -import - os, llstream, paslex, idents, strutils, ast, astalgo, msgs, options - -type - TSection = enum - seImplementation, seInterface - TContext = enum - conExpr, conStmt, conTypeDesc - TParserFlag* = enum - pfRefs, ## use "ref" instead of "ptr" for Pascal's ^typ - pfMoreReplacements, ## use more than the default replacements - pfImportBlackList ## use import blacklist - TParser*{.final.} = object - section: TSection - inParamList: bool - context: TContext # needed for the @emit command - lastVarSection: PNode - lex: TLexer - tok: TToken - repl: TIdTable # replacements - flags: set[TParserFlag] - - TReplaceTuple* = array[0..1, string] - -const - ImportBlackList*: array[1..3, string] = ["nsystem", "sysutils", "charsets"] - stdReplacements*: array[1..19, TReplaceTuple] = [["include", "incl"], - ["exclude", "excl"], ["pchar", "cstring"], ["assignfile", "open"], - ["integer", "int"], ["longword", "int32"], ["cardinal", "int"], - ["boolean", "bool"], ["shortint", "int8"], ["smallint", "int16"], - ["longint", "int32"], ["byte", "int8"], ["word", "int16"], - ["single", "float32"], ["double", "float64"], ["real", "float"], - ["length", "len"], ["len", "length"], ["setlength", "setlen"]] - nimReplacements*: array[1..35, TReplaceTuple] = [["nimread", "read"], - ["nimwrite", "write"], ["nimclosefile", "close"], ["closefile", "close"], - ["openfile", "open"], ["nsystem", "system"], ["ntime", "times"], - ["nos", "os"], ["nmath", "math"], ["ncopy", "copy"], ["addChar", "add"], - ["halt", "quit"], ["nobject", "TObject"], ["eof", "EndOfFile"], - ["input", "stdin"], ["output", "stdout"], ["addu", "`+%`"], - ["subu", "`-%`"], ["mulu", "`*%`"], ["divu", "`/%`"], ["modu", "`%%`"], - ["ltu", "`<%`"], ["leu", "`<=%`"], ["shlu", "`shl`"], ["shru", "`shr`"], - ["assigned", "not isNil"], ["eintoverflow", "EOverflow"], ["format", "`%`"], - ["snil", "nil"], ["tostringf", "$"], ["ttextfile", "tfile"], - ["tbinaryfile", "tfile"], ["strstart", "0"], ["nl", "\"\\n\""], - ["tostring", "$"]] - -proc ParseUnit*(p: var TParser): PNode -proc openParser*(p: var TParser, filename: string, inputStream: PLLStream, - flags: set[TParserFlag] = {}) -proc closeParser*(p: var TParser) -proc exSymbol*(n: var PNode) -proc fixRecordDef*(n: var PNode) - # XXX: move these two to an auxiliary module - -# implementation - -proc OpenParser(p: var TParser, filename: string, - inputStream: PLLStream, flags: set[TParserFlag] = {}) = - OpenLexer(p.lex, filename, inputStream) - initIdTable(p.repl) - for i in countup(low(stdReplacements), high(stdReplacements)): - IdTablePut(p.repl, getIdent(stdReplacements[i][0]), - getIdent(stdReplacements[i][1])) - if pfMoreReplacements in flags: - for i in countup(low(nimReplacements), high(nimReplacements)): - IdTablePut(p.repl, getIdent(nimReplacements[i][0]), - getIdent(nimReplacements[i][1])) - p.flags = flags - -proc CloseParser(p: var TParser) = CloseLexer(p.lex) -proc getTok(p: var TParser) = getTok(p.lex, p.tok) - -proc parMessage(p: TParser, msg: TMsgKind, arg = "") = - lexMessage(p.lex, msg, arg) - -proc parLineInfo(p: TParser): TLineInfo = - result = getLineInfo(p.lex) - -proc skipCom(p: var TParser, n: PNode) = - while p.tok.xkind == pxComment: - if (n != nil): - if n.comment == nil: n.comment = p.tok.literal - else: add(n.comment, "\n" & p.tok.literal) - else: - parMessage(p, warnCommentXIgnored, p.tok.literal) - getTok(p) - -proc ExpectIdent(p: TParser) = - if p.tok.xkind != pxSymbol: - lexMessage(p.lex, errIdentifierExpected, $(p.tok)) - -proc Eat(p: var TParser, xkind: TTokKind) = - if p.tok.xkind == xkind: getTok(p) - else: lexMessage(p.lex, errTokenExpected, TokKindToStr(xkind)) - -proc Opt(p: var TParser, xkind: TTokKind) = - if p.tok.xkind == xkind: getTok(p) - -proc newNodeP(kind: TNodeKind, p: TParser): PNode = - result = newNodeI(kind, getLineInfo(p.lex)) - -proc newIntNodeP(kind: TNodeKind, intVal: BiggestInt, p: TParser): PNode = - result = newNodeP(kind, p) - result.intVal = intVal - -proc newFloatNodeP(kind: TNodeKind, floatVal: BiggestFloat, - p: TParser): PNode = - result = newNodeP(kind, p) - result.floatVal = floatVal - -proc newStrNodeP(kind: TNodeKind, strVal: string, p: TParser): PNode = - result = newNodeP(kind, p) - result.strVal = strVal - -proc newIdentNodeP(ident: PIdent, p: TParser): PNode = - result = newNodeP(nkIdent, p) - result.ident = ident - -proc createIdentNodeP(ident: PIdent, p: TParser): PNode = - result = newNodeP(nkIdent, p) - var x = PIdent(IdTableGet(p.repl, ident)) - if x != nil: result.ident = x - else: result.ident = ident - -proc parseExpr(p: var TParser): PNode -proc parseStmt(p: var TParser): PNode -proc parseTypeDesc(p: var TParser, definition: PNode = nil): PNode - -proc parseEmit(p: var TParser, definition: PNode): PNode = - getTok(p) # skip 'emit' - result = ast.emptyNode - if p.tok.xkind != pxCurlyDirRi: - case p.context - of conExpr: - result = parseExpr(p) - of conStmt: - result = parseStmt(p) - if p.tok.xkind != pxCurlyDirRi: - var a = result - result = newNodeP(nkStmtList, p) - addSon(result, a) - while p.tok.xkind != pxCurlyDirRi: - addSon(result, parseStmt(p)) - of conTypeDesc: - result = parseTypeDesc(p, definition) - eat(p, pxCurlyDirRi) - -proc parseCommand(p: var TParser, definition: PNode = nil): PNode = - result = ast.emptyNode - getTok(p) - if p.tok.ident.id == getIdent("discard").id: - result = newNodeP(nkDiscardStmt, p) - getTok(p) - eat(p, pxCurlyDirRi) - addSon(result, parseExpr(p)) - elif p.tok.ident.id == getIdent("set").id: - getTok(p) - eat(p, pxCurlyDirRi) - result = parseExpr(p) - if result.kind == nkEmpty: InternalError("emptyNode modified") - result.kind = nkCurly - elif p.tok.ident.id == getIdent("cast").id: - getTok(p) - eat(p, pxCurlyDirRi) - var a = parseExpr(p) - if (a.kind == nkCall) and (sonsLen(a) == 2): - result = newNodeP(nkCast, p) - addSon(result, a.sons[0]) - addSon(result, a.sons[1]) - else: - parMessage(p, errInvalidDirectiveX, $p.tok) - result = a - elif p.tok.ident.id == getIdent("emit").id: - result = parseEmit(p, definition) - elif p.tok.ident.id == getIdent("ignore").id: - getTok(p) - eat(p, pxCurlyDirRi) - while true: - case p.tok.xkind - of pxEof: - parMessage(p, errTokenExpected, "{@emit}") - of pxCommand: - getTok(p) - if p.tok.ident.id == getIdent("emit").id: - result = parseEmit(p, definition) - break - else: - while (p.tok.xkind != pxCurlyDirRi) and (p.tok.xkind != pxEof): - getTok(p) - eat(p, pxCurlyDirRi) - else: - getTok(p) # skip token - elif p.tok.ident.id == getIdent("ptr").id: - result = newNodeP(nkPtrTy, p) - getTok(p) - eat(p, pxCurlyDirRi) - elif p.tok.ident.id == getIdent("tuple").id: - result = newNodeP(nkTupleTy, p) - getTok(p) - eat(p, pxCurlyDirRi) - elif p.tok.ident.id == getIdent("acyclic").id: - result = newIdentNodeP(p.tok.ident, p) - getTok(p) - eat(p, pxCurlyDirRi) - else: - parMessage(p, errInvalidDirectiveX, $p.tok) - while true: - getTok(p) - if p.tok.xkind == pxCurlyDirRi or p.tok.xkind == pxEof: break - eat(p, pxCurlyDirRi) - result = ast.emptyNode - -proc getPrecedence(kind: TTokKind): int = - case kind - of pxDiv, pxMod, pxStar, pxSlash, pxShl, pxShr, pxAnd: result = 5 - of pxPlus, pxMinus, pxOr, pxXor: result = 4 - of pxIn, pxEquals, pxLe, pxLt, pxGe, pxGt, pxNeq, pxIs: result = 3 - else: result = -1 - -proc rangeExpr(p: var TParser): PNode = - var a = parseExpr(p) - if p.tok.xkind == pxDotDot: - result = newNodeP(nkRange, p) - addSon(result, a) - getTok(p) - skipCom(p, result) - addSon(result, parseExpr(p)) - else: - result = a - -proc bracketExprList(p: var TParser, first: PNode): PNode = - result = newNodeP(nkBracketExpr, p) - addSon(result, first) - getTok(p) - skipCom(p, result) - while true: - if p.tok.xkind == pxBracketRi: - getTok(p) - break - if p.tok.xkind == pxEof: - parMessage(p, errTokenExpected, TokKindToStr(pxBracketRi)) - break - var a = rangeExpr(p) - skipCom(p, a) - if p.tok.xkind == pxComma: - getTok(p) - skipCom(p, a) - addSon(result, a) - -proc exprColonEqExpr(p: var TParser, kind: TNodeKind, - tok: TTokKind): PNode = - var a = parseExpr(p) - if p.tok.xkind == tok: - result = newNodeP(kind, p) - getTok(p) - skipCom(p, result) - addSon(result, a) - addSon(result, parseExpr(p)) - else: - result = a - -proc exprListAux(p: var TParser, elemKind: TNodeKind, - endTok, sepTok: TTokKind, result: PNode) = - getTok(p) - skipCom(p, result) - while true: - if p.tok.xkind == endTok: - getTok(p) - break - if p.tok.xkind == pxEof: - parMessage(p, errTokenExpected, TokKindToStr(endtok)) - break - var a = exprColonEqExpr(p, elemKind, sepTok) - skipCom(p, a) - if (p.tok.xkind == pxComma) or (p.tok.xkind == pxSemicolon): - getTok(p) - skipCom(p, a) - addSon(result, a) - -proc qualifiedIdent(p: var TParser): PNode = - if p.tok.xkind == pxSymbol: - result = createIdentNodeP(p.tok.ident, p) - else: - parMessage(p, errIdentifierExpected, $p.tok) - return ast.emptyNode - getTok(p) - skipCom(p, result) - if p.tok.xkind == pxDot: - getTok(p) - skipCom(p, result) - if p.tok.xkind == pxSymbol: - var a = result - result = newNodeI(nkDotExpr, a.info) - addSon(result, a) - addSon(result, createIdentNodeP(p.tok.ident, p)) - getTok(p) - else: - parMessage(p, errIdentifierExpected, $p.tok) - -proc qualifiedIdentListAux(p: var TParser, endTok: TTokKind, - result: PNode) = - getTok(p) - skipCom(p, result) - while true: - if p.tok.xkind == endTok: - getTok(p) - break - if p.tok.xkind == pxEof: - parMessage(p, errTokenExpected, TokKindToStr(endtok)) - break - var a = qualifiedIdent(p) - skipCom(p, a) - if p.tok.xkind == pxComma: - getTok(p) - skipCom(p, a) - addSon(result, a) - -proc exprColonEqExprList(p: var TParser, kind, elemKind: TNodeKind, - endTok, sepTok: TTokKind): PNode = - result = newNodeP(kind, p) - exprListAux(p, elemKind, endTok, sepTok, result) - -proc setBaseFlags(n: PNode, base: TNumericalBase) = - case base - of base10: nil - of base2: incl(n.flags, nfBase2) - of base8: incl(n.flags, nfBase8) - of base16: incl(n.flags, nfBase16) - -proc identOrLiteral(p: var TParser): PNode = - case p.tok.xkind - of pxSymbol: - result = createIdentNodeP(p.tok.ident, p) - getTok(p) - of pxIntLit: - result = newIntNodeP(nkIntLit, p.tok.iNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of pxInt64Lit: - result = newIntNodeP(nkInt64Lit, p.tok.iNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of pxFloatLit: - result = newFloatNodeP(nkFloatLit, p.tok.fNumber, p) - setBaseFlags(result, p.tok.base) - getTok(p) - of pxStrLit: - if len(p.tok.literal) != 1: result = newStrNodeP(nkStrLit, p.tok.literal, p) - else: result = newIntNodeP(nkCharLit, ord(p.tok.literal[0]), p) - getTok(p) - of pxNil: - result = newNodeP(nkNilLit, p) - getTok(p) - of pxParLe: - # () constructor - result = exprColonEqExprList(p, nkPar, nkExprColonExpr, pxParRi, pxColon) - #if hasSonWith(result, nkExprColonExpr) then - # replaceSons(result, nkExprColonExpr, nkExprEqExpr) - if (sonsLen(result) > 1) and not hasSonWith(result, nkExprColonExpr): - result.kind = nkBracket # is an array constructor - of pxBracketLe: - # [] constructor - result = newNodeP(nkBracket, p) - getTok(p) - skipCom(p, result) - while (p.tok.xkind != pxBracketRi) and (p.tok.xkind != pxEof): - var a = rangeExpr(p) - if a.kind == nkRange: - result.kind = nkCurly # it is definitely a set literal - opt(p, pxComma) - skipCom(p, a) - assert(a != nil) - addSon(result, a) - eat(p, pxBracketRi) - of pxCommand: - result = parseCommand(p) - else: - parMessage(p, errExprExpected, $(p.tok)) - getTok(p) # we must consume a token here to prevend endless loops! - result = ast.emptyNode - if result.kind != nkEmpty: skipCom(p, result) - -proc primary(p: var TParser): PNode = - # prefix operator? - if (p.tok.xkind == pxNot) or (p.tok.xkind == pxMinus) or - (p.tok.xkind == pxPlus): - result = newNodeP(nkPrefix, p) - var a = newIdentNodeP(getIdent($p.tok), p) - addSon(result, a) - getTok(p) - skipCom(p, a) - addSon(result, primary(p)) - return - elif p.tok.xkind == pxAt: - result = newNodeP(nkAddr, p) - var a = newIdentNodeP(getIdent($p.tok), p) - getTok(p) - if p.tok.xkind == pxBracketLe: - result = newNodeP(nkPrefix, p) - addSon(result, a) - addSon(result, identOrLiteral(p)) - else: - addSon(result, primary(p)) - return - result = identOrLiteral(p) - while true: - case p.tok.xkind - of pxParLe: - var a = result - result = newNodeP(nkCall, p) - addSon(result, a) - exprListAux(p, nkExprEqExpr, pxParRi, pxEquals, result) - of pxDot: - var a = result - result = newNodeP(nkDotExpr, p) - addSon(result, a) - getTok(p) # skip '.' - skipCom(p, result) - if p.tok.xkind == pxSymbol: - addSon(result, createIdentNodeP(p.tok.ident, p)) - getTok(p) - else: - parMessage(p, errIdentifierExpected, $p.tok) - of pxHat: - var a = result - result = newNodeP(nkBracketExpr, p) - addSon(result, a) - getTok(p) - of pxBracketLe: - result = bracketExprList(p, result) - else: break - -proc lowestExprAux(p: var TParser, v: var PNode, limit: int): TTokKind = - var - nextop: TTokKind - v2, node, opNode: PNode - v = primary(p) # expand while operators have priorities higher than 'limit' - var op = p.tok.xkind - var opPred = getPrecedence(op) - while (opPred > limit): - node = newNodeP(nkInfix, p) - opNode = newIdentNodeP(getIdent($(p.tok)), p) # skip operator: - getTok(p) - case op - of pxPlus: - case p.tok.xkind - of pxPer: - getTok(p) - eat(p, pxCurlyDirRi) - opNode.ident = getIdent("+%") - of pxAmp: - getTok(p) - eat(p, pxCurlyDirRi) - opNode.ident = getIdent("&") - else: - nil - of pxMinus: - if p.tok.xkind == pxPer: - getTok(p) - eat(p, pxCurlyDirRi) - opNode.ident = getIdent("-%") - of pxEquals: - opNode.ident = getIdent("==") - of pxNeq: - opNode.ident = getIdent("!=") - else: - nil - skipCom(p, opNode) # read sub-expression with higher priority - nextop = lowestExprAux(p, v2, opPred) - addSon(node, opNode) - addSon(node, v) - addSon(node, v2) - v = node - op = nextop - opPred = getPrecedence(nextop) - result = op # return first untreated operator - -proc fixExpr(n: PNode): PNode = - result = n - case n.kind - of nkInfix: - if n.sons[1].kind == nkBracket: n.sons[1].kind = nkCurly - if n.sons[2].kind == nkBracket: n.sons[2].kind = nkCurly - if (n.sons[0].kind == nkIdent): - if (n.sons[0].ident.id == getIdent("+").id): - if (n.sons[1].kind == nkCharLit) and (n.sons[2].kind == nkStrLit) and - (n.sons[2].strVal == ""): - result = newStrNode(nkStrLit, chr(int(n.sons[1].intVal)) & "") - result.info = n.info - return # do not process sons as they don't exist anymore - elif (n.sons[1].kind in {nkCharLit, nkStrLit}) or - (n.sons[2].kind in {nkCharLit, nkStrLit}): - n.sons[0].ident = getIdent("&") # fix operator - else: - nil - if not (n.kind in {nkEmpty..nkNilLit}): - for i in countup(0, sonsLen(n) - 1): result.sons[i] = fixExpr(n.sons[i]) - -proc parseExpr(p: var TParser): PNode = - var oldcontext = p.context - p.context = conExpr - if p.tok.xkind == pxCommand: - result = parseCommand(p) - else: - discard lowestExprAux(p, result, - 1) - result = fixExpr(result) - p.context = oldcontext - -proc parseExprStmt(p: var TParser): PNode = - var info = parLineInfo(p) - var a = parseExpr(p) - if p.tok.xkind == pxAsgn: - getTok(p) - skipCom(p, a) - var b = parseExpr(p) - result = newNodeI(nkAsgn, info) - addSon(result, a) - addSon(result, b) - else: - result = a - -proc inImportBlackList(ident: PIdent): bool = - for i in countup(low(ImportBlackList), high(ImportBlackList)): - if ident.id == getIdent(ImportBlackList[i]).id: - return true - -proc parseUsesStmt(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkImportStmt, p) - getTok(p) # skip `import` - skipCom(p, result) - while true: - case p.tok.xkind - of pxEof: break - of pxSymbol: a = newIdentNodeP(p.tok.ident, p) - else: - parMessage(p, errIdentifierExpected, $(p.tok)) - break - getTok(p) # skip identifier, string - skipCom(p, a) - if pfImportBlackList notin p.flags or not inImportBlackList(a.ident): - addSon(result, createIdentNodeP(a.ident, p)) - if p.tok.xkind == pxComma: - getTok(p) - skipCom(p, a) - else: - break - if sonsLen(result) == 0: result = ast.emptyNode - -proc parseIncludeDir(p: var TParser): PNode = - result = newNodeP(nkIncludeStmt, p) - getTok(p) # skip `include` - var filename = "" - while true: - case p.tok.xkind - of pxSymbol, pxDot, pxDotDot, pxSlash: - add(filename, $p.tok) - getTok(p) - of pxStrLit: - filename = p.tok.literal - getTok(p) - break - of pxCurlyDirRi: - break - else: - parMessage(p, errIdentifierExpected, $p.tok) - break - addSon(result, newStrNodeP(nkStrLit, changeFileExt(filename, "nim"), p)) - if filename == "config.inc": result = ast.emptyNode - -proc definedExprAux(p: var TParser): PNode = - result = newNodeP(nkCall, p) - addSon(result, newIdentNodeP(getIdent("defined"), p)) - ExpectIdent(p) - addSon(result, createIdentNodeP(p.tok.ident, p)) - getTok(p) - -proc isHandledDirective(p: TParser): bool = - if p.tok.xkind in {pxCurlyDirLe, pxStarDirLe}: - case toLower(p.tok.ident.s) - of "else", "endif": result = false - else: result = true - -proc parseStmtList(p: var TParser): PNode = - result = newNodeP(nkStmtList, p) - while true: - case p.tok.xkind - of pxEof: - break - of pxCurlyDirLe, pxStarDirLe: - if not isHandledDirective(p): break - else: - nil - addSon(result, parseStmt(p)) - if sonsLen(result) == 1: result = result.sons[0] - -proc parseIfDirAux(p: var TParser, result: PNode) = - addSon(result.sons[0], parseStmtList(p)) - if p.tok.xkind in {pxCurlyDirLe, pxStarDirLe}: - var endMarker = succ(p.tok.xkind) - if toLower(p.tok.ident.s) == "else": - var s = newNodeP(nkElse, p) - while p.tok.xkind != pxEof and p.tok.xkind != endMarker: getTok(p) - eat(p, endMarker) - addSon(s, parseStmtList(p)) - addSon(result, s) - if p.tok.xkind in {pxCurlyDirLe, pxStarDirLe}: - endMarker = succ(p.tok.xkind) - if toLower(p.tok.ident.s) == "endif": - while p.tok.xkind != pxEof and p.tok.xkind != endMarker: getTok(p) - eat(p, endMarker) - else: - parMessage(p, errXExpected, "{$endif}") - else: - parMessage(p, errXExpected, "{$endif}") - -proc parseIfdefDir(p: var TParser, endMarker: TTokKind): PNode = - result = newNodeP(nkWhenStmt, p) - addSon(result, newNodeP(nkElifBranch, p)) - getTok(p) - addSon(result.sons[0], definedExprAux(p)) - eat(p, endMarker) - parseIfDirAux(p, result) - -proc parseIfndefDir(p: var TParser, endMarker: TTokKind): PNode = - result = newNodeP(nkWhenStmt, p) - addSon(result, newNodeP(nkElifBranch, p)) - getTok(p) - var e = newNodeP(nkCall, p) - addSon(e, newIdentNodeP(getIdent("not"), p)) - addSon(e, definedExprAux(p)) - eat(p, endMarker) - addSon(result.sons[0], e) - parseIfDirAux(p, result) - -proc parseIfDir(p: var TParser, endMarker: TTokKind): PNode = - result = newNodeP(nkWhenStmt, p) - addSon(result, newNodeP(nkElifBranch, p)) - getTok(p) - addSon(result.sons[0], parseExpr(p)) - eat(p, endMarker) - parseIfDirAux(p, result) - -proc parseDirective(p: var TParser): PNode = - result = ast.emptyNode - if not (p.tok.xkind in {pxCurlyDirLe, pxStarDirLe}): return - var endMarker = succ(p.tok.xkind) - if p.tok.ident != nil: - case toLower(p.tok.ident.s) - of "include": - result = parseIncludeDir(p) - eat(p, endMarker) - of "if": result = parseIfDir(p, endMarker) - of "ifdef": result = parseIfdefDir(p, endMarker) - of "ifndef": result = parseIfndefDir(p, endMarker) - else: - # skip unknown compiler directive - while p.tok.xkind != pxEof and p.tok.xkind != endMarker: getTok(p) - eat(p, endMarker) - else: - eat(p, endMarker) - -proc parseRaise(p: var TParser): PNode = - result = newNodeP(nkRaiseStmt, p) - getTok(p) - skipCom(p, result) - if p.tok.xkind != pxSemicolon: addSon(result, parseExpr(p)) - else: addSon(result, ast.emptyNode) - -proc parseIf(p: var TParser): PNode = - result = newNodeP(nkIfStmt, p) - while true: - getTok(p) # skip ``if`` - var branch = newNodeP(nkElifBranch, p) - skipCom(p, branch) - addSon(branch, parseExpr(p)) - eat(p, pxThen) - skipCom(p, branch) - addSon(branch, parseStmt(p)) - skipCom(p, branch) - addSon(result, branch) - if p.tok.xkind == pxElse: - getTok(p) - if p.tok.xkind != pxIf: - # ordinary else part: - branch = newNodeP(nkElse, p) - skipCom(p, result) # BUGFIX - addSon(branch, parseStmt(p)) - addSon(result, branch) - break - else: - break - -proc parseWhile(p: var TParser): PNode = - result = newNodeP(nkWhileStmt, p) - getTok(p) - skipCom(p, result) - addSon(result, parseExpr(p)) - eat(p, pxDo) - skipCom(p, result) - addSon(result, parseStmt(p)) - -proc parseRepeat(p: var TParser): PNode = - result = newNodeP(nkWhileStmt, p) - getTok(p) - skipCom(p, result) - addSon(result, newIdentNodeP(getIdent("true"), p)) - var s = newNodeP(nkStmtList, p) - while p.tok.xkind != pxEof and p.tok.xkind != pxUntil: - addSon(s, parseStmt(p)) - eat(p, pxUntil) - var a = newNodeP(nkIfStmt, p) - skipCom(p, a) - var b = newNodeP(nkElifBranch, p) - var c = newNodeP(nkBreakStmt, p) - addSon(c, ast.emptyNode) - addSon(b, parseExpr(p)) - skipCom(p, a) - addSon(b, c) - addSon(a, b) - if b.sons[0].kind == nkIdent and b.sons[0].ident.id == getIdent("false").id: - nil - else: - addSon(s, a) - addSon(result, s) - -proc parseCase(p: var TParser): PNode = - var b: PNode - result = newNodeP(nkCaseStmt, p) - getTok(p) - addSon(result, parseExpr(p)) - eat(p, pxOf) - skipCom(p, result) - while (p.tok.xkind != pxEnd) and (p.tok.xkind != pxEof): - if p.tok.xkind == pxElse: - b = newNodeP(nkElse, p) - getTok(p) - else: - b = newNodeP(nkOfBranch, p) - while (p.tok.xkind != pxEof) and (p.tok.xkind != pxColon): - addSon(b, rangeExpr(p)) - opt(p, pxComma) - skipcom(p, b) - eat(p, pxColon) - skipCom(p, b) - addSon(b, parseStmt(p)) - addSon(result, b) - if b.kind == nkElse: break - eat(p, pxEnd) - -proc parseTry(p: var TParser): PNode = - result = newNodeP(nkTryStmt, p) - getTok(p) - skipCom(p, result) - var b = newNodeP(nkStmtList, p) - while not (p.tok.xkind in {pxFinally, pxExcept, pxEof, pxEnd}): - addSon(b, parseStmt(p)) - addSon(result, b) - if p.tok.xkind == pxExcept: - getTok(p) - while p.tok.ident.id == getIdent("on").id: - b = newNodeP(nkExceptBranch, p) - getTok(p) - var e = qualifiedIdent(p) - if p.tok.xkind == pxColon: - getTok(p) - e = qualifiedIdent(p) - addSon(b, e) - eat(p, pxDo) - addSon(b, parseStmt(p)) - addSon(result, b) - if p.tok.xkind == pxCommand: discard parseCommand(p) - if p.tok.xkind == pxElse: - b = newNodeP(nkExceptBranch, p) - getTok(p) - addSon(b, parseStmt(p)) - addSon(result, b) - if p.tok.xkind == pxFinally: - b = newNodeP(nkFinally, p) - getTok(p) - var e = newNodeP(nkStmtList, p) - while (p.tok.xkind != pxEof) and (p.tok.xkind != pxEnd): - addSon(e, parseStmt(p)) - if sonsLen(e) == 0: addSon(e, newNodeP(nkNilLit, p)) - addSon(result, e) - eat(p, pxEnd) - -proc parseFor(p: var TParser): PNode = - result = newNodeP(nkForStmt, p) - getTok(p) - skipCom(p, result) - expectIdent(p) - addSon(result, createIdentNodeP(p.tok.ident, p)) - getTok(p) - eat(p, pxAsgn) - var a = parseExpr(p) - var b = ast.emptyNode - var c = newNodeP(nkCall, p) - if p.tok.xkind == pxTo: - addSon(c, newIdentNodeP(getIdent("countup"), p)) - getTok(p) - b = parseExpr(p) - elif p.tok.xkind == pxDownto: - addSon(c, newIdentNodeP(getIdent("countdown"), p)) - getTok(p) - b = parseExpr(p) - else: - parMessage(p, errTokenExpected, TokKindToStr(pxTo)) - addSon(c, a) - addSon(c, b) - eat(p, pxDo) - skipCom(p, result) - addSon(result, c) - addSon(result, parseStmt(p)) - -proc parseParam(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkIdentDefs, p) - var v = ast.emptyNode - case p.tok.xkind - of pxConst: - getTok(p) - of pxVar: - getTok(p) - v = newNodeP(nkVarTy, p) - of pxOut: - getTok(p) - v = newNodeP(nkVarTy, p) - else: - nil - while true: - case p.tok.xkind - of pxSymbol: a = createIdentNodeP(p.tok.ident, p) - of pxColon, pxEof, pxParRi, pxEquals: break - else: - parMessage(p, errIdentifierExpected, $p.tok) - return - getTok(p) # skip identifier - skipCom(p, a) - if p.tok.xkind == pxComma: - getTok(p) - skipCom(p, a) - addSon(result, a) - if p.tok.xkind == pxColon: - getTok(p) - skipCom(p, result) - if v.kind != nkEmpty: addSon(v, parseTypeDesc(p)) - else: v = parseTypeDesc(p) - addSon(result, v) - else: - addSon(result, ast.emptyNode) - if p.tok.xkind != pxEquals: - parMessage(p, errColonOrEqualsExpected, $p.tok) - if p.tok.xkind == pxEquals: - getTok(p) - skipCom(p, result) - addSon(result, parseExpr(p)) - else: - addSon(result, ast.emptyNode) - -proc parseParamList(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkFormalParams, p) - addSon(result, ast.emptyNode) # return type - if p.tok.xkind == pxParLe: - p.inParamList = true - getTok(p) - skipCom(p, result) - while true: - case p.tok.xkind - of pxSymbol, pxConst, pxVar, pxOut: - a = parseParam(p) - of pxParRi: - getTok(p) - break - else: - parMessage(p, errTokenExpected, ")") - break - skipCom(p, a) - if p.tok.xkind == pxSemicolon: - getTok(p) - skipCom(p, a) - addSon(result, a) - p.inParamList = false - if p.tok.xkind == pxColon: - getTok(p) - skipCom(p, result) - result.sons[0] = parseTypeDesc(p) - -proc parseCallingConvention(p: var TParser): PNode = - result = ast.emptyNode - if p.tok.xkind == pxSymbol: - case toLower(p.tok.ident.s) - of "stdcall", "cdecl", "safecall", "syscall", "inline", "fastcall": - result = newNodeP(nkPragma, p) - addSon(result, newIdentNodeP(p.tok.ident, p)) - getTok(p) - opt(p, pxSemicolon) - of "register": - result = newNodeP(nkPragma, p) - addSon(result, newIdentNodeP(getIdent("fastcall"), p)) - getTok(p) - opt(p, pxSemicolon) - else: - nil - -proc parseRoutineSpecifiers(p: var TParser, noBody: var bool): PNode = - var e: PNode - result = parseCallingConvention(p) - noBody = false - while p.tok.xkind == pxSymbol: - case toLower(p.tok.ident.s) - of "assembler", "overload", "far": - getTok(p) - opt(p, pxSemicolon) - of "forward": - noBody = true - getTok(p) - opt(p, pxSemicolon) - of "importc": - # This is a fake for platform module. There is no ``importc`` - # directive in Pascal. - if result.kind == nkEmpty: result = newNodeP(nkPragma, p) - addSon(result, newIdentNodeP(getIdent("importc"), p)) - noBody = true - getTok(p) - opt(p, pxSemicolon) - of "noconv": - # This is a fake for platform module. There is no ``noconv`` - # directive in Pascal. - if result.kind == nkEmpty: result = newNodeP(nkPragma, p) - addSon(result, newIdentNodeP(getIdent("noconv"), p)) - noBody = true - getTok(p) - opt(p, pxSemicolon) - of "procvar": - # This is a fake for the Nimrod compiler. There is no ``procvar`` - # directive in Pascal. - if result.kind == nkEmpty: result = newNodeP(nkPragma, p) - addSon(result, newIdentNodeP(getIdent("procvar"), p)) - getTok(p) - opt(p, pxSemicolon) - of "varargs": - if result.kind == nkEmpty: result = newNodeP(nkPragma, p) - addSon(result, newIdentNodeP(getIdent("varargs"), p)) - getTok(p) - opt(p, pxSemicolon) - of "external": - if result.kind == nkEmpty: result = newNodeP(nkPragma, p) - getTok(p) - noBody = true - e = newNodeP(nkExprColonExpr, p) - addSon(e, newIdentNodeP(getIdent("dynlib"), p)) - addSon(e, parseExpr(p)) - addSon(result, e) - opt(p, pxSemicolon) - if (p.tok.xkind == pxSymbol) and - (p.tok.ident.id == getIdent("name").id): - e = newNodeP(nkExprColonExpr, p) - getTok(p) - addSon(e, newIdentNodeP(getIdent("importc"), p)) - addSon(e, parseExpr(p)) - addSon(result, e) - else: - addSon(result, newIdentNodeP(getIdent("importc"), p)) - opt(p, pxSemicolon) - else: - e = parseCallingConvention(p) - if e.kind == nkEmpty: break - if result.kind == nkEmpty: result = newNodeP(nkPragma, p) - addSon(result, e.sons[0]) - -proc parseRoutineType(p: var TParser): PNode = - result = newNodeP(nkProcTy, p) - getTok(p) - skipCom(p, result) - addSon(result, parseParamList(p)) - opt(p, pxSemicolon) - addSon(result, parseCallingConvention(p)) - skipCom(p, result) - -proc parseEnum(p: var TParser): PNode = - var a: PNode - result = newNodeP(nkEnumTy, p) - getTok(p) - skipCom(p, result) - addSon(result, ast.emptyNode) # it does not inherit from any enumeration - while true: - case p.tok.xkind - of pxEof, pxParRi: break - of pxSymbol: a = newIdentNodeP(p.tok.ident, p) - else: - parMessage(p, errIdentifierExpected, $(p.tok)) - break - getTok(p) # skip identifier - skipCom(p, a) - if (p.tok.xkind == pxEquals) or (p.tok.xkind == pxAsgn): - getTok(p) - skipCom(p, a) - var b = a - a = newNodeP(nkEnumFieldDef, p) - addSon(a, b) - addSon(a, parseExpr(p)) - if p.tok.xkind == pxComma: - getTok(p) - skipCom(p, a) - addSon(result, a) - eat(p, pxParRi) - -proc identVis(p: var TParser): PNode = - # identifier with visability - var a = createIdentNodeP(p.tok.ident, p) - if p.section == seInterface: - result = newNodeP(nkPostfix, p) - addSon(result, newIdentNodeP(getIdent("*"), p)) - addSon(result, a) - else: - result = a - getTok(p) - -type - TSymbolParser = proc (p: var TParser): PNode {.nimcall.} - -proc rawIdent(p: var TParser): PNode = - result = createIdentNodeP(p.tok.ident, p) - getTok(p) - -proc parseIdentColonEquals(p: var TParser, - identParser: TSymbolParser): PNode = - var a: PNode - result = newNodeP(nkIdentDefs, p) - while true: - case p.tok.xkind - of pxSymbol: a = identParser(p) - of pxColon, pxEof, pxParRi, pxEquals: break - else: - parMessage(p, errIdentifierExpected, $(p.tok)) - return - skipCom(p, a) - if p.tok.xkind == pxComma: - getTok(p) - skipCom(p, a) - addSon(result, a) - if p.tok.xkind == pxColon: - getTok(p) - skipCom(p, result) - addSon(result, parseTypeDesc(p)) - else: - addSon(result, ast.emptyNode) - if p.tok.xkind != pxEquals: - parMessage(p, errColonOrEqualsExpected, $(p.tok)) - if p.tok.xkind == pxEquals: - getTok(p) - skipCom(p, result) - addSon(result, parseExpr(p)) - else: - addSon(result, ast.emptyNode) - if p.tok.xkind == pxSemicolon: - getTok(p) - skipCom(p, result) - -proc parseRecordCase(p: var TParser): PNode = - var b, c: PNode - result = newNodeP(nkRecCase, p) - getTok(p) - var a = newNodeP(nkIdentDefs, p) - addSon(a, rawIdent(p)) - eat(p, pxColon) - addSon(a, parseTypeDesc(p)) - addSon(a, ast.emptyNode) - addSon(result, a) - eat(p, pxOf) - skipCom(p, result) - while true: - case p.tok.xkind - of pxEof, pxEnd: - break - of pxElse: - b = newNodeP(nkElse, p) - getTok(p) - else: - b = newNodeP(nkOfBranch, p) - while (p.tok.xkind != pxEof) and (p.tok.xkind != pxColon): - addSon(b, rangeExpr(p)) - opt(p, pxComma) - skipcom(p, b) - eat(p, pxColon) - skipCom(p, b) - c = newNodeP(nkRecList, p) - eat(p, pxParLe) - while (p.tok.xkind != pxParRi) and (p.tok.xkind != pxEof): - addSon(c, parseIdentColonEquals(p, rawIdent)) - opt(p, pxSemicolon) - skipCom(p, lastSon(c)) - eat(p, pxParRi) - opt(p, pxSemicolon) - if sonsLen(c) > 0: skipCom(p, lastSon(c)) - else: addSon(c, newNodeP(nkNilLit, p)) - addSon(b, c) - addSon(result, b) - if b.kind == nkElse: break - -proc parseRecordPart(p: var TParser): PNode = - result = ast.emptyNode - while (p.tok.xkind != pxEof) and (p.tok.xkind != pxEnd): - if result.kind == nkEmpty: result = newNodeP(nkRecList, p) - case p.tok.xkind - of pxSymbol: - addSon(result, parseIdentColonEquals(p, rawIdent)) - opt(p, pxSemicolon) - skipCom(p, lastSon(result)) - of pxCase: - addSon(result, parseRecordCase(p)) - of pxComment: - skipCom(p, lastSon(result)) - else: - parMessage(p, errIdentifierExpected, $p.tok) - break - -proc exSymbol(n: var PNode) = - case n.kind - of nkPostfix: - nil - of nkPragmaExpr: - exSymbol(n.sons[0]) - of nkIdent, nkAccQuoted: - var a = newNodeI(nkPostFix, n.info) - addSon(a, newIdentNode(getIdent("*"), n.info)) - addSon(a, n) - n = a - else: internalError(n.info, "exSymbol(): " & $n.kind) - -proc fixRecordDef(n: var PNode) = - case n.kind - of nkRecCase: - fixRecordDef(n.sons[0]) - for i in countup(1, sonsLen(n) - 1): - var length = sonsLen(n.sons[i]) - fixRecordDef(n.sons[i].sons[length - 1]) - of nkRecList, nkRecWhen, nkElse, nkOfBranch, nkElifBranch, nkObjectTy: - for i in countup(0, sonsLen(n) - 1): fixRecordDef(n.sons[i]) - of nkIdentDefs: - for i in countup(0, sonsLen(n) - 3): exSymbol(n.sons[i]) - of nkNilLit, nkEmpty: nil - else: internalError(n.info, "fixRecordDef(): " & $n.kind) - -proc addPragmaToIdent(ident: var PNode, pragma: PNode) = - var pragmasNode: PNode - if ident.kind != nkPragmaExpr: - pragmasNode = newNodeI(nkPragma, ident.info) - var e = newNodeI(nkPragmaExpr, ident.info) - addSon(e, ident) - addSon(e, pragmasNode) - ident = e - else: - pragmasNode = ident.sons[1] - if pragmasNode.kind != nkPragma: - InternalError(ident.info, "addPragmaToIdent") - addSon(pragmasNode, pragma) - -proc parseRecordBody(p: var TParser, result, definition: PNode) = - skipCom(p, result) - var a = parseRecordPart(p) - if result.kind != nkTupleTy: fixRecordDef(a) - addSon(result, a) - eat(p, pxEnd) - case p.tok.xkind - of pxSymbol: - if p.tok.ident.id == getIdent("acyclic").id: - if definition != nil: - addPragmaToIdent(definition.sons[0], newIdentNodeP(p.tok.ident, p)) - else: - InternalError(result.info, "anonymous record is not supported") - getTok(p) - else: - InternalError(result.info, "parseRecordBody") - of pxCommand: - if definition != nil: addPragmaToIdent(definition.sons[0], parseCommand(p)) - else: InternalError(result.info, "anonymous record is not supported") - else: - nil - opt(p, pxSemicolon) - skipCom(p, result) - -proc parseRecordOrObject(p: var TParser, kind: TNodeKind, - definition: PNode): PNode = - result = newNodeP(kind, p) - getTok(p) - addSon(result, ast.emptyNode) - if p.tok.xkind == pxParLe: - var a = newNodeP(nkOfInherit, p) - getTok(p) - addSon(a, parseTypeDesc(p)) - addSon(result, a) - eat(p, pxParRi) - else: - addSon(result, ast.emptyNode) - parseRecordBody(p, result, definition) - -proc parseTypeDesc(p: var TParser, definition: PNode = nil): PNode = - var oldcontext = p.context - p.context = conTypeDesc - if p.tok.xkind == pxPacked: getTok(p) - case p.tok.xkind - of pxCommand: - result = parseCommand(p, definition) - of pxProcedure, pxFunction: - result = parseRoutineType(p) - of pxRecord: - getTok(p) - if p.tok.xkind == pxCommand: - result = parseCommand(p) - if result.kind != nkTupleTy: InternalError(result.info, "parseTypeDesc") - parseRecordBody(p, result, definition) - var a = lastSon(result) # embed nkRecList directly into nkTupleTy - for i in countup(0, sonsLen(a) - 1): - if i == 0: result.sons[sonsLen(result) - 1] = a.sons[0] - else: addSon(result, a.sons[i]) - else: - result = newNodeP(nkObjectTy, p) - addSon(result, ast.emptyNode) - addSon(result, ast.emptyNode) - parseRecordBody(p, result, definition) - if definition != nil: - addPragmaToIdent(definition.sons[0], newIdentNodeP(getIdent("final"), p)) - else: - InternalError(result.info, "anonymous record is not supported") - of pxObject: result = parseRecordOrObject(p, nkObjectTy, definition) - of pxParLe: result = parseEnum(p) - of pxArray: - result = newNodeP(nkBracketExpr, p) - getTok(p) - if p.tok.xkind == pxBracketLe: - addSon(result, newIdentNodeP(getIdent("array"), p)) - getTok(p) - addSon(result, rangeExpr(p)) - eat(p, pxBracketRi) - else: - if p.inParamList: addSon(result, newIdentNodeP(getIdent("openarray"), p)) - else: addSon(result, newIdentNodeP(getIdent("seq"), p)) - eat(p, pxOf) - addSon(result, parseTypeDesc(p)) - of pxSet: - result = newNodeP(nkBracketExpr, p) - getTok(p) - eat(p, pxOf) - addSon(result, newIdentNodeP(getIdent("set"), p)) - addSon(result, parseTypeDesc(p)) - of pxHat: - getTok(p) - if p.tok.xkind == pxCommand: result = parseCommand(p) - elif pfRefs in p.flags: result = newNodeP(nkRefTy, p) - else: result = newNodeP(nkPtrTy, p) - addSon(result, parseTypeDesc(p)) - of pxType: - getTok(p) - result = parseTypeDesc(p) - else: - var a = primary(p) - if p.tok.xkind == pxDotDot: - result = newNodeP(nkBracketExpr, p) - var r = newNodeP(nkRange, p) - addSon(result, newIdentNodeP(getIdent("range"), p)) - getTok(p) - addSon(r, a) - addSon(r, parseExpr(p)) - addSon(result, r) - else: - result = a - p.context = oldcontext - -proc parseTypeDef(p: var TParser): PNode = - result = newNodeP(nkTypeDef, p) - addSon(result, identVis(p)) - addSon(result, ast.emptyNode) # generic params - if p.tok.xkind == pxEquals: - getTok(p) - skipCom(p, result) - addSon(result, parseTypeDesc(p, result)) - else: - addSon(result, ast.emptyNode) - if p.tok.xkind == pxSemicolon: - getTok(p) - skipCom(p, result) - -proc parseTypeSection(p: var TParser): PNode = - result = newNodeP(nkTypeSection, p) - getTok(p) - skipCom(p, result) - while p.tok.xkind == pxSymbol: - addSon(result, parseTypeDef(p)) - -proc parseConstant(p: var TParser): PNode = - result = newNodeP(nkConstDef, p) - addSon(result, identVis(p)) - if p.tok.xkind == pxColon: - getTok(p) - skipCom(p, result) - addSon(result, parseTypeDesc(p)) - else: - addSon(result, ast.emptyNode) - if p.tok.xkind != pxEquals: - parMessage(p, errColonOrEqualsExpected, $(p.tok)) - if p.tok.xkind == pxEquals: - getTok(p) - skipCom(p, result) - addSon(result, parseExpr(p)) - else: - addSon(result, ast.emptyNode) - if p.tok.xkind == pxSemicolon: - getTok(p) - skipCom(p, result) - -proc parseConstSection(p: var TParser): PNode = - result = newNodeP(nkConstSection, p) - getTok(p) - skipCom(p, result) - while p.tok.xkind == pxSymbol: - addSon(result, parseConstant(p)) - -proc parseVar(p: var TParser): PNode = - result = newNodeP(nkVarSection, p) - getTok(p) - skipCom(p, result) - while p.tok.xkind == pxSymbol: - addSon(result, parseIdentColonEquals(p, identVis)) - p.lastVarSection = result - -proc parseRoutine(p: var TParser): PNode = - var noBody: bool - result = newNodeP(nkProcDef, p) - getTok(p) - skipCom(p, result) - expectIdent(p) - addSon(result, identVis(p)) - # patterns, generic parameters: - addSon(result, ast.emptyNode) - addSon(result, ast.emptyNode) - addSon(result, parseParamList(p)) - opt(p, pxSemicolon) - addSon(result, parseRoutineSpecifiers(p, noBody)) - addSon(result, ast.emptyNode) - if (p.section == seInterface) or noBody: - addSon(result, ast.emptyNode) - else: - var stmts = newNodeP(nkStmtList, p) - while true: - case p.tok.xkind - of pxVar: addSon(stmts, parseVar(p)) - of pxConst: addSon(stmts, parseConstSection(p)) - of pxType: addSon(stmts, parseTypeSection(p)) - of pxComment: skipCom(p, result) - of pxBegin: break - else: - parMessage(p, errTokenExpected, "begin") - break - var a = parseStmt(p) - for i in countup(0, sonsLen(a) - 1): addSon(stmts, a.sons[i]) - addSon(result, stmts) - -proc fixExit(p: var TParser, n: PNode): bool = - if (p.tok.ident.id == getIdent("exit").id): - var length = sonsLen(n) - if (length <= 0): return - var a = n.sons[length-1] - if (a.kind == nkAsgn) and (a.sons[0].kind == nkIdent) and - (a.sons[0].ident.id == getIdent("result").id): - delSon(a, 0) - a.kind = nkReturnStmt - result = true - getTok(p) - opt(p, pxSemicolon) - skipCom(p, a) - -proc fixVarSection(p: var TParser, counter: PNode) = - if p.lastVarSection == nil: return - assert(counter.kind == nkIdent) - for i in countup(0, sonsLen(p.lastVarSection) - 1): - var v = p.lastVarSection.sons[i] - for j in countup(0, sonsLen(v) - 3): - if v.sons[j].ident.id == counter.ident.id: - delSon(v, j) - if sonsLen(v) <= 2: - delSon(p.lastVarSection, i) - return - -proc exSymbols(n: PNode) = - case n.kind - of nkEmpty..nkNilLit: nil - of nkProcDef..nkIteratorDef: exSymbol(n.sons[namePos]) - of nkWhenStmt, nkStmtList: - for i in countup(0, sonsLen(n) - 1): exSymbols(n.sons[i]) - of nkVarSection, nkConstSection: - for i in countup(0, sonsLen(n) - 1): exSymbol(n.sons[i].sons[0]) - of nkTypeSection: - for i in countup(0, sonsLen(n) - 1): - exSymbol(n.sons[i].sons[0]) - if n.sons[i].sons[2].kind == nkObjectTy: - fixRecordDef(n.sons[i].sons[2]) - else: nil - -proc parseBegin(p: var TParser, result: PNode) = - getTok(p) - while true: - case p.tok.xkind - of pxComment: addSon(result, parseStmt(p)) - of pxSymbol: - if not fixExit(p, result): addSon(result, parseStmt(p)) - of pxEnd: - getTok(p) - break - of pxSemicolon: getTok(p) - of pxEof: parMessage(p, errExprExpected) - else: - var a = parseStmt(p) - if a.kind != nkEmpty: addSon(result, a) - if sonsLen(result) == 0: addSon(result, newNodeP(nkNilLit, p)) - -proc parseStmt(p: var TParser): PNode = - var oldcontext = p.context - p.context = conStmt - result = ast.emptyNode - case p.tok.xkind - of pxBegin: - result = newNodeP(nkStmtList, p) - parseBegin(p, result) - of pxCommand: result = parseCommand(p) - of pxCurlyDirLe, pxStarDirLe: - if isHandledDirective(p): result = parseDirective(p) - of pxIf: result = parseIf(p) - of pxWhile: result = parseWhile(p) - of pxRepeat: result = parseRepeat(p) - of pxCase: result = parseCase(p) - of pxTry: result = parseTry(p) - of pxProcedure, pxFunction: result = parseRoutine(p) - of pxType: result = parseTypeSection(p) - of pxConst: result = parseConstSection(p) - of pxVar: result = parseVar(p) - of pxFor: - result = parseFor(p) - fixVarSection(p, result.sons[0]) - of pxRaise: result = parseRaise(p) - of pxUses: result = parseUsesStmt(p) - of pxProgram, pxUnit, pxLibrary: - # skip the pointless header - while not (p.tok.xkind in {pxSemicolon, pxEof}): getTok(p) - getTok(p) - of pxInitialization: getTok(p) # just skip the token - of pxImplementation: - p.section = seImplementation - result = newNodeP(nkCommentStmt, p) - result.comment = "# implementation" - getTok(p) - of pxInterface: - p.section = seInterface - getTok(p) - of pxComment: - result = newNodeP(nkCommentStmt, p) - skipCom(p, result) - of pxSemicolon: getTok(p) - of pxSymbol: - if p.tok.ident.id == getIdent("break").id: - result = newNodeP(nkBreakStmt, p) - getTok(p) - skipCom(p, result) - addSon(result, ast.emptyNode) - elif p.tok.ident.id == getIdent("continue").id: - result = newNodeP(nkContinueStmt, p) - getTok(p) - skipCom(p, result) - addSon(result, ast.emptyNode) - elif p.tok.ident.id == getIdent("exit").id: - result = newNodeP(nkReturnStmt, p) - getTok(p) - skipCom(p, result) - addSon(result, ast.emptyNode) - else: - result = parseExprStmt(p) - of pxDot: getTok(p) # BUGFIX for ``end.`` in main program - else: result = parseExprStmt(p) - opt(p, pxSemicolon) - if result.kind != nkEmpty: skipCom(p, result) - p.context = oldcontext - -proc parseUnit(p: var TParser): PNode = - result = newNodeP(nkStmtList, p) - getTok(p) # read first token - while true: - case p.tok.xkind - of pxEof, pxEnd: break - of pxBegin: parseBegin(p, result) - of pxCurlyDirLe, pxStarDirLe: - if isHandledDirective(p): addSon(result, parseDirective(p)) - else: parMessage(p, errXNotAllowedHere, p.tok.ident.s) - else: addSon(result, parseStmt(p)) - opt(p, pxEnd) - opt(p, pxDot) - if p.tok.xkind != pxEof: - addSon(result, parseStmt(p)) # comments after final 'end.' - diff --git a/compiler/passaux.nim b/compiler/passaux.nim index 4a85c994c..af507d210 100644 --- a/compiler/passaux.nim +++ b/compiler/passaux.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -9,39 +9,25 @@ ## implements some little helper passes -import - strutils, ast, astalgo, passes, msgs, options, idgen +import + ast, passes, msgs, options, lineinfos -proc verboseOpen(s: PSym): PPassContext = - #MessageOut('compiling ' + s.name.s); - result = nil # we don't need a context - if gVerbosity > 0: rawMessage(hintProcessing, s.name.s) - -proc verboseProcess(context: PPassContext, n: PNode): PNode = - result = n - if context != nil: InternalError("logpass: context is not nil") - if gVerbosity == 3: - # system.nim deactivates all hints, for verbosity:3 we want the processing - # messages nonetheless, so we activate them again unconditionally: - incl(msgs.gNotes, hintProcessing) - Message(n.info, hintProcessing, $idgen.gBackendId) - -const verbosePass* = makePass(open = verboseOpen, process = verboseProcess) +from modulegraphs import ModuleGraph, PPassContext + +type + VerboseRef = ref object of PPassContext + config: ConfigRef -proc cleanUp(c: PPassContext, n: PNode): PNode = +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 - # we cannot clean up if dead code elimination is activated - if optDeadCodeElim in gGlobalOptions or n == nil: return - case n.kind - of nkStmtList: - for i in countup(0, sonsLen(n) - 1): discard cleanup(c, n.sons[i]) - of nkProcDef, nkMethodDef: - if n.sons[namePos].kind == nkSym: - var s = n.sons[namePos].sym - if sfDeadCodeElim notin getModule(s).flags and not astNeeded(s): - s.ast.sons[bodyPos] = ast.emptyNode # free the memory - else: - nil - -const cleanupPass* = makePass(process = cleanUp, close = cleanUp) + let v = VerboseRef(context) + 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 8d228fe9a..d6b141078 100644 --- a/compiler/passes.nim +++ b/compiler/passes.nim @@ -1,204 +1,255 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # -# This module implements the passes functionality. A pass must implement the -# `TPass` interface. +## This module implements the passes functionality. A pass must implement the +## `TPass` interface. -import - strutils, lists, options, ast, astalgo, llstream, msgs, platform, os, - condsyms, idents, renderer, types, extccomp, math, magicsys, nversion, - nimsets, syntaxes, times, rodread, semthreads, idgen +import + options, ast, llstream, msgs, + idents, + syntaxes, modulegraphs, reorder, + lineinfos, + pipelineutils, + modules, pathutils, packages, + sem, semdata -type - TPassContext* = object of TObject # the pass's context - fromCache*: bool # true if created by "openCached" - - PPassContext* = ref TPassContext +import ic/replayer - TPassOpen* = proc (module: PSym): PPassContext {.nimcall.} - TPassOpenCached* = - proc (module: PSym, rd: PRodReader): PPassContext {.nimcall.} - TPassClose* = proc (p: PPassContext, n: PNode): PNode {.nimcall.} - TPassProcess* = proc (p: PPassContext, topLevelStmt: PNode): PNode {.nimcall.} +export skipCodegen, resolveMod, prepareConfigNotes - TPass* = tuple[open: TPassOpen, openCached: TPassOpenCached, - process: TPassProcess, close: TPassClose] +when defined(nimsuggest): + import ../dist/checksums/src/checksums/sha1 - TPassData* = tuple[input: PNode, closeOutput: Pnode] - TPasses* = openarray[TPass] +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] -# a pass is a tuple of procedure vars ``TPass.close`` may produce additional -# nodes. These are passed to the other close procedures. +import std/tables + +type + TPassData* = tuple[input: PNode, closeOutput: PNode] + +# a pass is a tuple of procedure vars ``TPass.close`` may produce additional +# nodes. These are passed to the other close procedures. # This mechanism used to be used for the instantiation of generics. proc makePass*(open: TPassOpen = nil, - openCached: TPassOpenCached = nil, process: TPassProcess = nil, - close: TPassClose = nil): TPass = + close: TPassClose = nil, + isFrontend = false): TPass = result.open = open - result.openCached = openCached result.close = close result.process = process + result.isFrontend = isFrontend - # This implements a memory preserving scheme: Top level statements are - # processed in a pipeline. The compiler never looks at a whole module - # any longer. However, this is simple to change, as new passes may perform - # whole program optimizations. For now, we avoid it to save a lot of memory. -proc processModule*(module: PSym, stream: PLLStream, rd: PRodReader) - -# the semantic checker needs these: -var - gImportModule*: proc (m: PSym, fileIdx: int32): PSym {.nimcall.} - gIncludeFile*: proc (m: PSym, fileIdx: int32): PNode {.nimcall.} - -# implementation - -proc skipCodegen*(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 = msgs.gErrorCounter > 0 - -proc astNeeded*(s: PSym): bool = - # The ``rodwrite`` module uses this to determine if the body of a proc - # needs to be stored. The passes manager frees s.sons[codePos] when - # appropriate to free the procedure body's memory. This is important - # to keep memory usage down. - if (s.kind in {skMethod, skProc}) and - ({sfCompilerProc, sfCompileTime} * s.flags == {}) and - (s.typ.callConv != ccInline) and - (s.ast.sons[genericParamsPos].kind == nkEmpty): - result = semthreads.needsGlobalAnalysis() - else: - result = true - -const +const maxPasses = 10 -type +type TPassContextArray = array[0..maxPasses - 1, PPassContext] -var - gPasses: array[0..maxPasses - 1, TPass] - gPassesLen*: int - -proc clearPasses* = - gPassesLen = 0 - -proc registerPass*(p: TPass) = - gPasses[gPassesLen] = p - inc(gPassesLen) - -proc carryPass*(p: TPass, module: PSym, m: TPassData): TPassData = - var c = p.open(module) - result.input = p.process(c, m.input) - result.closeOutput = if p.close != nil: p.close(c, m.closeOutput) - else: m.closeOutput - -proc carryPasses*(nodes: PNode, module: PSym, passes: TPasses) = - var passdata: TPassData - passdata.input = nodes - for pass in passes: - passdata = carryPass(pass, module, passdata) - -proc openPasses(a: var TPassContextArray, module: PSym) = - for i in countup(0, gPassesLen - 1): - if not isNil(gPasses[i].open): - a[i] = gPasses[i].open(module) +proc clearPasses*(g: ModuleGraph) = + g.passes.setLen(0) + +proc registerPass*(g: ModuleGraph; p: TPass) = + internalAssert g.config, g.passes.len < maxPasses + g.passes.add(p) + +proc openPasses(g: ModuleGraph; a: var TPassContextArray; + 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 openPassesCached(a: var TPassContextArray, module: PSym, rd: PRodReader) = - for i in countup(0, gPassesLen - 1): - if not isNil(gPasses[i].openCached): - a[i] = gPasses[i].openCached(module, rd) - if a[i] != nil: - a[i].fromCache = true - else: - a[i] = nil - -proc closePasses(a: var TPassContextArray) = + +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(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 processTopLevelStmtCached(n: PNode, a: var TPassContextArray) = - # this implements the code transformation pipeline - var m = n - for i in countup(0, gPassesLen - 1): - if not isNil(gPasses[i].openCached): m = gPasses[i].process(a[i], m) - -proc closePassesCached(a: var TPassContextArray) = - var m: PNode = nil - for i in countup(0, gPassesLen - 1): - if not isNil(gPasses[i].openCached) and not isNil(gPasses[i].close): - m = gPasses[i].close(a[i], m) - a[i] = nil # free the memory here - -proc processImplicits(implicits: seq[string], nodeKind: TNodeKind, - a: var TPassContextArray) = + +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 relativeTo = toFullPath(graph.config, m.info) for module in items(implicits): - var importStmt = newNodeI(nodeKind, gCmdLineInfo) - var str = newStrNode(nkStrLit, module) - str.info = gCmdLineInfo - importStmt.addSon str - if not processTopLevelStmt(importStmt, a): break - -proc processModule(module: PSym, stream: PLLStream, rd: PRodReader) = - var - p: TParsers + # 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 + if not processTopLevelStmt(graph, importStmt, a): break + +proc processModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator; + stream: PLLStream): bool {.discardable.} = + if graph.stopCompile(): return true + var + p: Parser a: TPassContextArray s: PLLStream fileIdx = module.fileIdx - if rd == nil: - openPasses(a, module) - if stream == nil: - let filename = fileIdx.toFullPath - s = LLStreamOpen(filename, fmRead) - if s == nil: - rawMessage(errCannotOpenFile, filename) - return - else: - s = stream - while true: - openParsers(p, fileIdx, s) - - 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 implicitImports, nkImportStmt, a - processImplicits implicitIncludes, nkIncludeStmt, a - - while true: + 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: + 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: var n = parseTopLevelStmt(p) - if n.kind == nkEmpty: break - if not processTopLevelStmt(n, a): break - - closeParsers(p) - if s.kind != llsStdIn: break - closePasses(a) - # id synchronization point for more consistent code generation: - IDsynchronizationPoint(1000) + if n.kind == nkEmpty: break + sl.add n + if sfReorder in module.flags or codeReordering in graph.config.features: + sl = reorder(graph, sl, module) + discard processTopLevelStmt(graph, sl, a) + + 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: - openPassesCached(a, module, rd) - var n = loadInitSection(rd) - for i in countup(0, sonsLen(n) - 1): processTopLevelStmtCached(n.sons[i], a) - closePassesCached(a) + 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 ff7f18ac0..32ec7fb53 100644 --- a/compiler/patterns.nim +++ b/compiler/patterns.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -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 - else: nil + 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,81 +63,97 @@ 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: - for i in 0.. <sc.len: - if sc.sons[i].sym == x.sym: return true + result = false + for i in 0..<sc.len: + if sc[i].sym == x.sym: return true elif sc.kind == nkOpenSymChoice: # same name suffices for open sym choices! - result = sc.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: if p.constraint != nil: result = matchNodeKinds(p.constraint, n) if not result: return if isNil(n.typ): - result = p.typ.kind in {tyEmpty, tyStmt} + result = p.typ.kind in {tyVoid, tyTyped} else: - result = sigmatch.argtypeMatches(c.c, p.typ, n.typ) + result = sigmatch.argtypeMatches(c.c, p.typ, n.typ, fromHlo = true) 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) + var pp = getLazy(c, param) if pp != nil: # check if we got the same pattern (already unified): result = sameTrees(pp, n) #matches(c, pp, n) elif n.kind == nkArgList or checkTypes(c, param, n): - PutLazy(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) + var pp = getLazy(c, param) if pp != nil and pp.kind == nkArgList: pp.add(n) else: pp = newNodeI(nkArgList, n.info, 1) - pp.sons[0] = n - PutLazy(c, param, pp) + pp[0] = n + putLazy(c, param, pp) proc matchNested(c: PPatternContext, p, n: PNode, rpn: bool): bool = # match ``op * param`` or ``op *| param`` 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] - for i in 0.. <n.len: + 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 = - # hidden conversions (?) - if isPatternParam(c, p): + let n = skipHidden(n) + if nfNoRewrite in n.flags: + result = false + elif isPatternParam(c, p): result = bindOrCheck(c, p.sym, n) elif n.kind == nkSym and p.kind == nkIdent: result = p.ident.id == n.sym.name.id @@ -139,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: InternalError(p.info, "invalid pattern") - # template {add(a, `&` * b)}(a: string{noalias}, b: varargs[string]) = - # add(a, b) + 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]) = + # 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 @@ -170,89 +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]) - -when false: - proc procPatternMatches*(c: PContext, s: PSym, n: PNode): bool = - ## for AST-based overloading: - var ctx: TPatternContext - ctx.owner = s - ctx.c = c - ctx.formals = sonsLen(s.typ)-1 - result = matches(ctx, s.ast.sons[patternPos], n) + 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 :-) @@ -260,23 +285,25 @@ 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 - let x = GetLazy(ctx, param) + 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 result.add(x) - if requiresAA: addToArgList(args, n) + 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: nil + of aqNone: discard of aqShouldAlias: # it suffices that it aliases for sure with *some* other param: var ok = false @@ -284,7 +311,7 @@ proc applyRule*(c: PContext, s: PSym, n: PNode): PNode = if arg != rs and aliases.isPartOf(rs, arg) == arYes: ok = true break - # constraint not fullfilled: + # constraint not fulfilled: if not ok: return nil of aqNoAlias: # it MUST not alias with any other param: @@ -293,11 +320,11 @@ proc applyRule*(c: PContext, s: PSym, n: PNode): PNode = if arg != rs and aliases.isPartOf(rs, arg) != arNo: ok = false break - # constraint not fullfilled: + # constraint not fulfilled: if not ok: return nil - markUsed(n, s) + 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/pbraces.nim b/compiler/pbraces.nim deleted file mode 100644 index a944fe0ab..000000000 --- a/compiler/pbraces.nim +++ /dev/null @@ -1,18 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -import - llstream, lexer, parser, idents, strutils, ast, msgs - -proc ParseAll*(p: var TParser): PNode = - result = nil - -proc parseTopLevelStmt*(p: var TParser): PNode = - result = nil - diff --git a/compiler/pendx.nim b/compiler/pendx.nim deleted file mode 100644 index 2942968a0..000000000 --- a/compiler/pendx.nim +++ /dev/null @@ -1,18 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -import - llstream, lexer, parser, idents, strutils, ast, msgs - -proc ParseAll*(p: var TParser): PNode = - result = nil - -proc parseTopLevelStmt*(p: var TParser): PNode = - result = nil - 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 59091b690..03d0cc461 100644 --- a/compiler/platform.nim +++ b/compiler/platform.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -10,215 +10,289 @@ # This module contains data about the different processors # and operating systems. # Note: Unfortunately if an OS or CPU is listed here this does not mean that -# Nimrod has been tested on this platform or that the RTL has been ported. +# Nim has been tested on this platform or that the RTL has been ported. # Feel free to test for your excentric platform! -import - strutils +import + std/strutils -type +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, osAix, osPalmos, osQnx, osAmiga, - osAtari, osNetware, osMacos, osMacosx, osHaiku, osJS, osNimrodVM, - osStandalone + osNone, osDos, osWindows, osOs2, osLinux, osMorphos, osSkyos, osSolaris, + 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 +type + TInfoOSProp* = enum ospNeedsPIC, # OS needs PIC for libraries ospCaseInsensitive, # OS filesystem is case insensitive ospPosix, # OS is posix-like ospLacksThreadVars # OS lacks proper __threadvar support TInfoOSProps* = set[TInfoOSProp] - TInfoOS* = tuple[name: string, parDir: string, dllFrmt: string, - altDirSep: string, objExt: string, newLine: string, - pathSep: string, dirSep: string, scriptExt: string, - curDir: string, exeExt: string, extSep: string, + TInfoOS* = tuple[name: string, parDir: string, dllFrmt: string, + altDirSep: string, objExt: string, newLine: string, + pathSep: string, dirSep: string, scriptExt: string, + curDir: string, exeExt: string, extSep: string, props: TInfoOSProps] -const +const OS*: array[succ(low(TSystemOS))..high(TSystemOS), TInfoOS] = [ - (name: "DOS", - parDir: "..", dllFrmt: "$1.dll", altDirSep: "/", objExt: ".obj", - newLine: "\x0D\x0A", pathSep: ";", dirSep: "\\", scriptExt: ".bat", - curDir: ".", exeExt: ".exe", extSep: ".", props: {ospCaseInsensitive}), - (name: "Windows", parDir: "..", dllFrmt: "$1.dll", altDirSep: "/", - objExt: ".obj", newLine: "\x0D\x0A", pathSep: ";", dirSep: "\\", - scriptExt: ".bat", curDir: ".", exeExt: ".exe", extSep: ".", - props: {ospCaseInsensitive}), - (name: "OS2", parDir: "..", - dllFrmt: "$1.dll", altDirSep: "/", - objExt: ".obj", newLine: "\x0D\x0A", - pathSep: ";", dirSep: "\\", - scriptExt: ".bat", curDir: ".", - exeExt: ".exe", extSep: ".", - props: {ospCaseInsensitive}), - (name: "Linux", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "MorphOS", parDir: "..", - dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", - pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "SkyOS", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "Solaris", parDir: "..", - dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", - pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "Irix", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "NetBSD", parDir: "..", - dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", - pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "FreeBSD", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "OpenBSD", 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: ".", - props: {ospNeedsPIC, ospPosix}), - (name: "PalmOS", parDir: "..", - dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", - pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", - props: {ospNeedsPIC}), - (name: "QNX", - parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", objExt: ".o", - newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", props: {ospNeedsPIC, ospPosix}), - (name: "Amiga", - parDir: "..", dllFrmt: "$1.library", altDirSep: "/", objExt: ".o", - newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", props: {ospNeedsPIC}), - (name: "Atari", - parDir: "..", dllFrmt: "$1.dll", altDirSep: "/", objExt: ".o", - newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: "", curDir: ".", - exeExt: ".tpp", extSep: ".", props: {ospNeedsPIC}), - (name: "Netware", - parDir: "..", dllFrmt: "$1.nlm", altDirSep: "/", objExt: "", - newLine: "\x0D\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", - curDir: ".", exeExt: ".nlm", extSep: ".", props: {ospCaseInsensitive}), - (name: "MacOS", parDir: "::", dllFrmt: "$1Lib", altDirSep: ":", - objExt: ".o", newLine: "\x0D", pathSep: ",", dirSep: ":", scriptExt: "", - curDir: ":", exeExt: "", extSep: ".", props: {ospCaseInsensitive}), - (name: "MacOSX", parDir: "..", dllFrmt: "lib$1.dylib", altDirSep: ":", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix, ospLacksThreadVars}), - (name: "Haiku", parDir: "..", dllFrmt: "lib$1.so", altDirSep: ":", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {ospNeedsPIC, ospPosix, ospLacksThreadVars}), - (name: "JS", parDir: "..", - dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", - pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", - exeExt: "", extSep: ".", props: {}), - (name: "NimrodVM", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", - objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + (name: "DOS", + parDir: "..", dllFrmt: "$1.dll", altDirSep: "/", objExt: ".obj", + newLine: "\x0D\x0A", pathSep: ";", dirSep: "\\", scriptExt: ".bat", + curDir: ".", exeExt: ".exe", extSep: ".", props: {ospCaseInsensitive}), + (name: "Windows", parDir: "..", dllFrmt: "$1.dll", altDirSep: "/", + objExt: ".obj", newLine: "\x0D\x0A", pathSep: ";", dirSep: "\\", + scriptExt: ".bat", curDir: ".", exeExt: ".exe", extSep: ".", + props: {ospCaseInsensitive}), + (name: "OS2", parDir: "..", + dllFrmt: "$1.dll", altDirSep: "/", + objExt: ".obj", newLine: "\x0D\x0A", + pathSep: ";", dirSep: "\\", + scriptExt: ".bat", curDir: ".", + exeExt: ".exe", extSep: ".", + props: {ospCaseInsensitive}), + (name: "Linux", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "MorphOS", parDir: "..", + dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", + pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", + exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "SkyOS", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "Solaris", parDir: "..", + dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", + pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", + exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "Irix", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "NetBSD", parDir: "..", + dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", + pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", + exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "FreeBSD", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "OpenBSD", parDir: "..", + dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", + pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", + exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "DragonFly", parDir: "..", + dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", + pathSep: ":", dirSep: "/", + 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: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "PalmOS", parDir: "..", + dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", + pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", + exeExt: "", extSep: ".", + props: {ospNeedsPIC}), + (name: "QNX", + parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", objExt: ".o", + newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", curDir: ".", + exeExt: "", extSep: ".", props: {ospNeedsPIC, ospPosix}), + (name: "Amiga", + parDir: "..", dllFrmt: "$1.library", altDirSep: "/", objExt: ".o", + newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", curDir: ".", + exeExt: "", extSep: ".", props: {ospNeedsPIC}), + (name: "Atari", + parDir: "..", dllFrmt: "$1.dll", altDirSep: "/", objExt: ".o", + newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: "", curDir: ".", + exeExt: ".tpp", extSep: ".", props: {ospNeedsPIC}), + (name: "Netware", + parDir: "..", dllFrmt: "$1.nlm", altDirSep: "/", objExt: "", + newLine: "\x0D\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", + curDir: ".", exeExt: ".nlm", extSep: ".", props: {ospCaseInsensitive}), + (name: "MacOS", parDir: "::", dllFrmt: "$1Lib", altDirSep: ":", + objExt: ".o", newLine: "\x0D", pathSep: ",", dirSep: ":", scriptExt: "", + curDir: ":", exeExt: "", extSep: ".", props: {ospCaseInsensitive}), + (name: "MacOSX", parDir: "..", dllFrmt: "lib$1.dylib", altDirSep: ":", + 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: ".", + props: {ospNeedsPIC, ospPosix, ospLacksThreadVars}), + (name: "Android", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospPosix}), + (name: "VxWorks", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ";", dirSep: "\\", + scriptExt: ".sh", curDir: ".", exeExt: ".vxe", extSep: ".", + props: {ospNeedsPIC, ospPosix, ospLacksThreadVars}), + (name: "Genode", pardir: "..", dllFrmt: "$1.lib.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", + scriptExt: "", curDir: "/", exeExt: "", extSep: ".", + props: {ospNeedsPIC, ospLacksThreadVars}), + + (name: "JS", parDir: "..", + dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", + pathSep: ":", dirSep: "/", + scriptExt: ".sh", curDir: ".", + exeExt: "", extSep: ".", props: {}), + (name: "NimVM", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", + objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", props: {}), (name: "Standalone", parDir: "..", dllFrmt: "lib$1.so", altDirSep: "/", objExt: ".o", newLine: "\x0A", pathSep: ":", dirSep: "/", - scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", - props: {})] + scriptExt: ".sh", curDir: ".", exeExt: "", extSep: ".", + 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 +type + TSystemCPU* = enum # Also add CPU for in initialization section and # alias conditionals to condsyms (end of module). cpuNone, cpuI386, cpuM68k, cpuAlpha, cpuPowerpc, cpuPowerpc64, - cpuSparc, cpuVm, cpuIa64, cpuAmd64, cpuMips, cpuArm, - cpuJS, cpuNimrodVM, cpuAVR + 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, +type + 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), - (name: "alpha", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), + (name: "i386", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), + (name: "m68k", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), + (name: "alpha", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), (name: "powerpc", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), - (name: "powerpc64", intSize: 64, endian: bigEndian, 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: "ia64", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), - (name: "amd64", intSize: 64, endian: littleEndian, floatSize: 64, bit: 64), - (name: "mips", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), - (name: "arm", intSize: 32, endian: littleEndian, floatSize: 64, bit: 32), - (name: "js", intSize: 32, endian: bigEndian,floatSize: 64,bit: 32), - (name: "nimrodvm", intSize: 32, endian: bigEndian, floatSize: 64, bit: 32), - (name: "avr", intSize: 16, endian: littleEndian, floatSize: 32, bit: 16)] - -var - targetCPU*, hostCPU*: TSystemCPU - targetOS*, hostOS*: TSystemOS - -proc NameToOS*(name: string): TSystemOS -proc NameToCPU*(name: string): TSystemCPU - -var - IntSize*: int - floatSize*: int - PtrSize*: int - tnl*: string # target newline - -proc setTarget*(o: TSystemOS, c: TSystemCPU) = + (name: "powerpc64", intSize: 64, endian: bigEndian, floatSize: 64,bit: 64), + (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), # 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: 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: "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 + targetCPU*, hostCPU*: TSystemCPU + targetOS*, hostOS*: TSystemOS + intSize*: int + floatSize*: int + ptrSize*: int + tnl*: string # target newline + +proc setTarget*(t: var Target; o: TSystemOS, c: TSystemCPU) = assert(c != cpuNone) assert(o != osNone) #echo "new Target: OS: ", o, " CPU: ", c - targetCPU = c - targetOS = o - intSize = cpu[c].intSize div 8 - floatSize = cpu[c].floatSize div 8 - ptrSize = cpu[c].bit div 8 - tnl = os[o].newLine - -proc NameToOS(name: string): TSystemOS = - for i in countup(succ(osNone), high(TSystemOS)): - if cmpIgnoreStyle(name, OS[i].name) == 0: + t.targetCPU = c + t.targetOS = 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 succ(osNone)..high(TSystemOS): + if cmpIgnoreStyle(name, OS[i].name) == 0: return i result = osNone -proc NameToCPU(name: string): TSystemCPU = - for i in countup(succ(cpuNone), high(TSystemCPU)): - if cmpIgnoreStyle(name, CPU[i].name) == 0: +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 succ(cpuNone)..high(TSystemCPU): + if cmpIgnoreStyle(name, CPU[i].name) == 0: return i result = cpuNone -hostCPU = nameToCPU(system.hostCPU) -hostOS = nameToOS(system.hostOS) - -setTarget(hostOS, hostCPU) # assume no cross-compiling +proc listCPUnames*(): seq[string] = + result = @[] + for i in succ(cpuNone)..high(TSystemCPU): + result.add CPU[i].name +proc setTargetFromSystem*(t: var Target) = + 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 new file mode 100644 index 000000000..19c320aae --- /dev/null +++ b/compiler/plugins/active.nim @@ -0,0 +1,24 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Include file that imports all plugins that are active. + +import + ".." / [pluginsupport, idents, ast], locals, itersgen + +const + plugins: array[2, Plugin] = [ + ("stdlib", "system", "iterToProc", iterToProcImpl), + ("stdlib", "system", "locals", semLocals) + ] + +proc getPlugin*(ic: IdentCache; fn: PSym): Transformation = + for p in plugins: + if pluginMatches(ic, p, fn): return p.t + return nil 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 new file mode 100644 index 000000000..e2c97bdc5 --- /dev/null +++ b/compiler/plugins/itersgen.nim @@ -0,0 +1,46 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Plugin to transform an inline iterator into a data structure. + +import ".." / [ast, modulegraphs, lookups, semdata, lambdalifting, msgs] + +proc iterToProcImpl*(c: PContext, n: PNode): PNode = + result = newNodeI(nkStmtList, n.info) + let iter = n[1] + if iter.kind != nkSym or iter.sym.kind != skIterator: + localError(c.config, iter.info, "first argument needs to be an iterator") + return + if n[2].typ.isNil: + localError(c.config, n[2].info, "second argument needs to be a type") + return + if n[3].kind != nkIdent: + localError(c.config, n[3].info, "third argument needs to be an identifier") + return + + let t = n[2].typ.skipTypes({tyTypeDesc, tyGenericInst}) + if t.kind notin {tyRef, tyPtr} or t.elementType.kind != tyObject: + localError(c.config, n[2].info, + "type must be a non-generic ref|ptr to object with state field") + return + let body = liftIterToProc(c.graph, iter.sym, getBody(c.graph, iter.sym), t, c.idgen) + + let prc = newSym(skProc, n[3].ident, 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 + let orig = iter.sym.ast + prc.ast = newProcNode(nkProcDef, n.info, + body = body, params = orig[paramsPos], name = newSymNode(prc), + pattern = c.graph.emptyNode, genericParams = c.graph.emptyNode, + pragmas = orig[pragmasPos], exceptions = c.graph.emptyNode) + + prc.ast.add iter.sym.ast[resultPos] + addInterfaceDecl(c, prc) diff --git a/compiler/plugins/locals.nim b/compiler/plugins/locals.nim new file mode 100644 index 000000000..d3046cd65 --- /dev/null +++ b/compiler/plugins/locals.nim @@ -0,0 +1,39 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## The builtin 'system.locals' implemented as a plugin. + +import ".." / [ast, astalgo, + magicsys, lookups, semdata, lowerings] + +proc semLocals*(c: PContext, n: PNode): PNode = + var counter = 0 + var tupleType = newTypeS(tyTuple, c) + result = newNodeIT(nkTupleConstr, n.info, tupleType) + tupleType.n = newNodeI(nkRecList, n.info) + let owner = getCurrOwner(c) + # for now we skip openarrays ... + for scope in localScopesFrom(c, c.currentScope): + for it in items(scope.symbols): + if it.kind in skLocalVars and + it.typ.skipTypes({tyGenericInst, tyVar}).kind notin + {tyVarargs, tyOpenArray, tyTypeDesc, tyStatic, tyUntyped, tyTyped, tyEmpty}: + + 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) + + 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) 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/pluginsupport.nim b/compiler/pluginsupport.nim new file mode 100644 index 000000000..a44436f11 --- /dev/null +++ b/compiler/pluginsupport.nim @@ -0,0 +1,33 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Plugin support for the Nim compiler. Right now plugins +## need to be built with the compiler only: plugins using +## DLLs or the FFI will not work. + +import ast, semdata, idents + +type + Transformation* = proc (c: PContext; n: PNode): PNode {.nimcall.} + Plugin* = tuple + package, module, fn: string + t: Transformation + +proc pluginMatches*(ic: IdentCache; p: Plugin; s: PSym): bool = + if s.name.id != ic.getIdent(p.fn).id: + return false + let module = s.skipGenericOwner + if module == nil or module.kind != skModule or + module.name.id != ic.getIdent(p.module).id: + return false + let package = module.owner + if package == nil or package.kind != skPackage or + package.name.id != ic.getIdent(p.package).id: + return false + return true diff --git a/compiler/pragmas.nim b/compiler/pragmas.nim index 8f3da9f38..9a298cd90 100644 --- a/compiler/pragmas.nim +++ b/compiler/pragmas.nim @@ -1,7 +1,7 @@ # # -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -9,232 +9,353 @@ # This module implements semantic checking for pragmas -import - os, platform, condsyms, ast, astalgo, idents, semdata, msgs, renderer, - wordrecg, ropes, options, strutils, lists, extccomp, math, magicsys, trees, - rodread, types, lookups +import + condsyms, ast, astalgo, idents, semdata, msgs, renderer, + wordrecg, ropes, options, extccomp, magicsys, trees, + types, lookups, lineinfos, pathutils, linter, modulepaths -const +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, wProcVar, wDeprecated, wVarargs, wCompileTime, wMerge, - wBorrow, wExtern, wImportCompilerProc, wThread, wImportCpp, wImportObjC, - wNoStackFrame, wError, wDiscardable, wNoInit, wDestructor, wCodegenDecl, - wGenSym, wInject, wRaises, wTags} + 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 - templatePragmas* = {wImmediate, wDeprecated, wError, wGenSym, wInject, wDirty} - macroPragmas* = {FirstCallConv..LastCallConv, wImmediate, wImportc, wExportc, - wNodecl, wMagic, wNosideEffect, wCompilerProc, wDeprecated, wExtern, - wImportcpp, wImportobjc, wError, wDiscardable, wGenSym, wInject} - iteratorPragmas* = {FirstCallConv..LastCallConv, wNosideEffect, wSideEffect, - wImportc, wExportc, wNodecl, wMagic, wDeprecated, wBorrow, wExtern, - wImportcpp, wImportobjc, wError, wDiscardable, wGenSym, wInject, wRaises, - wTags} - exprPragmas* = {wLine} - stmtPragmas* = {wChecks, wObjChecks, wFieldChecks, wRangechecks, - wBoundchecks, wOverflowchecks, wNilchecks, wAssertions, wWarnings, wHints, - wLinedir, wStacktrace, wLinetrace, wOptimization, wHint, wWarning, wError, - wFatal, wDefine, wUndef, wCompile, wLink, wLinkSys, wPure, wPush, wPop, - wBreakpoint, wWatchpoint, wPassL, wPassC, wDeadCodeElim, wDeprecated, - wFloatChecks, wInfChecks, wNanChecks, wPragma, wEmit, wUnroll, - wLinearScanEnd, wPatterns, wEffects, wNoForward} - lambdaPragmas* = {FirstCallConv..LastCallConv, wImportc, wExportc, wNodecl, - wNosideEffect, wSideEffect, wNoreturn, wDynLib, wHeader, - wDeprecated, wExtern, wThread, wImportcpp, wImportobjc, wNoStackFrame, - wRaises, wTags} - typePragmas* = {wImportc, wExportc, wDeprecated, wMagic, wAcyclic, wNodecl, - wPure, wHeader, wCompilerProc, wFinal, wSize, wExtern, wShallow, - wImportcpp, wImportobjc, wError, wIncompleteStruct, wByCopy, wByRef, - wInheritable, wGenSym, wInject, wRequiresInit} - fieldPragmas* = {wImportc, wExportc, wDeprecated, wExtern, - wImportcpp, wImportobjc, wError} - varPragmas* = {wImportc, wExportc, wVolatile, wRegister, wThreadVar, wNodecl, - wMagic, wHeader, wDeprecated, wCompilerProc, wDynLib, wExtern, - wImportcpp, wImportobjc, wError, wNoInit, wCompileTime, wGlobal, - wGenSym, wInject, wCodegenDecl} - constPragmas* = {wImportc, wExportc, wHeader, wDeprecated, wMagic, wNodecl, - wExtern, wImportcpp, wImportobjc, wError, wGenSym, wInject} + methodPragmas* = procPragmas+{wBase}-{wImportCpp} + 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, + wPassl, wPassc, wLocalPassc, + wDeadCodeElimUnused, # deprecated, always on + wDeprecated, + 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, + 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, wTags} - allRoutinePragmas* = procPragmas + iteratorPragmas + lambdaPragmas + procTypePragmas* = {FirstCallConv..LastCallConv, wVarargs, wNoSideEffect, + wThread, wRaises, wEffectsOf, wLocks, wTags, wForbids, wGcSafe, + wRequires, wEnsures} + forVarPragmas* = {wInject, wGensym} + allRoutinePragmas* = methodPragmas + iteratorPragmas + lambdaPragmas + enumFieldPragmas* = {wDeprecated} -proc pragma*(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords) -# implementation +proc getPragmaVal*(procAst: PNode; name: TSpecialWord): PNode = + result = nil + let p = procAst[pragmasPos] + if p.kind == nkEmpty: return nil + for it in p: + if it.kind in nkPragmaCallKinds and it.len == 2 and it[0].kind == nkIdent and + it[0].ident.id == ord(name): + return it[1] -proc invalidPragma(n: PNode) = - LocalError(n.info, errInvalidPragmaX, renderTree(n, {renderNoComments})) +proc pragma*(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords; + isStatement: bool = false) -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 == nkExprColonExpr) 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(it) - else: invalidPragma(it) - else: - invalidPragma(it) - -proc setExternName(s: PSym, extname: string) = - s.loc.r = toRope(extname % s.name.s) - -proc MakeExternImport(s: PSym, extname: string) = - setExternName(s, extname) +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})) + +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 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.snippet = rope(s.name.s) + elif '$' notin extname: + s.loc.snippet = rope(extname) + else: + try: + s.loc.snippet = rope(extname % s.name.s) + except ValueError: + localError(c.config, info, "invalid extern name: '" & extname & "'. (Forgot to escape '$'?)") + when hasFFI: + s.cname = $s.loc.snippet + + +proc makeExternImport(c: PContext; s: PSym, extname: string, info: TLineInfo) = + setExternName(c, s, extname, info) incl(s.flags, sfImportc) excl(s.flags, sfForward) -proc MakeExternExport(s: PSym, extname: string) = - setExternName(s, extname) +proc makeExternExport(c: PContext; s: PSym, extname: string, info: TLineInfo) = + setExternName(c, s, extname, info) incl(s.flags, sfExportc) -proc processImportCompilerProc(s: PSym, extname: string) = - setExternName(s, extname) +proc processImportCompilerProc(c: PContext; s: PSym, extname: string, info: TLineInfo) = + setExternName(c, s, extname, info) incl(s.flags, sfImportc) excl(s.flags, sfForward) incl(s.loc.flags, lfImportCompilerProc) -proc processImportCpp(s: PSym, extname: string) = - setExternName(s, extname) +proc processImportCpp(c: PContext; s: PSym, extname: string, info: TLineInfo) = + setExternName(c, s, extname, info) incl(s.flags, sfImportc) incl(s.flags, sfInfixCall) excl(s.flags, sfForward) + if c.config.backend == backendC: + let m = s.getModule() + incl(m.flags, sfCompileToCpp) + incl c.config.globalOptions, optMixedMode -proc processImportObjC(s: PSym, extname: string) = - setExternName(s, extname) +proc processImportObjC(c: PContext; s: PSym, extname: string, info: TLineInfo) = + setExternName(c, s, extname, info) incl(s.flags, sfImportc) incl(s.flags, sfNamedParamCall) excl(s.flags, sfForward) + let m = s.getModule() + incl(m.flags, sfCompileToObjc) -proc newEmptyStrNode(n: PNode): PNode {.noinline.} = - result = newNodeIT(nkStrLit, n.info, getSysType(tyString)) - result.strVal = "" +proc newEmptyStrNode(c: PContext; n: PNode, strVal: string = ""): PNode {.noinline.} = + result = newNodeIT(nkStrLit, n.info, getSysType(c.graph, n.info, tyString)) + result.strVal = strVal proc getStrLitNode(c: PContext, n: PNode): PNode = - if n.kind != nkExprColonExpr: - LocalError(n.info, errStringLiteralExpected) + if n.kind notin nkPragmaCallKinds or n.len != 2: + localError(c.config, n.info, errStringLiteralExpected) # error correction: - result = newEmptyStrNode(n) + 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] - else: - LocalError(n.info, errStringLiteralExpected) + 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: - result = newEmptyStrNode(n) + result = newEmptyStrNode(c, n) -proc expectStrLit(c: PContext, n: PNode): string = +proc expectStrLit(c: PContext, n: PNode): string = result = getStrLitNode(c, n).strVal -proc expectIntLit(c: PContext, n: PNode): int = - if n.kind != nkExprColonExpr: - LocalError(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) - else: LocalError(n.info, errIntLiteralExpected) - -proc getOptionalStr(c: PContext, n: PNode, defaultStr: string): string = - if n.kind == nkExprColonExpr: result = expectStrLit(c, n) +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[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) = +proc processMagic(c: PContext, n: PNode, s: PSym) = #if sfSystemModule notin c.module.flags: # liMessage(n.info, errMagicOnlyInSystem) - if n.kind != nkExprColonExpr: - LocalError(n.info, errStringLiteralExpected) + if n.kind notin nkPragmaCallKinds or n.len != 2: + 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)): - if substr($m, 1) == v: + for m in TMagic: + if substr($m, 1) == v: s.magic = m break - if s.magic == mNone: Message(n.info, warnUnknownMagic, v) + if s.magic == mNone: message(c.config, n.info, warnUnknownMagic, v) -proc wordToCallConv(sw: TSpecialWord): TCallingConvention = +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 = - if n.kind == nkExprColonExpr: - let x = c.semConstBoolExpr(c, n.sons[1]) - n.sons[1] = x +proc isTurnedOn(c: PContext, n: PNode): bool = + result = false + if n.kind in nkPragmaCallKinds and n.len == 2: + let x = c.semConstBoolExpr(c, n[1]) + n[1] = x if x.kind == nkIntLit: return x.intVal != 0 - LocalError(n.info, errOnOrOffExpected) - -proc onOff(c: PContext, n: PNode, op: TOptions) = - if IsTurnedOn(c, n): gOptions = gOptions + op - else: gOptions = gOptions - op - -proc pragmaDeadCodeElim(c: PContext, n: PNode) = - if IsTurnedOn(c, n): incl(c.module.flags, sfDeadCodeElim) - else: excl(c.module.flags, sfDeadCodeElim) - -proc pragmaNoForward(c: PContext, n: PNode) = - if IsTurnedOn(c, n): incl(c.module.flags, sfNoForward) - else: excl(c.module.flags, sfNoForward) - -proc processCallConv(c: PContext, n: PNode) = - if (n.kind == nkExprColonExpr) and (n.sons[1].kind == nkIdent): - var sw = whichKeyword(n.sons[1].ident) + 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.incl op + else: resOptions.excl op + +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[1].kind == nkIdent: + let sw = whichKeyword(n[1].ident) case sw - of firstCallConv..lastCallConv: - POptionEntry(c.optionStack.tail).defaultCC = wordToCallConv(sw) - else: LocalError(n.info, errCallConvExpected) - else: - LocalError(n.info, errCallConvExpected) - -proc getLib(c: PContext, kind: TLibKind, path: PNode): PLib = - var it = PLib(c.libs.head) - while it != nil: - if it.kind == kind: - if trees.ExprStructuralEquivalent(it.path, path): return it - it = PLib(it.next) + of FirstCallConv..LastCallConv: + c.optionStack[^1].defaultCC = wordToCallConv(sw) + else: localError(c.config, n.info, "calling convention expected") + else: + localError(c.config, n.info, "calling convention expected") + +proc getLib(c: PContext, kind: TLibKind, path: PNode): PLib = + for it in c.libs: + if it.kind == kind and trees.exprStructuralEquivalent(it.path, path): + return it + result = newLib(kind) result.path = path - Append(c.libs, result) + c.libs.add result if path.kind in {nkStrLit..nkTripleStrLit}: - result.isOverriden = options.isDynLibOverride(path.strVal) + result.isOverridden = options.isDynlibOverride(c.config, path.strVal) proc expectDynlibNode(c: PContext, n: PNode): PNode = - if n.kind != nkExprColonExpr: - LocalError(n.info, errStringLiteralExpected) + if n.kind notin nkPragmaCallKinds or n.len != 2: + localError(c.config, n.info, errStringLiteralExpected) # error correction: - result = newEmptyStrNode(n) + result = newEmptyStrNode(c, n) 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(n.info, errStringLiteralExpected) - result = newEmptyStrNode(n) - -proc processDynLib(c: PContext, n: PNode, sym: PSym) = + localError(c.config, n.info, errStringLiteralExpected) + result = newEmptyStrNode(c, n) + +proc processDynLib(c: PContext, n: PNode, sym: PSym) = if (sym == nil) or (sym.kind == skModule): - POptionEntry(c.optionStack.tail).dynlib = getLib(c, libDynamic, - expectDynlibNode(c, n)) + let lib = getLib(c, libDynamic, expectDynlibNode(c, n)) + if not lib.isOverridden: + c.optionStack[^1].dynlib = lib else: - if n.kind == nkExprColonExpr: + 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: @@ -242,508 +363,1049 @@ proc processDynLib(c: PContext, n: PNode, sym: PSym) = # since we'll be loading the dynlib symbols dynamically, we must use # a calling convention that doesn't introduce custom name mangling # cdecl is the default - the user can override this explicitly - if sym.kind in RoutineKinds and sym.typ != nil and - sym.typ.callConv == ccDefault: + if sym.kind in routineKinds and sym.typ != nil and + tfExplicitCallConv notin sym.typ.flags: sym.typ.callConv = ccCDecl proc processNote(c: PContext, n: PNode) = - if (n.kind == nkExprColonExpr) and (sonsLen(n) == 2) and - (n.sons[0].kind == nkBracketExpr) and - (n.sons[0].sons[1].kind == nkIdent) and - (n.sons[0].sons[0].kind == nkIdent) and (n.sons[1].kind == nkIdent): + 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.sons[0].sons[0].ident) - of wHint: - var x = findStr(msgs.HintsToStr, n.sons[0].sons[1].ident.s) - if x >= 0: nk = TNoteKind(x + ord(hintMin)) - else: invalidPragma(n); return - of wWarning: - var x = findStr(msgs.WarningsToStr, n.sons[0].sons[1].ident.s) - if x >= 0: nk = TNoteKind(x + ord(warnMin)) - else: InvalidPragma(n); return + case whichKeyword(n[0][0].ident) + of wHint: handleNote(hintMin .. hintMax, c.config.notes) + of wWarning: handleNote(warnMin .. warnMax, c.config.notes) + of wWarningAsError: handleNote(warnMin .. warnMax, c.config.warningAsErrors) + of wHintAsError: handleNote(hintMin .. hintMax, c.config.warningAsErrors) + else: 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 wFloatChecks: {optNaNCheck, optInfCheck} + of wNanChecks: {optNaNCheck} + of wInfChecks: {optInfCheck} + 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: {optNone} + of wProfiler: {optProfiler, optMemTracker} + of wMemTracker: {optMemTracker} + of wByRef: {optByRef} + of wImplicitStatic: {optImplicitStatic} + 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: - invalidPragma(n) - return + localError(c.config, n.info, errStringLiteralExpected) - let x = c.semConstBoolExpr(c, n.sons[1]) - n.sons[1] = x - if x.kind == nkIntLit and x.intVal != 0: incl(gNotes, nk) - else: excl(gNotes, nk) - else: - invalidPragma(n) - -proc processOption(c: PContext, n: PNode): bool = - if n.kind != nkExprColonExpr: result = true - elif n.sons[0].kind == nkBracketExpr: processNote(c, n) - elif n.sons[0].kind != nkIdent: result = true +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[0].kind == nkBracketExpr: processNote(c, n) + elif n[0].kind != nkIdent: result = false else: - var sw = whichKeyword(n.sons[0].ident) - case sw - of wChecks: OnOff(c, n, checksOptions) - of wObjChecks: OnOff(c, n, {optObjCheck}) - of wFieldchecks: OnOff(c, n, {optFieldCheck}) - of wRangechecks: OnOff(c, n, {optRangeCheck}) - of wBoundchecks: OnOff(c, n, {optBoundsCheck}) - of wOverflowchecks: OnOff(c, n, {optOverflowCheck}) - of wNilchecks: OnOff(c, n, {optNilCheck}) - of wFloatChecks: OnOff(c, n, {optNanCheck, optInfCheck}) - of wNaNchecks: OnOff(c, n, {optNanCheck}) - of wInfChecks: OnOff(c, n, {optInfCheck}) - of wAssertions: OnOff(c, n, {optAssert}) - of wWarnings: OnOff(c, n, {optWarns}) - of wHints: OnOff(c, n, {optHints}) - of wCallConv: processCallConv(c, n) - of wLinedir: OnOff(c, n, {optLineDir}) - of wStacktrace: OnOff(c, n, {optStackTrace}) - of wLinetrace: OnOff(c, n, {optLineTrace}) - of wDebugger: OnOff(c, n, {optEndb}) - of wProfiler: OnOff(c, n, {optProfiler}) - of wByRef: OnOff(c, n, {optByRef}) - of wDynLib: processDynLib(c, n, nil) - of wOptimization: - if n.sons[1].kind != nkIdent: - invalidPragma(n) - else: - case n.sons[1].ident.s.normalize - of "speed": - incl(gOptions, optOptimizeSpeed) - excl(gOptions, optOptimizeSize) - of "size": - excl(gOptions, optOptimizeSpeed) - incl(gOptions, optOptimizeSize) - of "none": - excl(gOptions, optOptimizeSpeed) - excl(gOptions, optOptimizeSize) - else: LocalError(n.info, errNoneSpeedOrSizeExpected) - of wImplicitStatic: OnOff(c, n, {optImplicitStatic}) - of wPatterns: OnOff(c, n, {optPatterns}) - else: result = true - -proc processPush(c: PContext, n: PNode, start: int) = - if n.sons[start-1].kind == nkExprColonExpr: - LocalError(n.info, errGenerated, "':' after 'push' not supported") - var x = newOptionEntry() - var y = POptionEntry(c.optionStack.tail) - x.options = gOptions - x.defaultCC = y.defaultCC - x.dynlib = y.dynlib - x.notes = gNotes - append(c.optionStack, x) - for i in countup(start, sonsLen(n) - 1): - if processOption(c, n.sons[i]): - # simply store it somehwere: + 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) + else: + case sw + of wCallconv: processCallConv(c, n) + of wDynlib: processDynLib(c, n, nil) + of wOptimization: + if n[1].kind != nkIdent: + invalidPragma(c, n) + else: + case n[1].ident.s.normalize + of "speed": + incl(resOptions, optOptimizeSpeed) + excl(resOptions, optOptimizeSize) + of "size": + excl(resOptions, optOptimizeSpeed) + incl(resOptions, optOptimizeSize) + of "none": + excl(resOptions, optOptimizeSpeed) + excl(resOptions, optOptimizeSize) + else: localError(c.config, n.info, "'none', 'speed' or 'size' expected") + else: result = false + +proc processOption(c: PContext, n: PNode, resOptions: var TOptions) = + if not tryProcessOption(c, n, resOptions): + # calling conventions (boring...): + localError(c.config, n.info, "option expected") + +proc checkPushedPragma(c: PContext, n: PNode) = + let keyDeep = n.kind in nkPragmaCallKinds and n.len > 1 + var key = if keyDeep: n[0] else: n + if key.kind in nkIdentKinds: + let ident = considerQuotedIdent(c, key) + var userPragma = strTableGet(c.userPragmas, ident) + if userPragma == nil: + let k = whichKeyword(ident) + # TODO: might as well make a list which is not accepted by `push`: emit, cast etc. + if k == wEmit: + localError(c.config, n.info, "an 'emit' pragma cannot be pushed") + +proc processPush(c: PContext, n: PNode, start: int) = + if n[start-1].kind in nkPragmaCallKinds: + localError(c.config, n.info, "'push' cannot have arguments") + 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] - #LocalError(n.info, errOptionExpected) - -proc processPop(c: PContext, n: PNode) = - if c.optionStack.counter <= 1: - LocalError(n.info, errAtPopWithoutPush) - else: - gOptions = POptionEntry(c.optionStack.tail).options - gNotes = POptionEntry(c.optionStack.tail).notes - remove(c.optionStack, c.optionStack.tail) - -proc processDefine(c: PContext, n: PNode) = - if (n.kind == nkExprColonExpr) and (n.sons[1].kind == nkIdent): - DefineSymbol(n.sons[1].ident.s) - Message(n.info, warnDeprecated, "define") - else: - invalidPragma(n) - -proc processUndef(c: PContext, n: PNode) = - if (n.kind == nkExprColonExpr) and (n.sons[1].kind == nkIdent): - UndefSymbol(n.sons[1].ident.s) - Message(n.info, warnDeprecated, "undef") - else: - invalidPragma(n) - -type - TLinkFeature = enum - linkNormal, linkSys - -proc processCompile(c: PContext, n: PNode) = + 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: + popOptionEntry(c) + when defined(debugOptions): + echo c.config $ n.info, " POP config is now ", c.config.options + +proc processDefineConst(c: PContext, n: PNode, sym: PSym, kind: TMagic) = + sym.magic = kind + if n.kind in nkPragmaCallKinds and n.len == 2: + # could also use TLib + n[1] = getStrLitNode(c, n) + +proc processDefine(c: PContext, n: PNode, sym: PSym) = + if sym != nil and sym.kind == skConst: + processDefineConst(c, n, sym, mGenericDefine) + elif (n.kind in nkPragmaCallKinds and n.len == 2) and (n[1].kind == nkIdent): + defineSymbol(c.config.symbols, n[1].ident.s) + else: + invalidPragma(c, n) + +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) + else: + invalidPragma(c, n) + +proc relativeFile(c: PContext; n: PNode; ext=""): AbsoluteFile = var s = expectStrLit(c, n) - var found = findFile(s) - if found == "": found = s - var trunc = ChangeFileExt(found, "") - extccomp.addExternalFileToCompile(found) - extccomp.addFileToLink(completeCFilePath(trunc, false)) - -proc processCommonLink(c: PContext, n: PNode, feature: TLinkFeature) = - var f = expectStrLit(c, n) - if splitFile(f).ext == "": f = addFileExt(f, cc[ccompiler].objExt) - var found = findFile(f) - if found == "": found = f # use the default - case feature - of linkNormal: extccomp.addFileToLink(found) - of linkSys: - extccomp.addFileToLink(libpath / completeCFilePath(found, false)) - else: internalError(n.info, "processCommonLink") - -proc PragmaBreakpoint(c: PContext, n: PNode) = - discard getOptionalStr(c, n, "") - -proc PragmaCheckpoint(c: PContext, n: PNode) = - # checkpoints can be used to debug the compiler; they are not documented - var info = n.info - inc(info.line) # next line is affected! - msgs.addCheckpoint(info) - -proc PragmaWatchpoint(c: PContext, n: PNode) = - if n.kind == nkExprColonExpr: - n.sons[1] = c.semExpr(c, n.sons[1]) + if ext.len > 0 and splitFile(s).ext == "": + s = addFileExt(s, ext) + result = AbsoluteFile parentDir(toFullPath(c.config, n.info)) / s + if not fileExists(result): + if isAbsolute(s): result = AbsoluteFile s + else: + result = findFile(c.config, s) + if result.isEmpty: result = AbsoluteFile s + +proc processCompile(c: PContext, n: PNode) = + ## This pragma can take two forms. The first is a simple file input: + ## {.compile: "file.c".} + ## The second is a tuple where the second arg is the output name strutils formatter: + ## {.compile: ("file.c", "$1.o").} + proc docompile(c: PContext; it: PNode; src, dest: AbsoluteFile; customArgs: string) = + var cf = Cfile(nimname: splitFile(src).name, + cname: src, obj: dest, flags: {CfileFlag.External}, + customArgs: customArgs) + if not fileExists(src): + localError(c.config, n.info, "cannot find: " & src.string) + else: + extccomp.addExternalFileToCompile(c.config, cf) + recordPragma(c, it, "compile", src.string, dest.string, customArgs) + + proc getStrLit(c: PContext, n: PNode; i: int): string = + n[i] = c.semConstExpr(c, n[i]) + case n[i].kind + of nkStrLit, nkRStrLit, nkTripleStrLit: + 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[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, AbsoluteFile(dest % extractFilename(f))) + docompile(c, it, AbsoluteFile f, obj, "") else: - invalidPragma(n) + 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 = AbsoluteFile s + else: + found = findFile(c.config, s) + 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 processLink(c: PContext, n: PNode) = + let found = relativeFile(c, n, CC[c.config.cCompiler].objExt) + 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(n.info, errEmptyAsm) + localError(con.config, n.info, "empty 'asm' statement") return # now parse the string literal and substitute symbols: var a = 0 - while true: + 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 b < 0: break + 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(sub)) - if e != nil: - if e.kind == skStub: loadStub(e) - addSon(result, newSymNode(e)) - else: - addSon(result, newStrNode(nkStrLit, sub)) - if c < 0: break + if 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: + incl(e.flags, sfUsed) + result.add newSymNode(e) + else: + result.add newStrNode(nkStrLit, sub) + else: + # an empty '``' produces a single '`' + result.add newStrNode(nkStrLit, $marker) + if c < 0: break a = c + 1 - else: illFormedAst(n) - -proc PragmaEmit(c: PContext, n: PNode) = - discard getStrLitNode(c, n) - n.sons[1] = semAsmOrEmit(c, n, '`') - -proc noVal(n: PNode) = - if n.kind == nkExprColonExpr: invalidPragma(n) - -proc PragmaUnroll(c: PContext, n: PNode) = - if c.p.nestedLoopCounter <= 0: - invalidPragma(n) - elif n.kind == nkExprColonExpr: + else: + illFormedAstLocal(n, con.config) + result = newNodeI(nkAsmStmt, n.info) + if n.kind == nkAsmStmt: result.add n[0] + +proc pragmaEmit(c: PContext, n: PNode) = + if n.kind notin nkPragmaCallKinds or n.len != 2: + localError(c.config, n.info, errStringLiteralExpected) + else: + let n1 = n[1] + if n1.kind == nkBracket: + var b = newNodeI(nkBracket, n1.info, n1.len) + for i in 0..<n1.len: + b[i] = c.semExprWithType(c, n1[i], {efTypeAllowed}) + n[1] = b + else: + n[1] = c.semConstExpr(c, n1) + case n[1].kind + of nkStrLit, nkRStrLit, nkTripleStrLit: + n[1] = semAsmOrEmit(c, n, '`') + else: + localError(c.config, n.info, errStringLiteralExpected) + +proc noVal(c: PContext; n: PNode) = + if n.kind in nkPragmaCallKinds and n.len > 1: invalidPragma(c, n) + +proc pragmaUnroll(c: PContext, n: PNode) = + if c.p.nestedLoopCounter <= 0: + invalidPragma(c, n) + elif n.kind in nkPragmaCallKinds and n.len == 2: var unrollFactor = expectIntLit(c, n) - if unrollFactor <% 32: - n.sons[1] = newIntNode(nkIntLit, unrollFactor) - else: - invalidPragma(n) - -proc PragmaLinearScanEnd(c: PContext, n: PNode) = - noVal(n) - -proc PragmaLine(c: PContext, n: PNode) = - if n.kind == nkExprColonExpr: - n.sons[1] = c.semConstExpr(c, n.sons[1]) - let a = n.sons[1] - if a.kind == nkPar: - 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] - if x.kind != nkStrLit: - LocalError(n.info, errStringLiteralExpected) - elif y.kind != nkIntLit: - LocalError(n.info, errIntLiteralExpected) + if unrollFactor <% 32: + 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[1] = c.semConstExpr(c, n[1]) + let a = n[1] + if a.kind in {nkPar, nkTupleConstr}: + # unpack the tuple + 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: - n.info.fileIndex = msgs.fileInfoIdx(x.strVal) - n.info.line = int16(y.intVal) + n.info.fileIndex = fileInfoIdx(c.config, AbsoluteFile(x.strVal)) + n.info.line = uint16(y.intVal) else: - LocalError(n.info, errXExpected, "tuple") + localError(c.config, n.info, "tuple expected") else: # sensible default: - n.info = getInfoContext(-1) - -proc processPragma(c: PContext, n: PNode, i: int) = - var it = n.sons[i] - if it.kind != nkExprColonExpr: invalidPragma(n) - elif it.sons[0].kind != nkIdent: invalidPragma(n) - elif it.sons[1].kind != nkIdent: invalidPragma(n) - - var userPragma = NewSym(skTemplate, it.sons[1].ident, nil, it.info) - var body = newNodeI(nkPragma, n.info) - for j in i+1 .. sonsLen(n)-1: addSon(body, n.sons[j]) - userPragma.ast = body - StrTableAdd(c.userPragmas, userPragma) + n.info = getInfoContext(c.config, -1) + +proc processPragma(c: PContext, n: PNode, i: int) = + ## Create and add a new custom pragma `{.pragma: name.}` node to the module's context. + let it = n[i] + if it.kind notin nkPragmaCallKinds and it.safeLen == 2: + invalidPragma(c, n) + 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, 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(x.info, errGenerated, "invalid type for raises/tags list") - x.typ = t - - if n.kind == nkExprColonExpr: - let it = n.sons[1] + 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[1] if it.kind notin {nkCurly, nkBracket}: processExc(c, it) else: for e in items(it): processExc(c, e) else: - invalidPragma(n) - -proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, - validPragmas: TSpecialWords): bool = - var it = n.sons[i] - var key = if it.kind == nkExprColonExpr: it.sons[0] else: it - if key.kind == nkIdent: - var userPragma = StrTableGet(c.userPragmas, key.ident) - if userPragma != nil: - inc c.InstCounter - if c.InstCounter > 100: - GlobalError(it.info, errRecursiveDependencyX, userPragma.name.s) - pragma(c, sym, userPragma.ast, validPragmas) - dec c.InstCounter + invalidPragma(c, n) + +proc pragmaLockStmt(c: PContext; it: PNode) = + if it.kind notin nkPragmaCallKinds or it.len != 2: + invalidPragma(c, it) + else: + let n = it[1] + if n.kind != nkBracket: + localError(c.config, n.info, errGenerated, "locks pragma takes a list of expressions") else: - var k = whichKeyword(key.ident) - if k in validPragmas: - case k - of wExportc: - makeExternExport(sym, getOptionalStr(c, it, sym.name.s)) - incl(sym.flags, sfUsed) # avoid wrong hints - of wImportc: makeExternImport(sym, getOptionalStr(c, it, sym.name.s)) - of wImportCompilerProc: - processImportCompilerProc(sym, getOptionalStr(c, it, sym.name.s)) - of wExtern: setExternName(sym, expectStrLit(c, it)) - of wImmediate: - if sym.kind in {skTemplate, skMacro}: incl(sym.flags, sfImmediate) - else: invalidPragma(it) - of wDirty: - if sym.kind == skTemplate: incl(sym.flags, sfDirty) - else: invalidPragma(it) - of wImportCpp: - processImportCpp(sym, getOptionalStr(c, it, sym.name.s)) - of wImportObjC: - processImportObjC(sym, getOptionalStr(c, it, sym.name.s)) - of wAlign: - if sym.typ == nil: invalidPragma(it) - var align = expectIntLit(c, it) - if not IsPowerOfTwo(align) and align != 0: - LocalError(it.info, errPowerOfTwoExpected) - else: - sym.typ.align = align - of wSize: - if sym.typ == nil: invalidPragma(it) - var size = expectIntLit(c, it) - if not IsPowerOfTwo(size) or size <= 0 or size > 8: - LocalError(it.info, errPowerOfTwoExpected) + 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[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 + # 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] + if pragma.kind in {nkStrLit..nkTripleStrLit}: + incl(c.module.flags, sfDeprecated) + c.module.constraint = getStrLitNode(c, outerPragma) + return + if pragma.kind != nkBracket: + localError(c.config, pragma.info, "list of key:value pairs expected"); return + 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: + invalidPragma(c, it); return + let n = it[1] + if n.kind == nkSym: + result = n.sym + elif kind == skField: + # First check if the guard is a global variable: + result = qualifiedLookUp(c, n, {}) + if result.isNil or result.kind notin {skLet, skVar} or + sfGlobal notin result.flags: + # 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), c.idgen, nil, n.info, + c.config.options) + else: + result = qualifiedLookUp(c, n, {checkUndeclared}) + +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) + callNode = newTree(nkCall, n[0], n[1]) + of nkPragmaCallKinds - {nkExprColonExpr}: + callNode = n + else: + invalidPragma(c, n) + return n + + trySuggestPragmas(c, callNode[0]) + + let r = c.semOverloadedCall(c, callNode, n, {skTemplate}, {efNoUndeclared}) + if r.isNil or sfCustomPragma notin r[0].sym.flags: + invalidPragma(c, n) + return n + + # we have a valid custom pragma + if sym != nil and sym.kind in {skEnumField, skForVar, skModule}: + illegalCustomPragma(c, n, sym) + return n + + result = r + # Transform the nkCall node back to its original form if possible + if n.kind == nkIdent and r.len == 1: + # 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: + localError(c.config, n.info, errGenerated, "parameter name expected") + else: + let it = n[1] + if it.kind in {nkCurly, nkBracket}: + for x in items(it): processParam(c, x) + else: + processParam(c, it) + +proc singlePragma(c: PContext, sym: PSym, n: PNode, i: var int, + validPragmas: TSpecialWords, + comesFromPush, isStatement: bool): bool = + result = false + var it = n[i] + 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[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) + + 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 + 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, 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: - sym.typ.size = size - of wNodecl: - noVal(it) - incl(sym.loc.Flags, lfNoDecl) - of wPure, wNoStackFrame: - noVal(it) - if sym != nil: incl(sym.flags, sfPure) - of wVolatile: - noVal(it) - incl(sym.flags, sfVolatile) - of wRegister: - noVal(it) - incl(sym.flags, sfRegister) - of wThreadVar: - noVal(it) - incl(sym.flags, sfThread) - of wDeadCodeElim: pragmaDeadCodeElim(c, it) - of wNoForward: pragmaNoForward(c, it) - of wMagic: processMagic(c, it, sym) - of wCompileTime: - noVal(it) + incl(sym.flags, sfMangleCpp) + incl(sym.flags, sfUsed) # avoid wrong hints + of wImportc: + let name = getOptionalStr(c, it, "$1") + cppDefine(c.config, name) + recordPragma(c, it, "cppdefine", name) + makeExternImport(c, sym, name, it.info) + of wImportCompilerProc: + let name = getOptionalStr(c, it, "$1") + cppDefine(c.config, name) + recordPragma(c, it, "cppdefine", name) + processImportCompilerProc(c, sym, name, it.info) + of wExtern: setExternName(c, sym, expectStrLit(c, it), it.info) + of wDirty: + if sym.kind == skTemplate: incl(sym.flags, sfDirty) + 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 wSize: + if sym.typ == nil: invalidPragma(c, it) + var size = expectIntLit(c, it) + 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) + of wPure, wAsmNoStackFrame: + noVal(c, it) + if sym != nil: + if k == wPure and sym.kind in routineKinds: invalidPragma(c, it) + else: incl(sym.flags, sfPure) + 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: + warningDeprecated(c.config, n.info, "'{.deadcodeelim: on.}' is deprecated, now a noop") # deprecated, dead code elim always on + of wNoForward: pragmaNoForward(c, it) + of wReorder: pragmaNoForward(c, it, flag = sfReorder) + of wMagic: processMagic(c, it, sym) + of wCompileTime: + noVal(c, it) + 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(it) - incl(sym.flags, sfGlobal) - of wMerge: - noval(it) - incl(sym.flags, sfMerge) - of wHeader: - var lib = getLib(c, libHeader, getStrLitNode(c, it)) - addToLib(lib, sym) - incl(sym.flags, sfImportc) - incl(sym.loc.flags, lfHeader) - incl(sym.loc.Flags, lfNoDecl) - # implies nodecl, because otherwise header would not make sense - if sym.loc.r == nil: sym.loc.r = toRope(sym.name.s) - of wDestructor: - if sym.typ.sons.len == 2: - sym.flags.incl sfDestructor - else: - invalidPragma(it) - of wNosideeffect: - noVal(it) + #incl(sym.loc.flags, lfNoDecl) + of wGlobal: + noVal(c, it) + incl(sym.flags, sfGlobal) + incl(sym.flags, sfPure) + of wConstructor: + 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) + incl(sym.flags, sfImportc) + incl(sym.loc.flags, lfHeader) + incl(sym.loc.flags, lfNoDecl) + # implies nodecl, because otherwise header would not make sense + if sym.loc.snippet == "": sym.loc.snippet = rope(sym.name.s) + of wNoSideEffect: + noVal(c, it) + if sym != nil: incl(sym.flags, sfNoSideEffect) if sym.typ != nil: incl(sym.typ.flags, tfNoSideEffect) - of wSideEffect: - noVal(it) - incl(sym.flags, sfSideEffect) - of wNoReturn: - noVal(it) + of wSideEffect: + noVal(c, it) + incl(sym.flags, sfSideEffect) + of wNoreturn: + noVal(c, it) + # Disable the 'noreturn' annotation when in the "Quirky Exceptions" mode! + if c.config.exc != excQuirky: incl(sym.flags, sfNoReturn) - of wDynLib: - processDynLib(c, it, sym) - of wCompilerProc: - noVal(it) # compilerproc may not get a string! - makeExternExport(sym, sym.name.s) - incl(sym.flags, sfCompilerProc) - incl(sym.flags, sfUsed) # suppress all those stupid warnings - registerCompilerProc(sym) - of wProcvar: - noVal(it) - incl(sym.flags, sfProcVar) - of wDeprecated: - noVal(it) - if sym != nil: incl(sym.flags, sfDeprecated) - else: incl(c.module.flags, sfDeprecated) - of wVarargs: - noVal(it) - if sym.typ == nil: invalidPragma(it) - else: incl(sym.typ.flags, tfVarargs) - of wBorrow: - noVal(it) + 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: + noVal(c, it) # compilerproc may not get a string! + 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) + of wExplain: + sym.flags.incl sfExplain + of wDeprecated: + if sym != nil and sym.kind in routineKinds + {skType, skVar, skLet, skConst}: + if it.kind in nkPragmaCallKinds: discard getStrLitNode(c, it) + incl(sym.flags, sfDeprecated) + 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) + else: incl(c.module.flags, sfDeprecated) + of wVarargs: + noVal(c, it) + if sym.typ == nil: invalidPragma(c, it) + else: incl(sym.typ.flags, tfVarargs) + of wBorrow: + if sym.kind == skType: + typeBorrow(c, sym, it) + else: + noVal(c, it) incl(sym.flags, sfBorrow) - of wFinal: - noVal(it) - if sym.typ == nil: invalidPragma(it) - else: incl(sym.typ.flags, tfFinal) - of wInheritable: - noVal(it) - if sym.typ == nil or tfFinal in sym.typ.flags: invalidPragma(it) - else: incl(sym.typ.flags, tfInheritable) - of wAcyclic: - noVal(it) - if sym.typ == nil: invalidPragma(it) - else: incl(sym.typ.flags, tfAcyclic) - of wShallow: - noVal(it) - if sym.typ == nil: invalidPragma(it) - else: incl(sym.typ.flags, tfShallow) - of wThread: - noVal(it) - incl(sym.flags, sfThread) - incl(sym.flags, sfProcVar) - if sym.typ != nil: incl(sym.typ.flags, tfThread) - of wHint: Message(it.info, hintUser, expectStrLit(c, it)) - of wWarning: Message(it.info, warnUser, expectStrLit(c, it)) - of wError: - if sym != nil and sym.isRoutine: - # This is subtle but correct: the error *statement* is only - # allowed for top level statements. Seems to be easier than - # distinguishing properly between - # ``proc p() {.error}`` and ``proc p() = {.error: "msg".}`` - noVal(it) - incl(sym.flags, sfError) - else: - LocalError(it.info, errUser, expectStrLit(c, it)) - of wFatal: Fatal(it.info, errUser, expectStrLit(c, it)) - of wDefine: processDefine(c, it) - of wUndef: processUndef(c, it) - of wCompile: processCompile(c, it) - of wLink: processCommonLink(c, it, linkNormal) - of wLinkSys: processCommonLink(c, it, linkSys) - of wPassL: extccomp.addLinkOption(expectStrLit(c, it)) - of wPassC: extccomp.addCompileOption(expectStrLit(c, it)) - of wBreakpoint: PragmaBreakpoint(c, it) - of wWatchpoint: PragmaWatchpoint(c, it) - of wPush: - processPush(c, n, i + 1) - result = true - of wPop: processPop(c, it) - of wPragma: + of wFinal: + noVal(c, it) + if sym.typ == nil: invalidPragma(c, it) + else: incl(sym.typ.flags, tfFinal) + of wInheritable: + noVal(c, it) + if sym.typ == nil or tfFinal in sym.typ.flags: invalidPragma(c, it) + else: incl(sym.typ.flags, tfInheritable) + of wPackage: + noVal(c, it) + if sym.typ == nil: invalidPragma(c, it) + else: incl(sym.flags, sfForward) + of wAcyclic: + noVal(c, it) + if sym.typ == nil: invalidPragma(c, it) + else: incl(sym.typ.flags, tfAcyclic) + of wShallow: + noVal(c, it) + if sym.typ == nil: invalidPragma(c, it) + else: incl(sym.typ.flags, tfShallow) + of wThread: + noVal(c, it) + incl(sym.flags, sfThread) + if sym.typ != nil: + incl(sym.typ.flags, tfThread) + if sym.typ.callConv == ccClosure: sym.typ.callConv = ccNimCall + of wSendable: + noVal(c, it) + if sym != nil and sym.typ != nil: + incl(sym.typ.flags, tfSendable) + else: + invalidPragma(c, it) + of wGcSafe: + noVal(c, it) + if sym != nil: + if sym.kind != skType: incl(sym.flags, sfThread) + if sym.typ != nil: incl(sym.typ.flags, tfGcSafe) + else: invalidPragma(c, it) + else: + discard "no checking if used as a code block" + of wPacked: + noVal(c, it) + if sym.typ == nil: invalidPragma(c, it) + else: incl(sym.typ.flags, tfPacked) + of wHint: + let s = expectStrLit(c, it) + recordPragma(c, it, "hint", s) + message(c.config, it.info, hintUser, s) + of wWarning: + let s = expectStrLit(c, it) + recordPragma(c, it, "warning", s) + message(c.config, it.info, warnUser, s) + of wError: + if sym != nil and (sym.isRoutine or sym.kind == skType) and not isStatement: + # This is subtle but correct: the error *statement* is only + # 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".}`` + 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, expectStrLit(c, it)) + of wDefine: processDefine(c, it, sym) + of wUndef: processUndef(c, it) + of wCompile: + let m = sym.getModule() + incl(m.flags, sfUsed) + processCompile(c, it) + of wLink: processLink(c, it) + of wPassl: + let m = sym.getModule() + incl(m.flags, sfUsed) + let s = expectStrLit(c, it) + extccomp.addLinkOption(c.config, s) + recordPragma(c, it, "passl", s) + of wPassc: + let m = sym.getModule() + incl(m.flags, sfUsed) + let s = expectStrLit(c, it) + extccomp.addCompileOption(c.config, s) + recordPragma(c, it, "passc", s) + of wLocalPassc: + assert sym != nil and sym.kind == skModule + let s = expectStrLit(c, it) + appendToModule(sym, n) + extccomp.addLocalCompileOption(c.config, s, toFullPathConsiderDirty(c.config, sym.info.fileIndex)) + recordPragma(c, it, "localpassl", s) + of wPush: + processPush(c, n, i + 1) + result = true + of wPop: + processPop(c, it) + result = true + of wPragma: + if not sym.isNil and sym.kind == skTemplate: + sym.flags.incl sfCustomPragma + else: processPragma(c, n, i) result = true - of wDiscardable: - noVal(it) - if sym != nil: incl(sym.flags, sfDiscardable) - of wNoInit: - noVal(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, wStacktrace, wLinetrace, wOptimization, - wCallConv, - wDebugger, wProfiler, wFloatChecks, wNanChecks, wInfChecks, - wPatterns: - if processOption(c, it): - # calling conventions (boring...): - LocalError(it.info, errOptionExpected) - of firstCallConv..lastCallConv: - assert(sym != nil) - if sym.typ == nil: invalidPragma(it) - else: sym.typ.callConv = wordToCallConv(k) - of wEmit: PragmaEmit(c, it) - of wUnroll: PragmaUnroll(c, it) - of wLinearScanEnd: PragmaLinearScanEnd(c, it) - of wEffects: - # is later processed in effect analysis: - noVal(it) - of wIncompleteStruct: - noVal(it) - if sym.typ == nil: invalidPragma(it) - else: incl(sym.typ.flags, tfIncompleteStruct) - of wRequiresInit: - noVal(it) - if sym.typ == nil: invalidPragma(it) - else: incl(sym.typ.flags, tfNeedsInit) - of wByRef: - noVal(it) - if sym == nil or sym.typ == nil: - if processOption(c, it): LocalError(it.info, errOptionExpected) - else: - incl(sym.typ.flags, tfByRef) - of wByCopy: - noVal(it) - if sym.kind != skType or sym.typ == nil: invalidPragma(it) - else: incl(sym.typ.flags, tfByCopy) - of wInject, wGenSym: - # We check for errors, but do nothing with these pragmas otherwise - # as they are handled directly in 'evalTemplate'. - noVal(it) - if sym == nil: invalidPragma(it) - of wLine: PragmaLine(c, it) - of wRaises, wTags: pragmaRaisesOrTags(c, it) - else: invalidPragma(it) - else: invalidPragma(it) - else: processNote(c, it) - -proc implictPragmas*(c: PContext, sym: PSym, n: PNode, - validPragmas: TSpecialWords) = + of wDiscardable: + noVal(c, it) + if sym != nil: incl(sym.flags, sfDiscardable) + of wNoInit: + 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, wStaticBoundchecks, wStyleChecks, + wCallconv, wDebugger, wProfiler, + wFloatChecks, wNanChecks, wInfChecks, wPatterns, wTrMacros: + processOption(c, it, c.config.options) + of wStackTrace, wLineTrace: + if sym.kind in {skProc, skMethod, skConverter}: + processOption(c, it, sym.options) + else: + processOption(c, it, c.config.options) + of FirstCallConv..LastCallConv: + assert(sym != nil) + if sym.typ == nil: invalidPragma(c, it) + 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) + of wEffects: + # is later processed in effect analysis: + noVal(c, it) + of wIncompleteStruct: + noVal(c, it) + if sym.typ == nil: invalidPragma(c, it) + else: incl(sym.typ.flags, tfIncompleteStruct) + of wCompleteStruct: + noVal(c, it) + if sym.typ == nil: invalidPragma(c, it) + else: incl(sym.typ.flags, tfCompleteStruct) + of wUnchecked: + noVal(c, it) + 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.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 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 == 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) + if sym.kind != skType or sym.typ == nil: invalidPragma(c, it) + else: + incl(sym.typ.flags, tfPartial) + of wInject, wGensym: + # We check for errors, but do nothing with these pragmas otherwise + # as they are handled directly in 'evalTemplate'. + noVal(c, it) + if sym == nil: invalidPragma(c, it) + of wLine: pragmaLine(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: 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) + else: + sym.guard = pragmaGuard(c, it, sym.kind) + of wGoto: + if sym == nil or sym.kind notin {skVar, skLet}: + invalidPragma(c, it) + else: + sym.flags.incl sfGoto + of wExportNims: + if sym == nil: invalidPragma(c, it) + else: magicsys.registerNimScriptSymbol(c.graph, sym) + of wExperimental: + if not isTopLevel(c): + localError(c.config, n.info, "'experimental' pragma only valid as toplevel statement or in a 'push' environment") + processExperimental(c, it) + of 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: + processDefineConst(c, n, sym, mIntDefine) + of wStrDefine: + 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: + 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: + # 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: - var it = POptionEntry(c.optionstack.head) - while it != nil: + for it in c.optionStack: let o = it.otherPragmas - if not o.isNil: - for i in countup(0, sonsLen(o) - 1): - if singlePragma(c, sym, o, i, validPragmas): - InternalError(n.info, "implicitPragmas") - it = it.next.POptionEntry - - if lfExportLib in sym.loc.flags and sfExportc notin sym.flags: - LocalError(n.info, errDynlibRequiresExportc) - var lib = POptionEntry(c.optionstack.tail).dynlib + 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, 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, 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 = toRope(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 + + for p in n: + var key = if p.kind in nkPragmaCallKinds and p.len > 1: p[0] else: p + if key.kind == nkIdent and whichKeyword(key.ident) == pragma: + return true + + return false + +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, false, isStatement): break + inc i + +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 pragma(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords) = +proc pragmaCallable*(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords, + isStatement: bool = false) = if n == nil: return - for i in countup(0, sonsLen(n) - 1): - if singlePragma(c, sym, n, i, validPragmas): break - implictPragmas(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 new file mode 100644 index 000000000..bfbe3d888 --- /dev/null +++ b/compiler/prefixmatches.nim @@ -0,0 +1,56 @@ +# +# +# The Nim Compiler +# (c) Copyright 2017 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +from std/strutils import toLowerAscii + +type + PrefixMatch* {.pure.} = enum + None, ## no prefix detected + Abbrev ## prefix is an abbreviation of the symbol + Substr, ## prefix is a substring of the symbol + Prefix, ## prefix does match the symbol + +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 + # check for prefix/contains: + while i < s.len: + if s[i] == '_': inc i + if i < s.len and eq(s[i], p[0]): + var ii = i+1 + var jj = 1 + 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 + inc ii + inc jj + + if jj >= p.len: + if i == 0: return PrefixMatch.Prefix + else: return PrefixMatch.Substr + inc i + # check for abbrev: + if eq(s[0], p[0]): + i = 1 + var j = 1 + while i < s.len: + if i < s.len-1 and s[i] == '_': + if j < p.len and eq(p[j], s[i+1]): inc j + else: return PrefixMatch.None + if i < s.len and s[i] in {'A'..'Z'} and s[i-1] notin {'A'..'Z'}: + if j < p.len and eq(p[j], s[i]): inc j + else: return PrefixMatch.None + inc i + if j >= p.len: + return PrefixMatch.Abbrev + else: + return PrefixMatch.None + return PrefixMatch.None diff --git a/compiler/procfind.nim b/compiler/procfind.nim index aefccd140..c2cc6e71f 100644 --- a/compiler/procfind.nim +++ b/compiler/procfind.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2013 Andreas Rumpf # # See the file "copying.txt", included in this @@ -11,82 +11,78 @@ # This is needed for proper handling of forward declarations. import - ast, astalgo, msgs, semdata, types, trees + ast, astalgo, msgs, semdata, types, trees, lookups + +import std/strutils proc equalGenericParams(procA, procB: PNode): bool = - if sonsLen(procA) != sonsLen(procB): return - for i in countup(0, sonsLen(procA) - 1): - if procA.sons[i].kind != nkSym: - InternalError(procA.info, "equalGenericParams") - return - if procB.sons[i].kind != nkSym: - InternalError(procB.info, "equalGenericParams") - return - let a = procA.sons[i].sym - let b = procB.sons[i].sym + if procA.len != procB.len: return false + for i in 0..<procA.len: + if procA[i].kind != nkSym: + return false + if procB[i].kind != nkSym: + return false + let a = procA[i].sym + let b = procB[i].sym if a.name.id != b.name.id or - not sameTypeOrNil(a.typ, b.typ, {TypeDescExactMatch}): return + not sameTypeOrNil(a.typ, b.typ, {ExactTypeDescValues}): return if a.ast != nil and b.ast != nil: - if not ExprStructuralEquivalent(a.ast, b.ast): return + if not exprStructuralEquivalent(a.ast, b.ast): return result = true -proc SearchForProc*(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(fn.info, errNotOverloadable, fn.name.s) - return - of paramsNotEqual: - nil - result = NextIdentIter(it, scope.symbols) +proc searchForProcAux(c: PContext, scope: PScope, fn: PSym): PSym = + const flags = {ExactGenericParams, ExactTypeDescValues, + ExactConstraints, IgnoreCC} + 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): + case equalParams(result.typ.n, fn.typ.n) + of paramsEqual: + if (sfExported notin result.flags) and (sfExported in fn.flags): + let message = ("public implementation '$1' has non-public " & + "forward declaration at $2") % + [getProcHeader(c.config, result, getDeclarationPath = false), c.config$result.info] + localError(c.config, fn.info, message) + 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 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) + proc paramsFitBorrow(child, parent: PNode): bool = 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(m.typ, n.typ, dcEqOrDistinctOf): return + 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 + proc searchForBorrowProc*(c: PContext, startScope: PScope, fn: PSym): PSym = + # Searches for the fn in the symbol table. If the parameter lists are suitable # for borrowing the sym in the symbol table is returned, else nil. - var it: TIdentIter + var it: TIdentIter = default(TIdentIter) for scope in walkScopes(startScope): result = initIdentIter(it, scope.symbols, fn.Name) - while result != nil: + 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 paramsFitBorrow(fn.typ.n, result.typ.n): return + if (result.Kind == fn.kind) and (result.id != fn.id): + 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 3d3cf4b29..000000000 --- a/compiler/readme.txt +++ /dev/null @@ -1,4 +0,0 @@ -This directory contains the Nimrod compiler written in Nimrod. Note that this -code has been translated from a bootstrapping version written in Pascal, so -the code is **not** a poster child of good Nimrod code. - diff --git a/compiler/renderer.nim b/compiler/renderer.nim index 70ce5c27d..cc07c0c2d 100644 --- a/compiler/renderer.nim +++ b/compiler/renderer.nim @@ -1,874 +1,1297 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2013 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # -# This module implements the renderer of the standard Nimrod representation. +# This module implements the renderer of the standard Nim representation. -import - lexer, options, idents, strutils, ast, msgs, lists +# 'import renderer' is so useful for debugging +# that Nim shouldn't produce a warning for that: +{.used.} + +import + lexer, options, idents, ast, msgs, lineinfos, wordrecg + +import std/[strutils] + +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions, formatfloat] + +type + TRenderFlag* = enum + renderNone, renderNoBody, renderNoComments, renderDocComments, + renderNoPragmas, renderIds, renderNoProcDefs, renderSyms, renderRunnableExamples, + renderIr, renderNonExportedFields, renderExpandUsing, renderNoPostfix -type - TRenderFlag* = enum - renderNone, renderNoBody, renderNoComments, renderDocComments, - renderNoPragmas, renderIds TRenderFlags* = set[TRenderFlag] - TRenderTok*{.final.} = object - kind*: TTokType + TRenderTok* = object + kind*: TokType length*: int16 + sym*: PSym + + Section = enum + GenericParams + ObjectDef TRenderTokSeq* = seq[TRenderTok] - TSrcGen*{.final.} = object + 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 buf*: string pendingNL*: int # negative if not active; else contains the # indentation value + pendingWhitespace: int comStack*: seq[PNode] # comment stack flags*: TRenderFlags + 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 renderModule*(n: PNode, filename: string, renderFlags: TRenderFlags = {}) proc renderTree*(n: PNode, renderFlags: TRenderFlags = {}): string -proc initTokRender*(r: var TSrcGen, n: PNode, renderFlags: TRenderFlags = {}) -proc getNextTok*(r: var TSrcGen, kind: var TTokType, literal: var string) -# implementation + # 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 isKeyword*(s: string): bool = - var i = getIdent(s) +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)): + (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): string = +proc renderDefinitionName*(s: PSym, noQuotes = false): string = + ## Returns the definition name of the symbol. + ## + ## If noQuotes is false the symbol may be returned in backticks. This will + ## happen if the name happens to be a keyword or the first character is not + ## part of the SymStartChars set. let x = s.name.s - if x[0] in SymStartChars and not renderer.isKeyword(x): result = x - else: result = '`' & x & '`' + if noQuotes or (x[0] in SymStartChars and not renderer.isKeyword(s.name)): + result = x + else: + result = '`' & x & '`' + +template inside(g: var TSrcGen, section: Section, body: untyped) = + ## Runs `body` with `section` included in `g.inside`. + ## Removes it at the end of the body if `g` wasn't inside it + ## before the template. + let wasntInSection = section notin g.inside + g.inside.incl section + body + if wasntInSection: + g.inside.excl section + +template outside(g: var TSrcGen, section: Section, body: untyped) = + ## Temporarily removes `section` from `g.inside`. Adds it back + ## at the end of the body if `g` was inside it before the template + let wasInSection = section in g.inside + g.inside.excl section + body + if wasInSection: + g.inside.incl section -const +const IndentWidth = 2 - longIndentWid = 4 + longIndentWid = IndentWidth * 2 MaxLineLen = 80 LineCommentColumn = 30 -proc InitSrcGen(g: var TSrcGen, renderFlags: TRenderFlags) = - 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.checkAnon = false - -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 addPendingNL(g: var TSrcGen) = - if g.pendingNL >= 0: - addTok(g, tkSpaces, "\n" & repeatChar(g.pendingNL)) +when defined(nimpretty): + proc minmaxLine(n: PNode): (int, int) = + case n.kind + of nkTripleStrLit: + result = (n.info.line.int, n.info.line.int + countLines(n.strVal)) + of nkCommentStmt: + 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..<n.safeLen: + let (currMin, currMax) = minmaxLine(n[i]) + if currMin < result[0]: result[0] = currMin + if currMax > result[1]: result[1] = currMax + + proc lineDiff(a, b: PNode): int = + result = minmaxLine(b)[0] - minmaxLine(a)[1] + +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: + when defined(nimpretty): + let newlines = repeat("\n", clamp(g.pendingNewlineCount, 1, 3)) + else: + 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: + addTok(g, tkSpaces, spaces(g.pendingWhitespace)) + g.pendingWhitespace = -1 -proc putNL(g: var TSrcGen, indent: int) = +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 + +proc previousNL(g: TSrcGen): bool = + result = g.pendingNL >= 0 or (g.tokens.len > 0 and + g.tokens[^1].kind == tkSpaces) -proc putNL(g: var TSrcGen) = +proc putNL(g: var TSrcGen) = putNL(g, g.indent) -proc optNL(g: var TSrcGen, indent: int) = +proc optNL(g: var TSrcGen, indent: int) = g.pendingNL = indent - g.lineLen = indent # BUGFIX - -proc optNL(g: var TSrcGen) = + g.lineLen = indent + g.col = g.indent + when defined(nimpretty): g.pendingNewlineCount = 0 + +proc optNL(g: var TSrcGen) = optNL(g, g.indent) -proc indentNL(g: var TSrcGen) = - inc(g.indent, indentWidth) +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) = + inc(g.indent, IndentWidth) g.pendingNL = g.indent g.lineLen = g.indent -proc Dedent(g: var TSrcGen) = - dec(g.indent, indentWidth) +proc dedent(g: var TSrcGen) = + dec(g.indent, IndentWidth) assert(g.indent >= 0) - if g.pendingNL > indentWidth: - Dec(g.pendingNL, indentWidth) - Dec(g.lineLen, indentWidth) - -proc put(g: var TSrcGen, kind: TTokType, s: string) = - addPendingNL(g) - if len(s) > 0: - addTok(g, kind, s) - inc(g.lineLen, len(s)) - -proc putLong(g: var TSrcGen, kind: TTokType, s: string, lineLen: int) = - # use this for tokens over multiple lines. - addPendingNL(g) - addTok(g, kind, s) - g.lineLen = lineLen - -proc toNimChar(c: Char): string = - case c - of '\0': result = "\\0" - of '\x01'..'\x1F', '\x80'..'\xFF': result = "\\x" & strutils.toHex(ord(c), 2) - of '\'', '\"', '\\': result = '\\' & c - else: result = c & "" - -proc makeNimString(s: string): string = - result = "\"" - for i in countup(0, len(s)-1): add(result, toNimChar(s[i])) - add(result, '\"') - -proc putComment(g: var TSrcGen, s: string) = + if g.pendingNL > IndentWidth: + dec(g.pendingNL, IndentWidth) + dec(g.lineLen, IndentWidth) + +proc put(g: var TSrcGen, kind: TokType, s: string; sym: PSym = nil) = + if kind != tkSpaces: + addPendingNL(g) + 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.len == 0: return var i = 0 - var comIndent = 1 - var isCode = (len(s) >= 2) and (s[1] != ' ') - var ind = g.lineLen - var com = "" - while true: + 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 '\0': + break + of '\r': put(g, tkComment, com) - com = "" + com = "## " inc(i) - if 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 = "" + com = "## " inc(i) optNL(g, ind) - of '#': - add(com, s[i]) + of ' ', '\t': + com.add(s[i]) inc(i) - comIndent = 0 - while s[i] == ' ': - add(com, s[i]) - inc(i) - inc(comIndent) - of ' ', '\x09': - add(com, s[i]) - inc(i) - else: + else: # we may break the comment into a multi-line comment if the line # gets too long: # compute length of the following word: var j = i - while s[j] > ' ': inc(j) - if not isCode and (g.lineLen + (j - i) > MaxLineLen): + while j <= hi and s[j] > ' ': inc(j) + if not isCode and (g.col + (j - i) > MaxLineLen): put(g, tkComment, com) optNL(g, ind) - com = '#' & repeatChar(comIndent) - while s[i] > ' ': - add(com, s[i]) + com = "## " + while i <= hi and s[i] > ' ': + com.add(s[i]) inc(i) put(g, tkComment, com) optNL(g) -proc maxLineLength(s: string): int = +proc maxLineLength(s: string): int = result = 0 + if s.len == 0: return 0 var i = 0 + let hi = s.len - 1 var lineLen = 0 - while true: + while i <= hi: case s[i] - of '\0': - break - of '\x0D': + of '\0': + break + 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 - else: + else: 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 - var hi = len(s) - 1 + let hi = s.len - 1 var str = "" - while i <= hi: + 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]) + else: + str.add(s[i]) inc(i) put(g, kind, str) -proc containsNL(s: string): bool = - for i in countup(0, len(s) - 1): +proc containsNL(s: string): bool = + for i in 0..<s.len: case s[i] - of '\x0D', '\x0A': + of '\r', '\n': return true - else: - nil + 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 - -proc popAllComs(g: var TSrcGen) = - setlen(g.comStack, 0) +proc pushCom(g: var TSrcGen, n: PNode) = + setLen(g.comStack, g.comStack.len + 1) + g.comStack[^1] = n -proc popCom(g: var TSrcGen) = - setlen(g.comStack, len(g.comStack) - 1) +proc popAllComs(g: var TSrcGen) = + setLen(g.comStack, 0) -const +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) and startsWith(n.comment, "##") - -proc gcom(g: var TSrcGen, n: PNode) = +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] != ' '): - put(g, tkSpaces, Space) + if shouldRenderComment(g, n): + 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, repeatChar(LineCommentColumn - g.lineLen)) + if ml + LineCommentColumn <= MaxLineLen: + 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]) + +proc gcoms(g: var TSrcGen) = + for i in 0..high(g.comStack): gcom(g, g.comStack[i]) popAllComs(g) -proc lsub(n: PNode): int -proc litAux(n: PNode, x: biggestInt, size: int): string = - proc skip(t: PType): PType = +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, tyDistinct, tyOrdinal, - tyConst, tyMutable}: - 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 -proc ulitAux(n: PNode, x: biggestInt, size: int): string = +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! - -proc atom(n: PNode): string = + else: result = $cast[BiggestUInt](x) + +proc atom(g: TSrcGen; n: PNode): string = + when defined(nimpretty): + doAssert g.config != nil, "g.config not initialized!" + let comment = if n.info.commentOffsetA < n.info.commentOffsetB: + " " & fileSection(g.config, g.fid, n.info.commentOffsetA, n.info.commentOffsetB) + else: + "" + if n.info.offsetA <= n.info.offsetB: + # for some constructed tokens this can not be the case and we're better + # off to not mess with the offset then. + return fileSection(g.config, g.fid, n.info.offsetA, n.info.offsetB) & comment var f: float32 case n.kind of nkEmpty: result = "" of nkIdent: result = n.ident.s of nkSym: result = n.sym.name.s - of nkStrLit: result = makeNimString(n.strVal) - of nkRStrLit: result = "r\"" & replace(n.strVal, "\"", "\"\"") & '\"' + 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 & "\"\"\"" - of nkCharLit: result = '\'' & toNimChar(chr(int(n.intVal))) & '\'' - of nkIntLit: result = litAux(n, n.intVal, 4) - of nkInt8Lit: result = litAux(n, n.intVal, 1) & "\'i8" - of nkInt16Lit: result = litAux(n, n.intVal, 2) & "\'i16" - of nkInt32Lit: result = litAux(n, n.intVal, 4) & "\'i32" - of nkInt64Lit: result = litAux(n, n.intVal, 8) & "\'i64" - of nkUIntLit: result = ulitAux(n, n.intVal, 4) & "\'u" - of nkUInt8Lit: result = ulitAux(n, n.intVal, 1) & "\'u8" - of nkUInt16Lit: result = ulitAux(n, n.intVal, 2) & "\'u16" - of nkUInt32Lit: result = ulitAux(n, n.intVal, 4) & "\'u32" - of nkUInt64Lit: result = ulitAux(n, n.intVal, 8) & "\'u64" + of nkCharLit: + result = "\'" + result.addEscapedChar(chr(int(n.intVal))); + result.add '\'' + of nkIntLit: result = litAux(g, n, n.intVal, 4) + of nkInt8Lit: result = litAux(g, n, n.intVal, 1) & "\'i8" + of nkInt16Lit: result = litAux(g, n, n.intVal, 2) & "\'i16" + of nkInt32Lit: result = litAux(g, n, n.intVal, 4) & "\'i32" + of nkInt64Lit: result = litAux(g, n, n.intVal, 8) & "\'i64" + of nkUIntLit: result = ulitAux(g, n, n.intVal, 4) & "\'u" + of nkUInt8Lit: result = ulitAux(g, n, n.intVal, 1) & "\'u8" + of nkUInt16Lit: result = ulitAux(g, n, n.intVal, 2) & "\'u16" + of nkUInt32Lit: result = ulitAux(g, n, n.intVal, 4) & "\'u32" + of nkUInt64Lit: result = ulitAux(g, n, n.intVal, 8) & "\'u64" of nkFloatLit: if n.flags * {nfBase2, nfBase8, nfBase16} == {}: result = $(n.floatVal) - else: result = litAux(n, (cast[PInt64](addr(n.floatVal)))[] , 8) - of nkFloat32Lit: - if n.flags * {nfBase2, nfBase8, nfBase16} == {}: + 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 - result = litAux(n, (cast[PInt32](addr(f)))[], 4) & "\'f32" - of nkFloat64Lit: - if n.flags * {nfBase2, nfBase8, nfBase16} == {}: + else: + f = n.floatVal.float32 + 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(n, (cast[PInt64](addr(n.floatVal)))[], 8) & "\'f64" + else: + 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: + of nkType: if (n.typ != nil) and (n.typ.sym != nil): result = n.typ.sym.name.s else: result = "[type node]" - else: - InternalError("rnimsyn.atom " & $n.kind) + else: + internalError(g.config, "renderer.atom " & $n.kind) result = "" - -proc lcomma(n: PNode, start: int = 0, theEnd: int = - 1): int = + +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(n.sons[i])) - inc(result, 2) # for ``, `` - if result > 0: + 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(n: PNode, start: int = 0, theEnd: int = - 1): int = + +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(n.sons[i])) - -proc lsub(n: PNode): int = + 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(n)) - of succ(nkEmpty)..pred(nkTripleStrLit), succ(nkTripleStrLit)..nkNilLit: - result = len(atom(n)) + of nkTripleStrLit: + if containsNL(n.strVal): result = MaxLineLen + 1 + else: result = atom(g, n).len + of succ(nkEmpty)..pred(nkTripleStrLit), succ(nkTripleStrLit)..nkNilLit: + result = atom(g, n).len of nkCall, nkBracketExpr, nkCurlyExpr, nkConv, nkPattern, nkObjConstr: - result = lsub(n.sons[0]) + lcomma(n, 1) + 2 - of nkHiddenStdConv, nkHiddenSubConv, nkHiddenCallConv: result = lsub(n[1]) - of nkCast: result = lsub(n.sons[0]) + lsub(n.sons[1]) + len("cast[]()") - of nkAddr: result = lsub(n.sons[0]) + len("addr()") - of nkStaticExpr: result = lsub(n.sons[0]) + len("static_") - of nkHiddenAddr, nkHiddenDeref: result = lsub(n.sons[0]) - of nkCommand: result = lsub(n.sons[0]) + lcomma(n, 1) + 1 - of nkExprEqExpr, nkAsgn, nkFastAsgn: result = lsons(n) + 3 - of nkPar, nkCurly, nkBracket, nkClosure: result = lcomma(n) + 2 - of nkArgList: result = lcomma(n) + 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[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: + # assume the trailing comma: + result = lcomma(g, n) + 3 + of nkArgList: result = lcomma(g, n) of nkTableConstr: - result = if n.len > 0: lcomma(n) + 2 else: len("{:}") - of nkClosedSymChoice, nkOpenSymChoice: - result = lsons(n) + len("()") + sonsLen(n) - 1 - of nkTupleTy: result = lcomma(n) + len("tuple[]") - of nkDotExpr: result = lsons(n) + 1 - of nkBind: result = lsons(n) + len("bind_") - of nkBindStmt: result = lcomma(n) + len("bind_") - of nkMixinStmt: result = lcomma(n) + len("mixin_") - of nkCheckedFieldExpr: result = lsub(n.sons[0]) - of nkLambda: result = lsons(n) + len("proc__=_") - of nkDo: result = lsons(n) + len("do__:_") - of nkConstDef, nkIdentDefs: - result = lcomma(n, 0, - 3) - var L = sonsLen(n) - if n.sons[L - 2].kind != nkEmpty: result = result + lsub(n.sons[L - 2]) + 2 - if n.sons[L - 1].kind != nkEmpty: result = result + lsub(n.sons[L - 1]) + 3 - of nkVarTuple: result = lcomma(n, 0, - 3) + len("() = ") + lsub(lastSon(n)) - of nkChckRangeF: result = len("chckRangeF") + 2 + lcomma(n) - of nkChckRange64: result = len("chckRange64") + 2 + lcomma(n) - of nkChckRange: result = len("chckRange") + 2 + lcomma(n) - of nkObjDownConv, nkObjUpConv, nkStringToCString, nkCStringToString: + result = if n.len > 0: lcomma(g, n) + 2 else: len("{:}") + of nkClosedSymChoice, nkOpenSymChoice: + if n.len > 0: result += lsub(g, n[0]) + of nkOpenSym: result = lsub(g, n[0]) + of nkTupleTy: result = lcomma(g, n) + len("tuple[]") + of nkTupleClassTy: result = len("tuple") + of nkDotExpr: result = lsons(g, n) + 1 + 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[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) + 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: result = 2 - if sonsLen(n) >= 1: result = result + lsub(n.sons[0]) - result = result + lcomma(n, 1) - of nkExprColonExpr: result = lsons(n) + 2 - of nkInfix: result = lsons(n) + 2 - of nkPrefix: result = lsons(n) + 1 - of nkPostfix: result = lsons(n) - of nkCallStrLit: result = lsons(n) - of nkPragmaExpr: result = lsub(n.sons[0]) + lcomma(n, 1) - of nkRange: result = lsons(n) + 2 - of nkDerefExpr: result = lsub(n.sons[0]) + 2 - of nkAccQuoted: result = lsons(n) + 2 - of nkIfExpr: - result = lsub(n.sons[0].sons[0]) + lsub(n.sons[0].sons[1]) + lsons(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[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[0]) + lcomma(g, n, 1) + of nkRange: result = lsons(g, n) + 2 + of nkDerefExpr: result = lsub(g, n[0]) + 2 + of nkAccQuoted: result = lsons(g, n) + 2 + of nkIfExpr: + result = lsub(g, n[0][0]) + lsub(g, n[0][1]) + lsons(g, n, 1) + len("if_:_") - of nkElifExpr: result = lsons(n) + len("_elif_:_") - of nkElseExpr: result = lsub(n.sons[0]) + len("_else:_") # type descriptions - of nkTypeOfExpr: result = lsub(n.sons[0]) + len("type_") - of nkRefTy: result = lsub(n.sons[0]) + len("ref_") - of nkPtrTy: result = lsub(n.sons[0]) + len("ptr_") - of nkVarTy: result = lsub(n.sons[0]) + len("var_") - of nkDistinctTy: result = lsub(n.sons[0]) + len("Distinct_") - of nkTypeDef: result = lsons(n) + 3 - of nkOfInherit: result = lsub(n.sons[0]) + len("of_") - of nkProcTy: result = lsons(n) + len("proc_") - of nkIteratorTy: result = lsons(n) + len("iterator_") - of nkSharedTy: result = lsons(n) + len("shared_") - of nkEnumTy: - if sonsLen(n) > 0: - result = lsub(n.sons[0]) + lcomma(n, 1) + len("enum_") + of nkElifExpr: result = lsons(g, n) + len("_elif_:_") + 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[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[0]) else: 0) + + len("static[]") + of nkTypeDef: result = lsons(g, n) + 3 + 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 nkSinkAsgn: result = lsons(g, n) + len("`=sink`(, )") + of nkEnumTy: + if n.len > 0: + result = lsub(g, n[0]) + lcomma(g, n, 1) + len("enum_") else: result = len("enum") - of nkEnumFieldDef: result = lsons(n) + 3 - of nkVarSection, nkLetSection: - if sonsLen(n) > 1: result = maxLineLen + 1 - else: result = lsons(n) + len("var_") - of nkReturnStmt: result = lsub(n.sons[0]) + len("return_") - of nkRaiseStmt: result = lsub(n.sons[0]) + len("raise_") - of nkYieldStmt: result = lsub(n.sons[0]) + len("yield_") - of nkDiscardStmt: result = lsub(n.sons[0]) + len("discard_") - of nkBreakStmt: result = lsub(n.sons[0]) + len("break_") - of nkContinueStmt: result = lsub(n.sons[0]) + len("continue_") - of nkPragma: result = lcomma(n) + 4 - of nkCommentStmt: result = len(n.comment) - of nkOfBranch: result = lcomma(n, 0, - 2) + lsub(lastSon(n)) + len("of_:_") - of nkElifBranch: result = lsons(n) + len("elif_:_") - of nkElse: result = lsub(n.sons[0]) + len("else:_") - of nkFinally: result = lsub(n.sons[0]) + len("finally:_") - of nkGenericParams: result = lcomma(n) + 2 - of nkFormalParams: - result = lcomma(n, 1) + 2 - if n.sons[0].kind != nkEmpty: result = result + lsub(n.sons[0]) + 2 - of nkExceptBranch: - result = lcomma(n, 0, -2) + lsub(lastSon(n)) + len("except_:_") - else: result = maxLineLen + 1 - -proc fits(g: TSrcGen, x: int): bool = - result = x + g.lineLen <= maxLineLen - -type - TSubFlag = enum - rfLongMode, rfNoIndent, rfInConstExpr + of nkEnumFieldDef: result = lsons(g, n) + 3 + of nkVarSection, nkLetSection: + if n.len > 1: result = MaxLineLen + 1 + else: result = lsons(g, n) + len("var_") + of nkUsingStmt: + if n.len > 1: result = MaxLineLen + 1 + else: result = lsons(g, n) + len("using_") + of nkReturnStmt: + if n.len > 0 and n[0].kind == nkAsgn 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 = n.comment.len + of nkOfBranch: result = lcomma(g, n, 0, - 2) + lsub(g, lastSon(n)) + len("of_:_") + 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[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[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 <= MaxLineLen + +type + TSubFlag = enum + rfLongMode, rfInConstExpr TSubFlags = set[TSubFlag] TContext = tuple[spacing: int, flags: TSubFlags] -const +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 = +proc hasCom(n: PNode): bool = result = false - if n.comment != nil: return true + if n.isNil: return false + if n.comment.len > 0: return true case n.kind - of nkEmpty..nkNilLit: nil - else: - for i in countup(0, sonsLen(n) - 1): - if hasCom(n.sons[i]): return true - -proc putWithSpace(g: var TSrcGen, kind: TTokType, s: string) = + of nkEmpty..nkNilLit: discard + else: + for i in 0..<n.len: + if hasCom(n[i]): return true + +proc putWithSpace(g: var TSrcGen, kind: TokType, s: string) = put(g, kind, s) put(g, tkSpaces, Space) -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(n.sons[i]) + ord(c) - if not fits(g, sublen) and (ind + sublen < maxLineLen): optNL(g, ind) +proc isHideable(config: ConfigRef, n: PNode): bool = + # xxx compare `ident` directly with `getIdent(cache, wRaises)`, but + # this requires a `cache`. + case n.kind + of nkExprColonExpr: + result = n[0].kind == nkIdent and + n[0].ident.s.nimIdentNormalize in ["raises", "tags", "extern", "deprecated", "forbids", "stacktrace"] + of nkIdent: result = n.ident.s in ["gcsafe", "deprecated"] + else: result = false + +proc gcommaAux(g: var TSrcGen, n: PNode, ind: int, start: int = 0, + theEnd: int = - 1, separator = tkComma) = + let inPragma = g.inPragma == 1 # just the top-level + var inHideable = false + for i in start..n.len + theEnd: + 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) = +proc gcomma(g: var TSrcGen, n: PNode, c: TContext, start: int = 0, + theEnd: int = -1) = var ind: int - if rfInConstExpr in c.flags: - ind = g.indent + indentWidth - else: + if rfInConstExpr in c.flags: + ind = g.indent + IndentWidth + else: ind = g.lineLen - if ind > maxLineLen div 2: ind = g.indent + longIndentWid + if ind > MaxLineLen div 2: ind = g.indent + longIndentWid gcommaAux(g, n, ind, start, theEnd) -proc gcomma(g: var TSrcGen, n: PNode, start: int = 0, theEnd: int = - 1) = +proc gcomma(g: var TSrcGen, n: PNode, start: int = 0, theEnd: int = - 1) = var ind = g.lineLen - if ind > maxLineLen div 2: ind = g.indent + longIndentWid + if ind > MaxLineLen div 2: ind = g.indent + longIndentWid gcommaAux(g, n, ind, start, theEnd) -proc gsemicolon(g: var TSrcGen, n: PNode, start: int = 0, theEnd: int = - 1) = +proc gsemicolon(g: var TSrcGen, n: PNode, start: int = 0, theEnd: int = - 1) = var ind = g.lineLen - if ind > maxLineLen div 2: ind = g.indent + longIndentWid - gcommaAux(g, n, ind, start, theEnd, tkSemicolon) + if ind > MaxLineLen div 2: ind = g.indent + longIndentWid + gcommaAux(g, n, ind, start, theEnd, tkSemiColon) -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) +proc gsons(g: var TSrcGen, n: PNode, c: TContext, start: int = 0, + theEnd: int = - 1) = + for i in start..n.len + theEnd: gsub(g, n[i], c) -proc gsection(g: var TSrcGen, n: PNode, c: TContext, kind: TTokType, - k: string) = - if sonsLen(n) == 0: return # empty var sections are possible +proc gsection(g: var TSrcGen, n: PNode, c: TContext, kind: TokType, + k: string) = + 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(n: PNode, start: int = 0, theEnd: int = - 1): bool = - result = n.comment != nil - if not result: +proc longMode(g: TSrcGen; n: PNode, start: int = 0, theEnd: int = - 1): bool = + result = shouldRenderComment(g, n) + if not result: # check further - for i in countup(start, sonsLen(n) + theEnd): - if (lsub(n.sons[i]) > maxLineLen): + for i in start..n.len + theEnd: + if (lsub(g, n[i]) > MaxLineLen): result = true - break + break -proc gstmts(g: var TSrcGen, n: PNode, c: TContext) = - if n.kind == nkEmpty: return - if (n.kind == nkStmtList) or (n.kind == nkStmtListExpr): - indentNL(g) - for i in countup(0, sonsLen(n) - 1): - optNL(g) - gsub(g, n.sons[i]) +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) + for i in 0..<n.len: + if i > 0: + optNL(g, n[i-1], n[i]) + else: + optNL(g) + if n[i].kind in {nkStmtList, nkStmtListExpr, nkStmtListType}: + gstmts(g, n[i], c, doIndent=false) + else: + gsub(g, n[i], fromStmtList = true) gcoms(g) - dedent(g) - else: - if rfLongMode in c.flags: indentNL(g) + if doIndent: dedent(g) + else: + indentNL(g) gsub(g, n) gcoms(g) + dedent(g) optNL(g) - if rfLongMode in c.flags: dedent(g) - -proc gif(g: var TSrcGen, n: PNode) = - var c: TContext - gsub(g, n.sons[0].sons[0]) - initContext(c) + + +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 = initContext() + gcond(g, n[0][0]) putWithSpace(g, tkColon, ":") - if longMode(n) or (lsub(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 +proc gwhile(g: var TSrcGen, n: PNode) = + var c: TContext = initContext() putWithSpace(g, tkWhile, "while") - gsub(g, n.sons[0]) + gcond(g, n[0]) putWithSpace(g, tkColon, ":") - initContext(c) - if longMode(n) or (lsub(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 +proc gpattern(g: var TSrcGen, n: PNode) = + var c: TContext = initContext() put(g, tkCurlyLe, "{") - initContext(c) - if longMode(n) or (lsub(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, c) put(g, tkCurlyRi, "}") -proc gpragmaBlock(g: var TSrcGen, n: PNode) = - var c: TContext - gsub(g, n.sons[0]) +proc gpragmaBlock(g: var TSrcGen, n: PNode) = + var c: TContext = initContext() + gsub(g, n[0]) putWithSpace(g, tkColon, ":") - initContext(c) - if longMode(n) or (lsub(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 +proc gtry(g: var TSrcGen, n: PNode) = + var c: TContext = initContext() put(g, tkTry, "try") putWithSpace(g, tkColon, ":") - initContext(c) - if longMode(n) or (lsub(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) +proc gfor(g: var TSrcGen, n: PNode) = + var c: TContext = initContext() putWithSpace(g, tkFor, "for") - initContext(c) - if longMode(n) or - (lsub(n.sons[length - 1]) + lsub(n.sons[length - 2]) + 6 + g.lineLen > - maxLineLen): + if longMode(g, n) or + (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) - -proc gmacro(g: var TSrcGen, n: PNode) = - var c: TContext - initContext(c) - gsub(g, n.sons[0]) - putWithSpace(g, tkColon, ":") - if longMode(n) or (lsub(n.sons[1]) + g.lineLen > maxLineLen): - incl(c.flags, rfLongMode) - gcoms(g) - gsons(g, n, c, 1) + gstmts(g, n[^1], c) -proc gcase(g: var TSrcGen, n: PNode) = - var c: TContext - initContext(c) - var length = sonsLen(n) - var last = if n.sons[length-1].kind == nkElse: -2 else: -1 - if longMode(n, 0, last): incl(c.flags, rfLongMode) +proc gcase(g: var TSrcGen, n: PNode) = + 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(n.sons[length - 1]): incl(c.flags, rfLongMode) - gsub(g, n.sons[length - 1], c) - -proc gproc(g: var TSrcGen, n: PNode) = - var c: TContext - if n.sons[namePos].kind == nkSym: - put(g, tkSymbol, renderDefinitionName(n.sons[namePos].sym)) + if last == - 2: + 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 = 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[namePos]) - - if n.sons[patternPos].kind != nkEmpty: - gpattern(g, n.sons[patternPos]) - let oldCheckAnon = g.checkAnon - g.checkAnon = true - gsub(g, n.sons[genericParamsPos]) - g.checkAnon = oldCheckAnon - 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) gcoms(g) dedent(g) -proc gblock(g: var TSrcGen, n: PNode) = - var c: TContext - initContext(c) - if n.sons[0].kind != nkEmpty: +proc gTypeClassTy(g: var TSrcGen, n: PNode) = + var c: TContext = initContext() + putWithSpace(g, tkConcept, "concept") + gsons(g, n[0], c) # arglist + gsub(g, n[1]) # pragmas + gsub(g, n[2]) # of + gcoms(g) + indentNL(g) + gcoms(g) + gstmts(g, n[3], c) + dedent(g) + +proc gblock(g: var TSrcGen, n: PNode) = + # 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(n) or (lsub(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 +proc gstaticStmt(g: var TSrcGen, n: PNode) = + var c: TContext = initContext() putWithSpace(g, tkStatic, "static") putWithSpace(g, tkColon, ":") - initContext(c) - if longMode(n) or (lsub(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) = +proc gasm(g: var TSrcGen, n: PNode) = putWithSpace(g, tkAsm, "asm") - gsub(g, n.sons[0]) + gsub(g, n[0]) gcoms(g) - gsub(g, n.sons[1]) + if n.len > 1: + gsub(g, n[1]) proc gident(g: var TSrcGen, n: PNode) = - if g.checkAnon and n.kind == nkSym and sfAnon in n.sym.flags: return - var t: TTokType - var s = atom(n) - if (s[0] in lexer.SymChars): - if (n.kind == nkIdent): + 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: TokType + var s = atom(g, n) + if s.len > 0 and s[0] in lexer.SymChars: + if n.kind == nkIdent: if (n.ident.id < ord(tokKeywordLow) - ord(tkSymbol)) or - (n.ident.id > ord(tokKeywordHigh) - ord(tkSymbol)): + (n.ident.id > ord(tokKeywordHigh) - ord(tkSymbol)): t = tkSymbol - else: - t = TTokType(n.ident.id + ord(tkSymbol)) - else: + else: + t = TokType(n.ident.id + ord(tkSymbol)) + else: t = tkSymbol - else: + else: t = tkOpr - put(g, t, s) - if n.kind == nkSym and renderIds in g.flags: put(g, tkIntLit, $n.sym.id) + 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): + 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: put(g, tkParLe, "(") gsemicolon(g, params, 1) put(g, tkParRi, ")") - - if 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: + gsub(g, n[i]) + else: + put(g, tkOpr, "<<" & $i & "th child missing for " & $n.kind & " >>") + +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, ")") -proc gsub(g: var TSrcGen, n: PNode, c: TContext) = +const postExprBlocks = {nkStmtList, nkStmtListExpr, + nkOfBranch, nkElifBranch, nkElse, + nkExceptBranch, nkFinally, nkDo} + +proc postStatements(g: var TSrcGen, n: PNode, i: int, fromStmtList: bool) = + var i = i + if n[i].kind in {nkStmtList, nkStmtListExpr}: + if fromStmtList: + put(g, tkColon, ":") + else: + put(g, tkSpaces, Space) + put(g, tkDo, "do") + put(g, tkColon, ":") + gsub(g, n, i) + i.inc + for j in i ..< n.len: + if n[j].kind == nkDo: + optNL(g) + elif n[j].kind in {nkStmtList, nkStmtListExpr}: + optNL(g) + put(g, tkDo, "do") + put(g, tkColon, ":") + gsub(g, n, j) + +proc isCustomLit(n: PNode): bool = + if n.len == 2 and n[0].kind == nkRStrLit: + let ident = n[1].getPIdent + result = ident != nil and ident.s.startsWith('\'') + else: + result = false + +proc gsub(g: var TSrcGen, n: PNode, c: TContext, fromStmtList = false) = if isNil(n): return var - a: TContext - if n.comment != nil: pushCom(g, n) + a: TContext = default(TContext) + if shouldRenderComment(g, n): pushCom(g, n) case n.kind # atoms: - of nkTripleStrLit: putRawStr(g, tkTripleStrLit, n.strVal) - of nkEmpty: nil - of nkType: put(g, tkInvalid, atom(n)) + of nkTripleStrLit: put(g, tkTripleStrLit, atom(g, n)) + of nkEmpty: discard + of nkType: put(g, tkInvalid, atom(g, n)) of nkSym, nkIdent: gident(g, n) - of nkIntLit: put(g, tkIntLit, atom(n)) - of nkInt8Lit: put(g, tkInt8Lit, atom(n)) - of nkInt16Lit: put(g, tkInt16Lit, atom(n)) - of nkInt32Lit: put(g, tkInt32Lit, atom(n)) - of nkInt64Lit: put(g, tkInt64Lit, atom(n)) - of nkUIntLit: put(g, tkUIntLit, atom(n)) - of nkUInt8Lit: put(g, tkUInt8Lit, atom(n)) - of nkUInt16Lit: put(g, tkUInt16Lit, atom(n)) - of nkUInt32Lit: put(g, tkUInt32Lit, atom(n)) - of nkUInt64Lit: put(g, tkUInt64Lit, atom(n)) - of nkFloatLit: put(g, tkFloatLit, atom(n)) - of nkFloat32Lit: put(g, tkFloat32Lit, atom(n)) - of nkFloat64Lit: put(g, tkFloat64Lit, atom(n)) - of nkFloat128Lit: put(g, tkFloat128Lit, atom(n)) - of nkStrLit: put(g, tkStrLit, atom(n)) - of nkRStrLit: put(g, tkRStrLit, atom(n)) - of nkCharLit: put(g, tkCharLit, atom(n)) - of nkNilLit: put(g, tkNil, atom(n)) # complex expressions + of nkIntLit: put(g, tkIntLit, atom(g, n)) + of nkInt8Lit: put(g, tkInt8Lit, atom(g, n)) + of nkInt16Lit: put(g, tkInt16Lit, atom(g, n)) + of nkInt32Lit: put(g, tkInt32Lit, atom(g, n)) + of nkInt64Lit: put(g, tkInt64Lit, atom(g, n)) + of nkUIntLit: put(g, tkUIntLit, atom(g, n)) + of nkUInt8Lit: put(g, tkUInt8Lit, atom(g, n)) + of nkUInt16Lit: put(g, tkUInt16Lit, atom(g, n)) + of nkUInt32Lit: put(g, tkUInt32Lit, atom(g, n)) + of nkUInt64Lit: put(g, tkUInt64Lit, atom(g, n)) + of nkFloatLit: put(g, tkFloatLit, atom(g, n)) + of nkFloat32Lit: put(g, tkFloat32Lit, atom(g, n)) + of nkFloat64Lit: put(g, tkFloat64Lit, atom(g, n)) + of nkFloat128Lit: put(g, tkFloat128Lit, atom(g, n)) + of nkStrLit: put(g, tkStrLit, atom(g, n)) + of nkRStrLit: put(g, tkRStrLit, atom(g, n)) + 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 sonsLen(n) >= 1: gsub(g, n.sons[0]) - put(g, tkParLe, "(") - gcomma(g, n, 1) - put(g, tkParRi, ")") - of nkCallStrLit: - gsub(g, n.sons[0]) - if n.sons[1].kind == nkRStrLit: + 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, 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, ")") + else: + put(g, tkParLe, "(") + put(g, tkParRi, ")") + of nkCallStrLit: + 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.sons[1]) - of nkCast: + else: + gsub(g, n, 1) + of nkHiddenStdConv, nkHiddenSubConv: + if n.len >= 2: + 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.sons[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.sons[1]) + gsub(g, n, 1) put(g, tkParRi, ")") - of nkAddr: + of nkAddr: put(g, tkAddr, "addr") - put(g, tkParLe, "(") - gsub(g, n.sons[0]) - put(g, tkParRi, ")") + if n.len > 0: + put(g, tkParLe, "(") + gsub(g, n[0]) + put(g, tkParRi, ")") of nkStaticExpr: put(g, tkStatic, "static") - put(g, tkSpaces, space) - gsub(g, n.sons[0]) - of nkBracketExpr: - gsub(g, n.sons[0]) + put(g, tkSpaces, Space) + gsub(g, n, 0) + of nkBracketExpr: + gsub(g, n, 0) put(g, tkBracketLe, "[") gcomma(g, n, 1) put(g, tkBracketRi, "]") of nkCurlyExpr: - gsub(g, n.sons[0]) + gsub(g, n, 0) put(g, tkCurlyLe, "{") gcomma(g, n, 1) put(g, tkCurlyRi, "}") - of nkPragmaExpr: - gsub(g, n.sons[0]) - gcomma(g, n, 1) - of nkCommand: - gsub(g, n.sons[0]) - put(g, tkSpaces, space) + of nkPragmaExpr: + gsub(g, n, 0) gcomma(g, n, 1) - of nkExprEqExpr, nkAsgn, nkFastAsgn: - gsub(g, n.sons[0]) + of nkCommand: + accentedName(g, n[0]) + put(g, tkSpaces, Space) + 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.sons[1]) - of nkChckRangeF: + 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, "(") gcomma(g, n) put(g, tkParRi, ")") - of nkChckRange64: + of nkChckRange64: put(g, tkSymbol, "chckRange64") put(g, tkParLe, "(") gcomma(g, n) put(g, tkParRi, ")") - of nkChckRange: + of nkChckRange: put(g, tkSymbol, "chckRange") 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 0..<n.len: + if i > 0: put(g, tkOpr, "|") + 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[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, "(") - for i in countup(0, sonsLen(n) - 1): - if i > 0: put(g, tkOpr, "|") - gsub(g, n.sons[i], c) + gcomma(g, n, c) put(g, tkParRi, ")") - of nkPar, nkClosure: + of nkTupleConstr: put(g, tkParLe, "(") gcomma(g, n, c) + if n.len == 1 and n[0].kind != nkExprColonExpr: put(g, tkComma, ",") put(g, tkParRi, ")") - of nkCurly: + of nkCurly: put(g, tkCurlyLe, "{") gcomma(g, n, c) put(g, tkCurlyRi, "}") @@ -883,173 +1306,275 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = put(g, tkBracketLe, "[") gcomma(g, n, c) put(g, tkBracketRi, "]") - of nkDotExpr: - gsub(g, n.sons[0]) - put(g, tkDot, ".") - gsub(g, n.sons[1]) - of nkBind: + of nkDotExpr: + 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.sons[0]) - of nkCheckedFieldExpr, nkHiddenAddr, nkHiddenDeref: - gsub(g, n.sons[0]) + gsub(g, n, 0) + of nkCheckedFieldExpr, nkHiddenAddr, nkHiddenDeref, nkStringToCString, nkCStringToString: + if renderIds in g.flags: + put(g, tkAddr, $n.kind) + put(g, tkParLe, "(") + gsub(g, n, 0) + if renderIds in g.flags: + put(g, tkParRi, ")") + of nkLambda: - putWithSpace(g, tkLambda, "proc") - gsub(g, n.sons[paramsPos]) - gsub(g, n.sons[pragmasPos]) + putWithSpace(g, tkProc, "proc") + gsub(g, n, paramsPos) + gsub(g, n, pragmasPos) put(g, tkSpaces, Space) putWithSpace(g, tkEquals, "=") - gsub(g, n.sons[bodyPos]) + gsub(g, n, bodyPos) of nkDo: putWithSpace(g, tkDo, "do") - doParamsAux(g, n.sons[paramsPos]) - gsub(g, n.sons[pragmasPos]) + if paramsPos < n.len: + doParamsAux(g, n[paramsPos]) + gsub(g, n, pragmasPos) put(g, tkColon, ":") - gsub(g, n.sons[bodyPos]) - of nkConstDef, nkIdentDefs: + gsub(g, n, bodyPos) + 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 n.sons[L - 2].kind != nkEmpty: + if n.len >= 2 and n[^2].kind != nkEmpty: putWithSpace(g, tkColon, ":") - gsub(g, n.sons[L - 2]) - if 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) - 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) - of nkExprColonExpr: - gsub(g, n.sons[0]) + gsub(g, n[^1], c) + of nkVarTuple: + 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.sons[1]) - of nkInfix: - gsub(g, n.sons[1]) + gsub(g, n, 1) + of nkInfix: + if n.len < 3: + var i = 0 + put(g, tkOpr, "Too few children for nkInfix") + return + let oldLineLen = g.lineLen # we cache this because lineLen gets updated below + infixArgument(g, n, 1) put(g, tkSpaces, Space) - gsub(g, n.sons[0]) # binary operator - if not fits(g, lsub(n.sons[2]) + lsub(n.sons[0]) + 1): + gsub(g, n, 0) # binary operator + # 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: + else: put(g, tkSpaces, Space) - gsub(g, n.sons[2]) - of nkPrefix: - gsub(g, n.sons[0]) + 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: - put(g, tkSpaces, space) - gsub(g, n.sons[1]) - of nkPostfix: - gsub(g, n.sons[1]) - gsub(g, n.sons[0]) - of nkRange: - gsub(g, n.sons[0]) + let opr = if n[0].kind == nkIdent: n[0].ident + elif n[0].kind == nkSym: n[0].sym.name + elif n[0].kind in {nkOpenSymChoice, nkClosedSymChoice}: n[0][0].sym.name + else: nil + let nNext = skipHiddenNodes(n[1]) + if nNext.kind == nkPrefix or (opr != nil and renderer.isKeyword(opr)): + put(g, tkSpaces, Space) + if nNext.kind == nkInfix: + put(g, tkParLe, "(") + gsub(g, n[1]) + put(g, tkParRi, ")") + else: + gsub(g, n[1]) + if n.len > 2 and n.lastSon.kind in postExprBlocks: + var i = 2 + while i < n.len and n[i].kind notin postExprBlocks: i.inc + postStatements(g, n, i, fromStmtList) + of nkPostfix: + gsub(g, n, 1) + if renderNoPostfix notin g.flags: + gsub(g, n, 0) + of nkRange: + gsub(g, n, 0) put(g, tkDotDot, "..") - gsub(g, n.sons[1]) + gsub(g, n, 1) of nkDerefExpr: - gsub(g, n.sons[0]) + gsub(g, n, 0) 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: + of nkIfExpr: putWithSpace(g, tkIf, "if") - gsub(g, n.sons[0].sons[0]) + if n.len > 0: gcond(g, n[0][0]) putWithSpace(g, tkColon, ":") - gsub(g, n.sons[0].sons[1]) + if n.len > 0: gsub(g, n[0], 1) gsons(g, n, emptyContext, 1) - of nkElifExpr: + of nkElifExpr: putWithSpace(g, tkElif, " elif") - gsub(g, n.sons[0]) + gcond(g, n[0]) putWithSpace(g, tkColon, ":") - gsub(g, n.sons[1]) - of nkElseExpr: + gsub(g, n, 1) + of nkElseExpr: put(g, tkElse, " else") putWithSpace(g, tkColon, ":") - gsub(g, n.sons[0]) - of nkTypeOfExpr: - putWithSpace(g, tkType, "type") - gsub(g, n.sons[0]) - of nkRefTy: - if sonsLen(n) > 0: + gsub(g, n, 0) + of nkTypeOfExpr: + put(g, tkType, "typeof") + put(g, tkParLe, "(") + if n.len > 0: gsub(g, n[0]) + put(g, tkParRi, ")") + of nkRefTy: + 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: + of nkPtrTy: + 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: + of nkVarTy: + if n.len > 0: putWithSpace(g, tkVar, "var") - gsub(g, n.sons[0]) + gsub(g, n[0]) else: put(g, tkVar, "var") - of nkDistinctTy: - if sonsLen(n) > 0: + 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") + else: + putWithSpace(g, tkSymbol, " without") + gcomma(g, n[1]) else: put(g, tkDistinct, "distinct") - of nkTypeDef: - gsub(g, n.sons[0]) - gsub(g, n.sons[1]) + of nkTypeDef: + 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.sons[2].kind != nkEmpty: + if n.len > 2 and n[2].kind != nkEmpty: putWithSpace(g, tkEquals, "=") - gsub(g, n.sons[2]) - of nkObjectTy: - if sonsLen(n) > 0: + gsub(g, n[2]) + of nkObjectTy: + 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): + of nkRecList: + 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: + of nkOfInherit: putWithSpace(g, tkOf, "of") - gsub(g, n.sons[0]) - of nkProcTy: - if sonsLen(n) > 0: + gsub(g, n, 0) + of nkProcTy: + if n.len > 0: putWithSpace(g, tkProc, "proc") - gsub(g, n.sons[0]) - gsub(g, n.sons[1]) + 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.sons[0]) - gsub(g, n.sons[1]) + gsub(g, n, 0) + gsub(g, n, 1) else: put(g, tkIterator, "iterator") - of nkSharedTy: - if sonsLen(n) > 0: - putWithSpace(g, tkShared, "shared") - gsub(g, n.sons[0]) - else: - put(g, tkShared, "shared") + of nkStaticTy: + put(g, tkStatic, "static") + put(g, tkBracketLe, "[") + if n.len > 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) @@ -1057,89 +1582,106 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = dedent(g) else: put(g, tkEnum, "enum") - of nkEnumFieldDef: - gsub(g, n.sons[0]) + of nkEnumFieldDef: + gsub(g, n, 0) put(g, tkSpaces, Space) putWithSpace(g, tkEquals, "=") - gsub(g, n.sons[1]) - of nkStmtList, nkStmtListExpr: gstmts(g, n, emptyContext) - of nkIfStmt: + gsub(g, n, 1) + 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) - of nkWhen, nkRecWhen: + of nkWhen, nkRecWhen: putWithSpace(g, tkWhen, "when") gif(g, n) 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) of nkAsmStmt: gasm(g, n) - of nkProcDef: - putWithSpace(g, tkProc, "proc") + of nkProcDef: + if renderNoProcDefs notin g.flags: putWithSpace(g, tkProc, "proc") + gproc(g, n) + of nkFuncDef: + if renderNoProcDefs notin g.flags: putWithSpace(g, tkFunc, "func") gproc(g, n) of nkConverterDef: - putWithSpace(g, tkConverter, "converter") + if renderNoProcDefs notin g.flags: putWithSpace(g, tkConverter, "converter") gproc(g, n) - of nkMethodDef: - putWithSpace(g, tkMethod, "method") + of nkMethodDef: + if renderNoProcDefs notin g.flags: putWithSpace(g, tkMethod, "method") gproc(g, n) - of nkIteratorDef: - putWithSpace(g, tkIterator, "iterator") + of nkIteratorDef: + if renderNoProcDefs notin g.flags: putWithSpace(g, tkIterator, "iterator") gproc(g, n) - of nkMacroDef: - putWithSpace(g, tkMacro, "macro") + of nkMacroDef: + if renderNoProcDefs notin g.flags: putWithSpace(g, tkMacro, "macro") gproc(g, n) - of nkTemplateDef: - putWithSpace(g, tkTemplate, "template") + of nkTemplateDef: + if renderNoProcDefs notin g.flags: putWithSpace(g, tkTemplate, "template") gproc(g, n) - of nkTypeSection: + of nkTypeSection: gsection(g, n, emptyContext, tkType, "type") - of nkConstSection: - initContext(a) + of nkConstSection: + a = initContext() incl(a.flags, rfInConstExpr) gsection(g, n, a, tkConst, "const") - of nkVarSection, nkLetSection: - var L = sonsLen(n) - if L == 0: return + of nkVarSection, nkLetSection, nkUsingStmt: + if n.len == 0: return if n.kind == nkVarSection: putWithSpace(g, tkVar, "var") - else: putWithSpace(g, tkLet, "let") - if L > 1: + elif n.kind == nkLetSection: putWithSpace(g, tkLet, "let") + else: putWithSpace(g, tkUsing, "using") + 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]) - of nkReturnStmt: + else: + gsub(g, n[0]) + of nkReturnStmt: putWithSpace(g, tkReturn, "return") - gsub(g, n.sons[0]) - of nkRaiseStmt: + 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.sons[0]) - of nkYieldStmt: + gsub(g, n, 0) + of nkYieldStmt: putWithSpace(g, tkYield, "yield") - gsub(g, n.sons[0]) - of nkDiscardStmt: + gsub(g, n, 0) + of nkDiscardStmt: putWithSpace(g, tkDiscard, "discard") - gsub(g, n.sons[0]) - of nkBreakStmt: + gsub(g, n, 0) + of nkBreakStmt: putWithSpace(g, tkBreak, "break") - gsub(g, n.sons[0]) - of nkContinueStmt: + gsub(g, n, 0) + of nkContinueStmt: putWithSpace(g, tkContinue, "continue") - gsub(g, n.sons[0]) - of nkPragma: - if renderNoPragmas notin g.flags: + gsub(g, n, 0) + of nkPragma: + 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") @@ -1155,128 +1697,187 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = putWithSpace(g, tkImport, "import") else: putWithSpace(g, tkExport, "export") - gsub(g, n.sons[0]) + gsub(g, n, 0) put(g, tkSpaces, Space) putWithSpace(g, tkExcept, "except") gcommaAux(g, n, g.indent, 1) gcoms(g) putNL(g) - of nkFromStmt: + of nkFromStmt: putWithSpace(g, tkFrom, "from") - gsub(g, n.sons[0]) + gsub(g, n, 0) put(g, tkSpaces, Space) putWithSpace(g, tkImport, "import") gcomma(g, n, emptyContext, 1) putNL(g) - of nkIncludeStmt: + of nkIncludeStmt: putWithSpace(g, tkInclude, "include") gcoms(g) indentNL(g) gcommaAux(g, n, g.indent) dedent(g) putNL(g) - of nkCommentStmt: + of nkCommentStmt: gcoms(g) optNL(g) - of nkOfBranch: + of nkOfBranch: optNL(g) putWithSpace(g, tkOf, "of") gcomma(g, n, c, 0, - 2) putWithSpace(g, tkColon, ":") gcoms(g) gstmts(g, lastSon(n), c) - of nkBindStmt: + of nkImportAs: + gsub(g, n, 0) + put(g, tkSpaces, Space) + putWithSpace(g, tkAs, "as") + gsub(g, n, 1) + of nkBindStmt: putWithSpace(g, tkBind, "bind") gcomma(g, n, c) of nkMixinStmt: putWithSpace(g, tkMixin, "mixin") gcomma(g, n, c) - of nkElifBranch: + of nkElifBranch: optNL(g) putWithSpace(g, tkElif, "elif") - gsub(g, n.sons[0]) + gsub(g, n, 0) putWithSpace(g, tkColon, ":") gcoms(g) - gstmts(g, n.sons[1], c) - of nkElse: + gstmts(g, n[1], c) + of nkElse: optNL(g) put(g, tkElse, "else") putWithSpace(g, tkColon, ":") gcoms(g) - gstmts(g, n.sons[0], c) - of nkFinally: + gstmts(g, n[0], c) + of nkFinally, nkDefer: optNL(g) - put(g, tkFinally, "finally") + if n.kind == nkFinally: + put(g, tkFinally, "finally") + else: + put(g, tkDefer, "defer") putWithSpace(g, tkColon, ":") gcoms(g) - gstmts(g, n.sons[0], c) - of nkExceptBranch: + gstmts(g, n[0], c) + of nkExceptBranch: optNL(g) - putWithSpace(g, tkExcept, "except") - gcomma(g, n, 0, - 2) + if n.len != 1: + putWithSpace(g, tkExcept, "except") + else: + put(g, tkExcept, "except") + gcomma(g, n, 0, -2) putWithSpace(g, tkColon, ":") gcoms(g) gstmts(g, lastSon(n), c) - of nkGenericParams: - put(g, tkBracketLe, "[") - gcomma(g, n) - put(g, tkBracketRi, "]") - of nkFormalParams: + of nkGenericParams: + proc hasExplicitParams(gp: PNode): bool = + for p in gp: + if p.typ == nil or tfImplicitTypeParam notin p.typ.flags: + return true + return false + + if n.hasExplicitParams: + put(g, tkBracketLe, "[") + gsemicolon(g, n) + put(g, tkBracketRi, "]") + of nkFormalParams: put(g, tkParLe, "(") gsemicolon(g, n, 1) put(g, tkParRi, ")") - if n.sons[0].kind != nkEmpty: + if n.len > 0 and n[0].kind != nkEmpty: putWithSpace(g, tkColon, ":") - gsub(g, n.sons[0]) - of nkTupleTy: + gsub(g, n[0]) + of nkTupleTy: put(g, tkTuple, "tuple") - if sonsLen(n) > 0: - put(g, tkBracketLe, "[") - gcomma(g, n) - put(g, tkBracketRi, "]") - else: - #nkNone, nkMetaNode, nkExplicitTypeListCall: - InternalError(n.info, "rnimsyn.gsub(" & $n.kind & ')') + put(g, tkBracketLe, "[") + gcomma(g, n) + put(g, tkBracketRi, "]") + of nkTupleClassTy: + put(g, tkTuple, "tuple") + of nkComesFrom: + put(g, tkParLe, "(ComesFrom|") + gsub(g, n, 0) + put(g, tkParRi, ")") + of nkGotoState: + var c: TContext = initContext() + putWithSpace g, tkSymbol, "goto" + gsons(g, n, c) + of nkState: + var c: TContext = initContext() + putWithSpace g, tkSymbol, "state" + gsub(g, n[0], c) + putWithSpace(g, tkColon, ":") + indentNL(g) + gsons(g, n, c, 1) + dedent(g) -proc renderTree(n: PNode, renderFlags: TRenderFlags = {}): string = - var g: TSrcGen - initSrcGen(g, renderFlags) - gsub(g, n) + 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, "renderer.gsub(" & $n.kind & ')') + +proc renderTree*(n: PNode, renderFlags: TRenderFlags = {}): string = + 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: + if n.kind in {nkStmtList, nkStmtListExpr, nkStmtListType}: + gstmts(g, n, emptyContext, doIndent = false) + else: + gsub(g, n) result = g.buf -proc renderModule(n: PNode, filename: string, - renderFlags: TRenderFlags = {}) = +proc `$`*(n: PNode): string = n.renderTree + +proc renderModule*(n: PNode, outfile: string, + renderFlags: TRenderFlags = {}; + fid = FileIndex(-1); + conf: ConfigRef = nil) = var - f: tfile - g: TSrcGen - initSrcGen(g, renderFlags) - for i in countup(0, sonsLen(n) - 1): - gsub(g, n.sons[i]) + f: File = default(File) + g: TSrcGen = initSrcGen(renderFlags, conf) + g.fid = fid + 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: nil + else: discard gcoms(g) - if optStdout in gGlobalOptions: - write(stdout, g.buf) - elif open(f, filename, fmWrite): + if open(f, outfile, fmWrite): write(f, g.buf) close(f) else: - rawMessage(errCannotOpenFile, filename) + rawMessage(g.config, errGenerated, "cannot open file: " & outfile) -proc initTokRender(r: var TSrcGen, n: PNode, renderFlags: TRenderFlags = {}) = - initSrcGen(r, renderFlags) - 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: + 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 new file mode 100644 index 000000000..2f7c04af1 --- /dev/null +++ b/compiler/reorder.nim @@ -0,0 +1,435 @@ + +import + 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 + id, idx, lowLink: int + onStack: bool + kids: seq[DepN] + hAQ, hIS, hB, hCmd: int + when defined(nimDebugReorder): + expls: seq[string] + DepG = seq[DepN] + +when defined(nimDebugReorder): + var idNames = newTable[int, string]() + +proc newDepN(id: int, pnode: PNode): DepN = + 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 ident = n[i].getPIdent + if ident != nil: id.add(ident.s) + result = getIdent(cache, id) + +proc addDecl(cache: IdentCache; n: PNode; declares: var IntSet) = + case n.kind + of nkPostfix: addDecl(cache, n[1], declares) + of nkPragmaExpr: addDecl(cache, n[0], declares) + of nkIdent: + declares.incl n.ident.id + when defined(nimDebugReorder): + idNames[n.ident.id] = n.ident.s + of nkSym: + declares.incl n.sym.name.id + 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(nimDebugReorder): + idNames[a.id] = a.s + of nkEnumFieldDef: + addDecl(cache, n[0], declares) + else: discard + +proc computeDeps(cache: IdentCache; n: PNode, declares, uses: var IntSet; topLevel: bool) = + template deps(n) = computeDeps(cache, n, declares, uses, false) + template decl(n) = + if topLevel: addDecl(cache, n, declares) + case n.kind + of procDefs, nkMacroDef, nkTemplateDef: + decl(n[0]) + for i in 1..bodyPos: deps(n[i]) + of nkLetSection, nkVarSection, nkUsingStmt: + for a in n: + if a.kind in {nkIdentDefs, nkVarTuple}: + 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: + decl(a[0]) + for i in 1..<a.len: + if a[i].kind == nkEnumTy: + # declare enum members + for b in a[i]: + decl(b) + else: + deps(a[i]) + of nkIdentDefs: + for i in 1..<n.len: # avoid members identifiers in object definition + deps(n[i]) + of nkIdent: uses.incl n.ident.id + of nkSym: uses.incl n.sym.name.id + of nkAccQuoted: uses.incl accQuoted(cache, n).id + of nkOpenSymChoice, nkClosedSymChoice: + uses.incl n[0].sym.name.id + of nkStmtList, nkStmtListExpr, nkWhenStmt, nkElifBranch, nkElse, nkStaticStmt: + for i in 0..<n.len: computeDeps(cache, n[i], declares, uses, topLevel) + of nkPragma: + 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..<n.safeLen: deps(n[i]) + of nkMixinStmt, nkBindStmt: discard + else: + # XXX: for callables, this technically adds the return type dep before args + for i in 0..<n.safeLen: deps(n[i]) + +proc hasIncludes(n: PNode): bool = + result = false + for a in n: + if a.kind == nkIncludeStmt: + return true + +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) + +proc expandIncludes(graph: ModuleGraph, module: PSym, n: PNode, + modulePath: string, includedFiles: var IntSet): PNode = + # Parses includes and injects them in the current tree + if not n.hasIncludes: + return n + result = newNodeI(nkStmtList, n.info) + for a in n: + if a.kind == nkIncludeStmt: + for i in 0..<a.len: + var f = checkModuleName(graph.config, a[i]) + if f != InvalidFileIdx: + if containsOrIncl(includedFiles, f.int): + localError(graph.config, a.info, "recursive dependency: '$1'" % + toMsgFilename(graph.config, f)) + else: + let nn = includeModule(graph, module, f) + let nnn = expandIncludes(graph, module, nn, modulePath, + includedFiles) + excl(includedFiles, f.int) + for b in nnn: + result.add b + else: + result.add a + +proc splitSections(n: PNode): PNode = + # Split typeSections and ConstSections into + # sections that contain only one definition + assert n.kind == nkStmtList + result = newNodeI(nkStmtList, n.info) + for a in n: + if a.kind in {nkTypeSection, nkConstSection} and a.len > 1: + for b in a: + var s = newNode(a.kind) + s.info = b.info + s.add b + result.add s + else: + result.add a + +proc haveSameKind(dns: seq[DepN]): bool = + # Check if all the nodes in a strongly connected + # component have the same kind + result = true + let kind = dns[0].pnode.kind + for dn in dns: + if dn.pnode.kind != kind: + return false + +proc mergeSections(conf: ConfigRef; comps: seq[seq[DepN]], res: PNode) = + # Merges typeSections and ConstSections when they form + # a strong component (ex: circular type definition) + for c in comps: + assert c.len > 0 + if c.len == 1: + res.add c[0].pnode + else: + let fstn = c[0].pnode + let kind = fstn.kind + # always return to the original order when we got circular dependencies + let cs = c.sortedByIt(it.id) + if kind in {nkTypeSection, nkConstSection} and haveSameKind(cs): + # Circular dependency between type or const sections, we just + # need to merge them + var sn = newNode(kind) + for dn in cs: + 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. `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 + 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: + result = true + of nkStmtList, nkStmtListExpr, nkWhenStmt, nkElifBranch, nkElse, nkStaticStmt: + result = false + for a in n: + if a.hasImportStmt: + return true + else: + result = false + +proc hasImportStmt(n: DepN): bool = + if n.hIS < 0: + n.hIS = ord(n.pnode.hasImportStmt) + result = bool(n.hIS) + +proc hasCommand(n: PNode): bool = + # Checks if the node is a command or a call + # or if it contains one + case n.kind + of nkCommand, nkCall: + result = true + of nkStmtList, nkStmtListExpr, nkWhenStmt, nkElifBranch, nkElse, + nkStaticStmt, nkLetSection, nkConstSection, nkVarSection, + nkIdentDefs: + result = false + for a in n: + if a.hasCommand: + return true + else: + return false + +proc hasCommand(n: DepN): bool = + if n.hCmd < 0: + n.hCmd = ord(n.pnode.hasCommand) + 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 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 extendedProcDefs: + result = n[0].hasAccQuoted + of nkStmtList, nkStmtListExpr, nkWhenStmt, nkElifBranch, nkElse, nkStaticStmt: + result = false + for a in n: + if hasAccQuotedDef(a): + return true + else: + result = false + +proc hasAccQuotedDef(n: DepN): bool = + if n.hAQ < 0: + n.hAQ = ord(n.pnode.hasAccQuotedDef) + result = bool(n.hAQ) + +proc hasBody(n: PNode): bool = + # Checks if the node is a function, macro, template ... + # with a body or if it contains one + case n.kind + of nkCommand, nkCall: + result = true + 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 + else: + result = false + +proc hasBody(n: DepN): bool = + if n.hB < 0: + n.hB = ord(n.pnode.hasBody) + 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[i]) + for i in 0..<deps.len: + var ni = result[i] + let uses = deps[i][1] + let niHasBody = ni.hasBody + let niHasCmd = ni.hasCommand + for j in 0..<deps.len: + if i == j: continue + var nj = result[j] + let declares = deps[j][0] + if j < i and nj.hasCommand and niHasCmd: + # Preserve order for commands and calls + ni.kids.add nj + 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(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 + # on precedent function declarations that have quoted names. + # That's because it is hard to detect the use of functions + # like "[]=", "[]", "or" ... in their bodies. + ni.kids.add nj + 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(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(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], + res: var seq[seq[DepN]]) = + # Recursive part of trajan's algorithm + v.idx = idx + v.lowLink = idx + inc idx + s.add v + v.onStack = true + for w in v.kids.mitems: + if w.idx < 0: + strongConnect(w, idx, s, res) + v.lowLink = min(v.lowLink, w.lowLink) + elif w.onStack: + v.lowLink = min(v.lowLink, w.idx) + if v.lowLink == v.idx: + var comp = newSeq[DepN]() + while true: + var w = s.pop + w.onStack = false + comp.add w + if w.id == v.id: break + res.add comp + +proc getStrongComponents(g: var DepG): seq[seq[DepN]] = + ## Tarjan's algorithm. Performs a topological sort + ## and detects strongly connected components. + result = @[] + var s: seq[DepN] = @[] + var idx = 0 + for v in g.mitems: + if v.idx < 0: + strongConnect(v, idx, s, result) + +proc reorder*(graph: ModuleGraph, n: PNode, module: PSym): PNode = + var includedFiles = initIntSet() + let mpath = toFullPath(graph.config, module.fileIdx) + let n = expandIncludes(graph, module, n, mpath, + includedFiles).splitSections + result = newNodeI(nkStmtList, n.info) + var deps = newSeq[(IntSet, IntSet)](n.len) + for i in 0..<n.len: + deps[i][0] = initIntSet() + deps[i][1] = initIntSet() + computeDeps(graph.cache, n[i], deps[i][0], deps[i][1], true) + + var g = buildGraph(n, deps) + let comps = getStrongComponents(g) + mergeSections(graph.config, comps, result) diff --git a/compiler/rodread.nim b/compiler/rodread.nim deleted file mode 100644 index 562eaebab..000000000 --- a/compiler/rodread.nim +++ /dev/null @@ -1,1170 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module is responsible for loading of rod files. -# -# Reading and writing binary files are really hard to debug. Therefore we use -# a "creative" text/binary hybrid format. ROD-files are more efficient -# to process because symbols can be loaded on demand. -# -# A ROD file consists of: -# -# - a header: -# NIM:$fileversion\n -# - the module's id (even if the module changed, its ID will not!): -# ID:Ax3\n -# - CRC value of this module: -# CRC:CRC-val\n -# - a section containing the compiler options and defines this -# module has been compiled with: -# OPTIONS:options\n -# GOPTIONS:options\n # global options -# CMD:command\n -# DEFINES:defines\n -# - FILES( -# myfile.inc -# lib/mymodA -# ) -# - an include file dependency section: -# INCLUDES( -# <fileidx> <CRC of myfile.inc>\n # fileidx is the LINE in the file section! -# ) -# - a module dependency section: -# DEPS: <fileidx> <fileidx>\n -# - an interface section: -# INTERF( -# identifier1 id\n # id is the symbol's id -# identifier2 id\n -# ) -# - a compiler proc section: -# COMPILERPROCS( -# identifier1 id\n # id is the symbol's id -# ) -# - an index consisting of (ID, linenumber)-pairs: -# INDEX( -# id-diff idx-diff\n -# id-diff idx-diff\n -# ) -# -# Since the whole index has to be read in advance, we compress it by -# storing the integer differences to the last entry instead of using the -# real numbers. -# -# - an import index consisting of (ID, moduleID)-pairs: -# IMPORTS( -# id-diff moduleID-diff\n -# id-diff moduleID-diff\n -# ) -# - a list of all exported type converters because they are needed for correct -# semantic checking: -# CONVERTERS:id id\n # symbol ID -# -# This is a misnomer now; it's really a "load unconditionally" section as -# it is also used for pattern templates. -# -# - a list of all (private or exported) methods because they are needed for -# correct dispatcher generation: -# METHODS: id id\n # symbol ID -# - an AST section that contains the module's AST: -# INIT( -# idx\n # position of the node in the DATA section -# idx\n -# ) -# - a data section, where each type, symbol or AST is stored. -# DATA( -# type -# (node) -# sym -# ) -# -# The data section MUST be the last section of the file, because processing -# stops immediately after ``DATA(`` and the rest is only loaded on demand -# by using a mem'mapped file. -# - -import - os, options, strutils, nversion, ast, astalgo, msgs, platform, condsyms, - ropes, idents, crc, idgen, types, rodutils, memfiles - -type - TReasonForRecompile* = enum ## all the reasons that can trigger recompilation - rrEmpty, # dependencies not yet computed - rrNone, # no need to recompile - rrRodDoesNotExist, # rod file does not exist - rrRodInvalid, # rod file is invalid - rrCrcChange, # file has been edited since last recompilation - rrDefines, # defines have changed - rrOptions, # options have changed - rrInclDeps, # an include has changed - rrModDeps # a module this module depends on has been changed - -const - reasonToFrmt*: array[TReasonForRecompile, string] = ["", - "no need to recompile: $1", "symbol file for $1 does not exist", - "symbol file for $1 has the wrong version", - "file edited since last compilation: $1", - "list of conditional symbols changed for: $1", - "list of options changed for: $1", - "an include file edited: $1", - "a module $1 depends on has changed"] - -type - TIndex*{.final.} = object # an index with compression - lastIdxKey*, lastIdxVal*: int - tab*: TIITable - r*: string # writers use this - offset*: int # readers use this - - TRodReader* = object of TObject - pos: int # position; used for parsing - s: cstring # mmap'ed file contents - options: TOptions - reason: TReasonForRecompile - modDeps: seq[int32] - files: seq[int32] - dataIdx: int # offset of start of data section - convertersIdx: int # offset of start of converters section - initIdx, interfIdx, compilerProcsIdx, methodsIdx: int - filename: string - index, imports: TIndex - readerIndex: int - line: int # only used for debugging, but is always in the code - moduleID: int - syms: TIdTable # already processed symbols - memfile: TMemFile # unfortunately there is no point in time where we - # can close this! XXX - methods*: TSymSeq - inViewMode: bool - - PRodReader* = ref TRodReader - -var rodCompilerprocs*: TStrTable - -proc handleSymbolFile*(module: PSym): PRodReader -# global because this is needed by magicsys -proc loadInitSection*(r: PRodReader): PNode - -# implementation - -proc rawLoadStub(s: PSym) - -var gTypeTable: TIdTable - -proc rrGetSym(r: PRodReader, id: int, info: TLineInfo): PSym - # `info` is only used for debugging purposes -proc rrGetType(r: PRodReader, id: int, info: TLineInfo): PType - -proc decodeLineInfo(r: PRodReader, info: var TLineInfo) = - if r.s[r.pos] == '?': - inc(r.pos) - if r.s[r.pos] == ',': info.col = -1'i16 - else: info.col = int16(decodeVInt(r.s, r.pos)) - if r.s[r.pos] == ',': - inc(r.pos) - if r.s[r.pos] == ',': info.line = -1'i16 - else: info.line = int16(decodeVInt(r.s, r.pos)) - if r.s[r.pos] == ',': - inc(r.pos) - info = newLineInfo(r.files[decodeVInt(r.s, r.pos)], info.line, info.col) - -proc skipNode(r: PRodReader) = - assert r.s[r.pos] == '(' - var par = 0 - var pos = r.pos+1 - while true: - case r.s[pos] - of ')': - if par == 0: break - dec par - of '(': inc par - else: nil - inc pos - r.pos = pos+1 # skip ')' - -proc decodeNodeLazyBody(r: PRodReader, fInfo: TLineInfo, - belongsTo: PSym): PNode = - result = nil - if r.s[r.pos] == '(': - inc(r.pos) - if r.s[r.pos] == ')': - inc(r.pos) - return # nil node - result = newNodeI(TNodeKind(decodeVInt(r.s, r.pos)), fInfo) - decodeLineInfo(r, result.info) - if r.s[r.pos] == '$': - inc(r.pos) - result.flags = cast[TNodeFlags](int32(decodeVInt(r.s, r.pos))) - if r.s[r.pos] == '^': - inc(r.pos) - var id = decodeVInt(r.s, r.pos) - result.typ = rrGetType(r, id, result.info) - case result.kind - of nkCharLit..nkInt64Lit: - if r.s[r.pos] == '!': - inc(r.pos) - result.intVal = decodeVBiggestInt(r.s, r.pos) - of nkFloatLit..nkFloat64Lit: - if r.s[r.pos] == '!': - inc(r.pos) - var fl = decodeStr(r.s, r.pos) - result.floatVal = parseFloat(fl) - of nkStrLit..nkTripleStrLit: - if r.s[r.pos] == '!': - inc(r.pos) - result.strVal = decodeStr(r.s, r.pos) - else: - result.strVal = "" # BUGFIX - of nkIdent: - if r.s[r.pos] == '!': - inc(r.pos) - var fl = decodeStr(r.s, r.pos) - result.ident = getIdent(fl) - else: - internalError(result.info, "decodeNode: nkIdent") - of nkSym: - if r.s[r.pos] == '!': - inc(r.pos) - var id = decodeVInt(r.s, r.pos) - result.sym = rrGetSym(r, id, result.info) - else: - internalError(result.info, "decodeNode: nkSym") - else: - var i = 0 - while r.s[r.pos] != ')': - if belongsTo != nil and i == bodyPos: - addSonNilAllowed(result, nil) - belongsTo.offset = r.pos - skipNode(r) - else: - addSonNilAllowed(result, decodeNodeLazyBody(r, result.info, nil)) - inc i - if r.s[r.pos] == ')': inc(r.pos) - else: internalError(result.info, "decodeNode: ')' missing") - else: - InternalError(fInfo, "decodeNode: '(' missing " & $r.pos) - -proc decodeNode(r: PRodReader, fInfo: TLineInfo): PNode = - result = decodeNodeLazyBody(r, fInfo, nil) - -proc decodeLoc(r: PRodReader, loc: var TLoc, info: TLineInfo) = - if r.s[r.pos] == '<': - inc(r.pos) - if r.s[r.pos] in {'0'..'9', 'a'..'z', 'A'..'Z'}: - loc.k = TLocKind(decodeVInt(r.s, r.pos)) - else: - loc.k = low(loc.k) - if r.s[r.pos] == '*': - inc(r.pos) - loc.s = TStorageLoc(decodeVInt(r.s, r.pos)) - else: - loc.s = low(loc.s) - if r.s[r.pos] == '$': - inc(r.pos) - loc.flags = cast[TLocFlags](int32(decodeVInt(r.s, r.pos))) - else: - loc.flags = {} - if r.s[r.pos] == '^': - inc(r.pos) - loc.t = rrGetType(r, decodeVInt(r.s, r.pos), info) - else: - loc.t = nil - if r.s[r.pos] == '!': - inc(r.pos) - loc.r = toRope(decodeStr(r.s, r.pos)) - else: - loc.r = nil - if r.s[r.pos] == '?': - inc(r.pos) - loc.a = decodeVInt(r.s, r.pos) - else: - loc.a = 0 - if r.s[r.pos] == '>': inc(r.pos) - else: InternalError(info, "decodeLoc " & r.s[r.pos]) - -proc decodeType(r: PRodReader, info: TLineInfo): PType = - result = nil - if r.s[r.pos] == '[': - inc(r.pos) - if r.s[r.pos] == ']': - inc(r.pos) - return # nil type - new(result) - result.kind = TTypeKind(decodeVInt(r.s, r.pos)) - if r.s[r.pos] == '+': - inc(r.pos) - result.id = decodeVInt(r.s, r.pos) - setId(result.id) - if debugIds: registerID(result) - else: - InternalError(info, "decodeType: no id") - # here this also avoids endless recursion for recursive type - IdTablePut(gTypeTable, result, result) - if r.s[r.pos] == '(': result.n = decodeNode(r, UnknownLineInfo()) - if r.s[r.pos] == '$': - inc(r.pos) - result.flags = cast[TTypeFlags](int32(decodeVInt(r.s, r.pos))) - if r.s[r.pos] == '?': - inc(r.pos) - result.callConv = TCallingConvention(decodeVInt(r.s, r.pos)) - if r.s[r.pos] == '*': - inc(r.pos) - result.owner = rrGetSym(r, decodeVInt(r.s, r.pos), info) - if r.s[r.pos] == '&': - inc(r.pos) - result.sym = rrGetSym(r, decodeVInt(r.s, r.pos), info) - if r.s[r.pos] == '/': - inc(r.pos) - result.size = decodeVInt(r.s, r.pos) - else: - result.size = - 1 - if r.s[r.pos] == '=': - inc(r.pos) - result.align = decodeVInt(r.s, r.pos) - else: - result.align = 2 - decodeLoc(r, result.loc, info) - while r.s[r.pos] == '^': - inc(r.pos) - if r.s[r.pos] == '(': - inc(r.pos) - if r.s[r.pos] == ')': inc(r.pos) - else: InternalError(info, "decodeType ^(" & r.s[r.pos]) - rawAddSon(result, nil) - else: - var d = decodeVInt(r.s, r.pos) - rawAddSon(result, rrGetType(r, d, info)) - -proc decodeLib(r: PRodReader, info: TLineInfo): PLib = - result = nil - if r.s[r.pos] == '|': - new(result) - inc(r.pos) - result.kind = TLibKind(decodeVInt(r.s, r.pos)) - if r.s[r.pos] != '|': InternalError("decodeLib: 1") - inc(r.pos) - result.name = toRope(decodeStr(r.s, r.pos)) - if r.s[r.pos] != '|': InternalError("decodeLib: 2") - inc(r.pos) - result.path = decodeNode(r, info) - -proc decodeSym(r: PRodReader, info: TLineInfo): PSym = - var - id: int - ident: PIdent - result = nil - if r.s[r.pos] == '{': - inc(r.pos) - if r.s[r.pos] == '}': - inc(r.pos) - return # nil sym - var k = TSymKind(decodeVInt(r.s, r.pos)) - if r.s[r.pos] == '+': - inc(r.pos) - id = decodeVInt(r.s, r.pos) - setId(id) - else: - InternalError(info, "decodeSym: no id") - if r.s[r.pos] == '&': - inc(r.pos) - ident = getIdent(decodeStr(r.s, r.pos)) - else: - InternalError(info, "decodeSym: no ident") - #echo "decoding: {", ident.s - result = PSym(IdTableGet(r.syms, id)) - if result == nil: - new(result) - result.id = id - IdTablePut(r.syms, result, result) - if debugIds: registerID(result) - elif result.id != id: - InternalError(info, "decodeSym: wrong id") - elif result.kind != skStub and not r.inViewMode: - # we already loaded the symbol - return - else: - reset(result[]) - result.id = id - result.kind = k - result.name = ident # read the rest of the symbol description: - if r.s[r.pos] == '^': - inc(r.pos) - result.typ = rrGetType(r, decodeVInt(r.s, r.pos), info) - decodeLineInfo(r, result.info) - if r.s[r.pos] == '*': - inc(r.pos) - result.owner = rrGetSym(r, decodeVInt(r.s, r.pos), result.info) - if r.s[r.pos] == '$': - inc(r.pos) - result.flags = cast[TSymFlags](int32(decodeVInt(r.s, r.pos))) - if r.s[r.pos] == '@': - inc(r.pos) - result.magic = TMagic(decodeVInt(r.s, r.pos)) - if r.s[r.pos] == '!': - inc(r.pos) - result.options = cast[TOptions](int32(decodeVInt(r.s, r.pos))) - else: - result.options = r.options - if r.s[r.pos] == '%': - inc(r.pos) - result.position = decodeVInt(r.s, r.pos) - elif result.kind notin routineKinds + {skModule}: - result.position = 0 - # this may have been misused as reader index! But we still - # need it for routines as the body is loaded lazily. - if r.s[r.pos] == '`': - inc(r.pos) - result.offset = decodeVInt(r.s, r.pos) - else: - result.offset = - 1 - decodeLoc(r, result.loc, result.info) - result.annex = decodeLib(r, info) - if r.s[r.pos] == '#': - inc(r.pos) - result.constraint = decodeNode(r, UnknownLineInfo()) - if r.s[r.pos] == '(': - if result.kind in routineKinds: - result.ast = decodeNodeLazyBody(r, result.info, result) - # since we load the body lazily, we need to set the reader to - # be able to reload: - result.position = r.readerIndex - else: - result.ast = decodeNode(r, result.info) - #echo "decoded: ", ident.s, "}" - -proc skipSection(r: PRodReader) = - if r.s[r.pos] == ':': - while r.s[r.pos] > '\x0A': inc(r.pos) - elif r.s[r.pos] == '(': - var c = 0 # count () pairs - inc(r.pos) - while true: - case r.s[r.pos] - of '\x0A': inc(r.line) - of '(': inc(c) - of ')': - if c == 0: - inc(r.pos) - break - elif c > 0: - dec(c) - of '\0': break # end of file - else: nil - inc(r.pos) - else: - InternalError("skipSection " & $r.line) - -proc rdWord(r: PRodReader): string = - result = "" - while r.s[r.pos] in {'A'..'Z', '_', 'a'..'z', '0'..'9'}: - add(result, r.s[r.pos]) - inc(r.pos) - -proc newStub(r: PRodReader, name: string, id: int): PSym = - new(result) - result.kind = skStub - result.id = id - result.name = getIdent(name) - result.position = r.readerIndex - setID(id) #MessageOut(result.name.s); - if debugIds: registerID(result) - -proc processInterf(r: PRodReader, module: PSym) = - if r.interfIdx == 0: InternalError("processInterf") - r.pos = r.interfIdx - while (r.s[r.pos] > '\x0A') and (r.s[r.pos] != ')'): - var w = decodeStr(r.s, r.pos) - inc(r.pos) - var key = decodeVInt(r.s, r.pos) - inc(r.pos) # #10 - var s = newStub(r, w, key) - s.owner = module - StrTableAdd(module.tab, s) - IdTablePut(r.syms, s, s) - -proc processCompilerProcs(r: PRodReader, module: PSym) = - if r.compilerProcsIdx == 0: InternalError("processCompilerProcs") - r.pos = r.compilerProcsIdx - while (r.s[r.pos] > '\x0A') and (r.s[r.pos] != ')'): - var w = decodeStr(r.s, r.pos) - inc(r.pos) - var key = decodeVInt(r.s, r.pos) - inc(r.pos) # #10 - var s = PSym(IdTableGet(r.syms, key)) - if s == nil: - s = newStub(r, w, key) - s.owner = module - IdTablePut(r.syms, s, s) - StrTableAdd(rodCompilerProcs, s) - -proc processIndex(r: PRodReader; idx: var TIndex; outf: TFile = nil) = - var key, val, tmp: int - inc(r.pos, 2) # skip "(\10" - inc(r.line) - while (r.s[r.pos] > '\x0A') and (r.s[r.pos] != ')'): - tmp = decodeVInt(r.s, r.pos) - if r.s[r.pos] == ' ': - inc(r.pos) - key = idx.lastIdxKey + tmp - val = decodeVInt(r.s, r.pos) + idx.lastIdxVal - else: - key = idx.lastIdxKey + 1 - val = tmp + idx.lastIdxVal - IITablePut(idx.tab, key, val) - if not outf.isNil: outf.write(key, " ", val, "\n") - idx.lastIdxKey = key - idx.lastIdxVal = val - setID(key) # ensure that this id will not be used - if r.s[r.pos] == '\x0A': - inc(r.pos) - inc(r.line) - if r.s[r.pos] == ')': inc(r.pos) - -proc cmdChangeTriggersRecompilation(old, new: TCommands): bool = - if old == new: return false - # we use a 'case' statement without 'else' so that addition of a - # new command forces us to consider it here :-) - case old - of cmdCompileToC, cmdCompileToCpp, cmdCompileToOC, - cmdCompileToJS, cmdCompileToLLVM: - if new in {cmdDoc, cmdCheck, cmdIdeTools, cmdPretty, cmdDef, - cmdInteractive}: - return false - of cmdNone, cmdDoc, cmdInterpret, cmdPretty, cmdGenDepend, cmdDump, - cmdCheck, cmdParse, cmdScan, cmdIdeTools, cmdDef, - cmdRst2html, cmdRst2tex, cmdInteractive, cmdRun: - nil - # else: trigger recompilation: - result = true - -proc processRodFile(r: PRodReader, crc: TCrc32) = - var - w: string - d, inclCrc: int - while r.s[r.pos] != '\0': - var section = rdWord(r) - if r.reason != rrNone: - break # no need to process this file further - case section - of "CRC": - inc(r.pos) # skip ':' - if int(crc) != decodeVInt(r.s, r.pos): r.reason = rrCrcChange - of "ID": - inc(r.pos) # skip ':' - r.moduleID = decodeVInt(r.s, r.pos) - setID(r.moduleID) - of "OPTIONS": - inc(r.pos) # skip ':' - r.options = cast[TOptions](int32(decodeVInt(r.s, r.pos))) - if options.gOptions != r.options: r.reason = rrOptions - of "GOPTIONS": - inc(r.pos) # skip ':' - var dep = cast[TGlobalOptions](int32(decodeVInt(r.s, r.pos))) - if gGlobalOptions != dep: r.reason = rrOptions - of "CMD": - inc(r.pos) # skip ':' - var dep = cast[TCommands](int32(decodeVInt(r.s, r.pos))) - if cmdChangeTriggersRecompilation(dep, gCmd): r.reason = rrOptions - of "DEFINES": - inc(r.pos) # skip ':' - d = 0 - while r.s[r.pos] > '\x0A': - w = decodeStr(r.s, r.pos) - inc(d) - if not condsyms.isDefined(getIdent(w)): - r.reason = rrDefines #MessageOut('not defined, but should: ' + w); - if r.s[r.pos] == ' ': inc(r.pos) - if (d != countDefinedSymbols()): r.reason = rrDefines - of "FILES": - inc(r.pos, 2) # skip "(\10" - inc(r.line) - while r.s[r.pos] != ')': - let relativePath = decodeStr(r.s, r.pos) - let resolvedPath = relativePath.findModule - let finalPath = if resolvedPath.len > 0: resolvedPath else: relativePath - r.files.add(finalPath.fileInfoIdx) - inc(r.pos) # skip #10 - inc(r.line) - if r.s[r.pos] == ')': inc(r.pos) - of "INCLUDES": - inc(r.pos, 2) # skip "(\10" - inc(r.line) - while r.s[r.pos] != ')': - w = r.files[decodeVInt(r.s, r.pos)].toFullPath - inc(r.pos) # skip ' ' - inclCrc = decodeVInt(r.s, r.pos) - if r.reason == rrNone: - if not ExistsFile(w) or (inclCrc != int(crcFromFile(w))): - r.reason = rrInclDeps - if r.s[r.pos] == '\x0A': - inc(r.pos) - inc(r.line) - if r.s[r.pos] == ')': inc(r.pos) - of "DEPS": - inc(r.pos) # skip ':' - while r.s[r.pos] > '\x0A': - r.modDeps.add(r.files[int32(decodeVInt(r.s, r.pos))]) - if r.s[r.pos] == ' ': inc(r.pos) - of "INTERF": - r.interfIdx = r.pos + 2 - skipSection(r) - of "COMPILERPROCS": - r.compilerProcsIdx = r.pos + 2 - skipSection(r) - of "INDEX": - processIndex(r, r.index) - of "IMPORTS": - processIndex(r, r.imports) - of "CONVERTERS": - r.convertersIdx = r.pos + 1 - skipSection(r) - of "METHODS": - r.methodsIdx = r.pos + 1 - skipSection(r) - of "DATA": - r.dataIdx = r.pos + 2 # "(\10" - # We do not read the DATA section here! We read the needed objects on - # demand. And the DATA section comes last in the file, so we stop here: - break - of "INIT": - r.initIdx = r.pos + 2 # "(\10" - skipSection(r) - else: - InternalError("invalid section: '" & section & - "' at " & $r.line & " in " & r.filename) - #MsgWriteln("skipping section: " & section & - # " at " & $r.line & " in " & r.filename) - skipSection(r) - if r.s[r.pos] == '\x0A': - inc(r.pos) - inc(r.line) - - -proc startsWith(buf: cstring, token: string, pos = 0): bool = - var s = 0 - while s < token.len and buf[pos+s] == token[s]: inc s - result = s == token.len - -proc newRodReader(modfilename: string, crc: TCrc32, - readerIndex: int): PRodReader = - new(result) - try: - result.memFile = memfiles.open(modfilename) - except EOS: - return nil - result.files = @[] - result.modDeps = @[] - result.methods = @[] - var r = result - r.reason = rrNone - r.pos = 0 - r.line = 1 - r.readerIndex = readerIndex - r.filename = modfilename - InitIdTable(r.syms) - # we terminate the file explicitely with ``\0``, so the cast to `cstring` - # is safe: - r.s = cast[cstring](r.memFile.mem) - if startsWith(r.s, "NIM:"): - initIITable(r.index.tab) - initIITable(r.imports.tab) # looks like a ROD file - inc(r.pos, 4) - var version = "" - while r.s[r.pos] notin {'\0', '\x0A'}: - add(version, r.s[r.pos]) - inc(r.pos) - if r.s[r.pos] == '\x0A': inc(r.pos) - if version != RodFileVersion: - # since ROD files are only for caching, no backwards compatibility is - # needed - result = nil - else: - result = nil - -proc rrGetType(r: PRodReader, id: int, info: TLineInfo): PType = - result = PType(IdTableGet(gTypeTable, id)) - if result == nil: - # load the type: - var oldPos = r.pos - var d = IITableGet(r.index.tab, id) - if d == invalidKey: InternalError(info, "rrGetType") - r.pos = d + r.dataIdx - result = decodeType(r, info) - r.pos = oldPos - -type - TFileModuleRec{.final.} = object - filename*: string - reason*: TReasonForRecompile - rd*: PRodReader - crc*: TCrc32 - crcDone*: bool - - TFileModuleMap = seq[TFileModuleRec] - -var gMods*: TFileModuleMap = @[] - -proc decodeSymSafePos(rd: PRodReader, offset: int, info: TLineInfo): PSym = - # all compiled modules - if rd.dataIdx == 0: InternalError(info, "dataIdx == 0") - var oldPos = rd.pos - rd.pos = offset + rd.dataIdx - result = decodeSym(rd, info) - rd.pos = oldPos - -proc findSomeWhere(id: int) = - for i in countup(0, high(gMods)): - var rd = gMods[i].rd - if rd != nil: - var d = IITableGet(rd.index.tab, id) - if d != invalidKey: - echo "found id ", id, " in ", gMods[i].filename - -proc getReader(moduleId: int): PRodReader = - # we can't index 'gMods' here as it's indexed by a *file index* which is not - # the module ID! We could introduce a mapping ID->PRodReader but I'll leave - # this for later versions if benchmarking shows the linear search causes - # problems: - for i in 0 .. <gMods.len: - result = gMods[i].rd - if result != nil and result.moduleId == moduleId: return result - return nil - -proc rrGetSym(r: PRodReader, id: int, info: TLineInfo): PSym = - result = PSym(IdTableGet(r.syms, id)) - if result == nil: - # load the symbol: - var d = IITableGet(r.index.tab, id) - if d == invalidKey: - # import from other module: - var moduleID = IiTableGet(r.imports.tab, id) - if moduleID < 0: - var x = "" - encodeVInt(id, x) - InternalError(info, "missing from both indexes: +" & x) - var rd = getReader(moduleID) - d = IITableGet(rd.index.tab, id) - if d != invalidKey: - result = decodeSymSafePos(rd, d, info) - else: - var x = "" - encodeVInt(id, x) - when false: findSomeWhere(id) - InternalError(info, "rrGetSym: no reader found: +" & x) - else: - # own symbol: - result = decodeSymSafePos(r, d, info) - if result != nil and result.kind == skStub: rawLoadStub(result) - -proc loadInitSection(r: PRodReader): PNode = - if r.initIdx == 0 or r.dataIdx == 0: InternalError("loadInitSection") - var oldPos = r.pos - r.pos = r.initIdx - result = newNode(nkStmtList) - while r.s[r.pos] > '\x0A' and r.s[r.pos] != ')': - var d = decodeVInt(r.s, r.pos) - inc(r.pos) # #10 - var p = r.pos - r.pos = d + r.dataIdx - addSon(result, decodeNode(r, UnknownLineInfo())) - r.pos = p - r.pos = oldPos - -proc loadConverters(r: PRodReader) = - # We have to ensure that no exported converter is a stub anymore, and the - # import mechanism takes care of the rest. - if r.convertersIdx == 0 or r.dataIdx == 0: - InternalError("importConverters") - r.pos = r.convertersIdx - while r.s[r.pos] > '\x0A': - var d = decodeVInt(r.s, r.pos) - discard rrGetSym(r, d, UnknownLineInfo()) - if r.s[r.pos] == ' ': inc(r.pos) - -proc loadMethods(r: PRodReader) = - if r.methodsIdx == 0 or r.dataIdx == 0: - InternalError("loadMethods") - r.pos = r.methodsIdx - while r.s[r.pos] > '\x0A': - var d = decodeVInt(r.s, r.pos) - r.methods.add(rrGetSym(r, d, UnknownLineInfo())) - if r.s[r.pos] == ' ': inc(r.pos) - -proc GetCRC*(fileIdx: int32): TCrc32 = - InternalAssert fileIdx >= 0 and fileIdx < gMods.len - - if gMods[fileIdx].crcDone: - return gMods[fileIdx].crc - - result = crcFromFile(fileIdx.toFilename) - gMods[fileIdx].crc = result - -template growCache*(cache, pos) = - if cache.len <= pos: cache.setLen(pos+1) - -proc checkDep(fileIdx: int32): TReasonForRecompile = - assert fileIdx != InvalidFileIDX - growCache gMods, fileIdx - if gMods[fileIdx].reason != rrEmpty: - # reason has already been computed for this module: - return gMods[fileIdx].reason - let filename = fileIdx.toFilename - var crc = GetCRC(fileIdx) - gMods[fileIdx].reason = rrNone # we need to set it here to avoid cycles - result = rrNone - var r: PRodReader = nil - var rodfile = toGeneratedFile(filename, RodExt) - r = newRodReader(rodfile, crc, fileIdx) - if r == nil: - result = (if ExistsFile(rodfile): rrRodInvalid else: rrRodDoesNotExist) - else: - processRodFile(r, crc) - result = r.reason - if result == rrNone: - # check modules it depends on - # NOTE: we need to process the entire module graph so that no ID will - # be used twice! However, compilation speed does not suffer much from - # this, since results are cached. - var res = checkDep(SystemFileIdx) - if res != rrNone: result = rrModDeps - for i in countup(0, high(r.modDeps)): - res = checkDep(r.modDeps[i]) - if res != rrNone: - result = rrModDeps - # we cannot break here, because of side-effects of `checkDep` - if result != rrNone and gVerbosity > 0: - rawMessage(hintProcessing, reasonToFrmt[result] % filename) - if result != rrNone or optForceFullMake in gGlobalOptions: - # recompilation is necessary: - if r != nil: memfiles.close(r.memFile) - r = nil - gMods[fileIdx].rd = r - gMods[fileIdx].reason = result # now we know better - -proc handleSymbolFile(module: PSym): PRodReader = - let fileIdx = module.fileIdx - if optSymbolFiles notin gGlobalOptions: - module.id = getID() - return nil - idgen.loadMaxIds(options.gProjectPath / options.gProjectName) - - discard checkDep(fileIdx) - if gMods[fileIdx].reason == rrEmpty: InternalError("handleSymbolFile") - result = gMods[fileIdx].rd - if result != nil: - module.id = result.moduleID - IdTablePut(result.syms, module, module) - processInterf(result, module) - processCompilerProcs(result, module) - loadConverters(result) - loadMethods(result) - else: - module.id = getID() - -proc rawLoadStub(s: PSym) = - if s.kind != skStub: InternalError("loadStub") - var rd = gMods[s.position].rd - var theId = s.id # used for later check - var d = IITableGet(rd.index.tab, s.id) - if d == invalidKey: InternalError("loadStub: invalid key") - var rs = decodeSymSafePos(rd, d, UnknownLineInfo()) - if rs != s: - #echo "rs: ", toHex(cast[int](rs.position), int.sizeof * 2), - # "\ns: ", toHex(cast[int](s.position), int.sizeof * 2) - InternalError(rs.info, "loadStub: wrong symbol") - elif rs.id != theId: - InternalError(rs.info, "loadStub: wrong ID") - #MessageOut('loaded stub: ' + s.name.s); - -proc LoadStub*(s: PSym) = - ## loads the stub symbol `s`. - - # deactivate the GC here because we do a deep recursion and generate no - # garbage when restoring parts of the object graph anyway. - # Since we die with internal errors if this fails, so no try-finally is - # necessary. - GC_disable() - rawLoadStub(s) - GC_enable() - -proc getBody*(s: PSym): PNode = - ## retrieves the AST's body of `s`. If `s` has been loaded from a rod-file - ## it may perform an expensive reload operation. Otherwise it's a simple - ## accessor. - assert s.kind in routineKinds - result = s.ast.sons[bodyPos] - if result == nil: - assert s.offset != 0 - var r = gMods[s.position].rd - var oldPos = r.pos - r.pos = s.offset - result = decodeNode(r, s.info) - r.pos = oldPos - s.ast.sons[bodyPos] = result - s.offset = 0 - -InitIdTable(gTypeTable) -InitStrTable(rodCompilerProcs) - -# viewer: -proc writeNode(f: TFile; n: PNode) = - f.write("(") - if n != nil: - f.write($n.kind) - if n.typ != nil: - f.write('^') - f.write(n.typ.id) - case n.kind - of nkCharLit..nkInt64Lit: - if n.intVal != 0: - f.write('!') - f.write(n.intVal) - of nkFloatLit..nkFloat64Lit: - if n.floatVal != 0.0: - f.write('!') - f.write($n.floatVal) - of nkStrLit..nkTripleStrLit: - if n.strVal != "": - f.write('!') - f.write(n.strVal.escape) - of nkIdent: - f.write('!') - f.write(n.ident.s) - of nkSym: - f.write('!') - f.write(n.sym.id) - else: - for i in countup(0, sonsLen(n) - 1): - writeNode(f, n.sons[i]) - f.write(")") - -proc writeSym(f: TFile; s: PSym) = - if s == nil: - f.write("{}\n") - return - f.write("{") - f.write($s.kind) - f.write('+') - f.write(s.id) - f.write('&') - f.write(s.name.s) - if s.typ != nil: - f.write('^') - f.write(s.typ.id) - if s.owner != nil: - f.write('*') - f.write(s.owner.id) - if s.flags != {}: - f.write('$') - f.write($s.flags) - if s.magic != mNone: - f.write('@') - f.write($s.magic) - if s.options != gOptions: - f.write('!') - f.write($s.options) - if s.position != 0: - f.write('%') - f.write($s.position) - if s.offset != -1: - f.write('`') - f.write($s.offset) - if s.constraint != nil: - f.write('#') - f.writeNode(s.constraint) - if s.ast != nil: - f.writeNode(s.ast) - f.write("}\n") - -proc writeType(f: TFile; t: PType) = - if t == nil: - f.write("[]\n") - return - f.write('[') - f.write($t.kind) - f.write('+') - f.write($t.id) - if t.n != nil: - f.writeNode(t.n) - if t.flags != {}: - f.write('$') - f.write($t.flags) - if t.callConv != low(t.callConv): - f.write('?') - f.write($t.callConv) - if t.owner != nil: - f.write('*') - f.write($t.owner.id) - if t.sym != nil: - f.write('&') - f.write(t.sym.id) - if t.size != -1: - f.write('/') - f.write($t.size) - if t.align != 2: - f.write('=') - f.write($t.align) - for i in countup(0, sonsLen(t) - 1): - if t.sons[i] == nil: - f.write("^()") - else: - f.write('^') - f.write($t.sons[i].id) - f.write("]\n") - -proc viewFile(rodfile: string) = - var r = newRodReader(rodfile, 0, 0) - if r == nil: - rawMessage(errGenerated, "cannot open file (or maybe wrong version):" & - rodfile) - return - r.inViewMode = true - var outf = system.open(rodfile.changeFileExt(".rod.txt"), fmWrite) - while r.s[r.pos] != '\0': - let section = rdWord(r) - case section - of "CRC": - inc(r.pos) # skip ':' - outf.writeln("CRC:", $decodeVInt(r.s, r.pos)) - of "ID": - inc(r.pos) # skip ':' - r.moduleID = decodeVInt(r.s, r.pos) - setID(r.moduleID) - outf.writeln("ID:", $r.moduleID) - of "OPTIONS": - inc(r.pos) # skip ':' - r.options = cast[TOptions](int32(decodeVInt(r.s, r.pos))) - outf.writeln("OPTIONS:", $r.options) - of "GOPTIONS": - inc(r.pos) # skip ':' - let dep = cast[TGlobalOptions](int32(decodeVInt(r.s, r.pos))) - outf.writeln("GOPTIONS:", $dep) - of "CMD": - inc(r.pos) # skip ':' - let dep = cast[TCommands](int32(decodeVInt(r.s, r.pos))) - outf.writeln("CMD:", $dep) - of "DEFINES": - inc(r.pos) # skip ':' - var d = 0 - outf.write("DEFINES:") - while r.s[r.pos] > '\x0A': - let w = decodeStr(r.s, r.pos) - inc(d) - outf.write(" ", w) - if r.s[r.pos] == ' ': inc(r.pos) - outf.write("\n") - of "FILES": - inc(r.pos, 2) # skip "(\10" - inc(r.line) - outf.write("FILES(\n") - while r.s[r.pos] != ')': - let relativePath = decodeStr(r.s, r.pos) - let resolvedPath = relativePath.findModule - let finalPath = if resolvedPath.len > 0: resolvedPath else: relativePath - r.files.add(finalPath.fileInfoIdx) - inc(r.pos) # skip #10 - inc(r.line) - outf.writeln finalPath - if r.s[r.pos] == ')': inc(r.pos) - outf.write(")\n") - of "INCLUDES": - inc(r.pos, 2) # skip "(\10" - inc(r.line) - outf.write("INCLUDES(\n") - while r.s[r.pos] != ')': - let w = r.files[decodeVInt(r.s, r.pos)] - inc(r.pos) # skip ' ' - let inclCrc = decodeVInt(r.s, r.pos) - if r.s[r.pos] == '\x0A': - inc(r.pos) - inc(r.line) - outf.write(w, " ", inclCrc, "\n") - if r.s[r.pos] == ')': inc(r.pos) - outf.write(")\n") - of "DEPS": - inc(r.pos) # skip ':' - outf.write("DEPS:") - while r.s[r.pos] > '\x0A': - let v = int32(decodeVInt(r.s, r.pos)) - r.modDeps.add(r.files[v]) - if r.s[r.pos] == ' ': inc(r.pos) - outf.write(" ", r.files[v]) - outf.write("\n") - of "INTERF", "COMPILERPROCS": - inc r.pos, 2 - if section == "INTERF": r.interfIdx = r.pos - else: r.compilerProcsIdx = r.pos - outf.write(section, "(\n") - while (r.s[r.pos] > '\x0A') and (r.s[r.pos] != ')'): - let w = decodeStr(r.s, r.pos) - inc(r.pos) - let key = decodeVInt(r.s, r.pos) - inc(r.pos) # #10 - outf.write(w, " ", key, "\n") - if r.s[r.pos] == ')': inc r.pos - outf.write(")\n") - of "INDEX": - outf.write(section, "(\n") - processIndex(r, r.index, outf) - outf.write(")\n") - of "IMPORTS": - outf.write(section, "(\n") - processIndex(r, r.imports, outf) - outf.write(")\n") - of "CONVERTERS", "METHODS": - inc r.pos - if section == "METHODS": r.methodsIdx = r.pos - else: r.convertersIdx = r.pos - outf.write(section, ":") - while r.s[r.pos] > '\x0A': - let d = decodeVInt(r.s, r.pos) - outf.write(" ", $d) - if r.s[r.pos] == ' ': inc(r.pos) - outf.write("\n") - of "DATA": - inc(r.pos, 2) - r.dataIdx = r.pos - outf.write("DATA(\n") - while r.s[r.pos] != ')': - if r.s[r.pos] == '(': - outf.writeNode decodeNode(r, UnknownLineInfo()) - outf.write("\n") - elif r.s[r.pos] == '[': - outf.writeType decodeType(r, UnknownLineInfo()) - else: - outf.writeSym decodeSym(r, UnknownLineInfo()) - if r.s[r.pos] == '\x0A': - inc(r.pos) - inc(r.line) - if r.s[r.pos] == ')': inc r.pos - outf.write(")\n") - of "INIT": - outf.write("INIT(\n") - inc r.pos, 2 - r.initIdx = r.pos - while r.s[r.pos] > '\x0A' and r.s[r.pos] != ')': - let d = decodeVInt(r.s, r.pos) - inc(r.pos) # #10 - #let p = r.pos - #r.pos = d + r.dataIdx - #outf.writeNode decodeNode(r, UnknownLineInfo()) - #outf.write("\n") - #r.pos = p - if r.s[r.pos] == ')': inc r.pos - outf.write("<not supported by viewer>)\n") - else: - InternalError("invalid section: '" & section & - "' at " & $r.line & " in " & r.filename) - skipSection(r) - if r.s[r.pos] == '\x0A': - inc(r.pos) - inc(r.line) - outf.close - -when isMainModule: - viewFile(paramStr(1).addFileExt(rodExt)) diff --git a/compiler/rodutils.nim b/compiler/rodutils.nim index 0ee3b1ec4..5355829c1 100644 --- a/compiler/rodutils.nim +++ b/compiler/rodutils.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -8,77 +8,117 @@ # ## Serialization utilities for the compiler. -import strutils - -proc c_sprintf(buf, frmt: cstring) {.importc: "sprintf", nodecl, varargs.} - -proc ToStrMaxPrecision*(f: BiggestFloat): string = - if f != f: - result = "NAN" - elif f == 0.0: - result = "0.0" - elif f == 0.5 * f: - if f > 0.0: result = "INF" - else: result = "-INF" +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: + if signbit(f): + result = "-NAN" + else: + result = "NAN" + of fcNegZero: + result = "-0.0" & literalPostfix + of fcZero: + result = "0.0" & literalPostfix + of fcInf: + result = "INF" + of fcNegInf: + result = "-INF" else: - var buf: array [0..80, char] - c_sprintf(buf, "%#.16e", f) - result = $buf + 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) = +proc hexChar(c: char, xi: var int) = case c of '0'..'9': xi = (xi shl 4) or (ord(c) - ord('0')) of 'a'..'f': xi = (xi shl 4) or (ord(c) - ord('a') + 10) of 'A'..'F': xi = (xi shl 4) or (ord(c) - ord('A') + 10) - else: nil + else: discard proc decodeStr*(s: cstring, pos: var int): string = var i = pos result = "" - while true: + while true: case s[i] - of '\\': + of '\\': inc(i, 3) var xi = 0 hexChar(s[i-2], xi) hexChar(s[i-1], xi) - add(result, chr(xi)) - of 'a'..'z', 'A'..'Z', '0'..'9', '_': - add(result, s[i]) + result.add(chr(xi)) + of 'a'..'z', 'A'..'Z', '0'..'9', '_': + result.add(s[i]) inc(i) - else: break + 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: expr) = +template encodeIntImpl(self) = var d: char var v = x var rem = v mod 190 - if rem < 0: - add(result, '-') + if rem < 0: + result.add('-') v = - (v div 190) rem = - rem - else: + else: v = v div 190 var idx = int(rem) 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. @@ -89,11 +129,11 @@ proc encodeVBiggestInt*(x: BiggestInt, result: var string) = encodeVBiggestIntAux(x +% vintDelta, result) # encodeIntImpl(encodeVBiggestInt) -proc encodeVIntAux(x: int, result: var string) = +proc encodeVIntAux(x: int, result: var string) = ## encode an int as a variable length base 190 int. encodeIntImpl(encodeVIntAux) - -proc encodeVInt*(x: int, result: var string) = + +proc encodeVInt*(x: int, result: var string) = ## encode an int as a variable length base 190 int. encodeVIntAux(x +% vintDelta, result) @@ -101,11 +141,11 @@ template decodeIntImpl() = var i = pos var sign = - 1 assert(s[i] in {'a'..'z', 'A'..'Z', '0'..'9', '-', '\x80'..'\xFF'}) - if s[i] == '-': + if s[i] == '-': inc(i) sign = 1 result = 0 - while true: + while true: case s[i] of '0'..'9': result = result * 190 - (ord(s[i]) - ord('0')) of 'a'..'z': result = result * 190 - (ord(s[i]) - ord('a') + 10) @@ -116,12 +156,14 @@ template decodeIntImpl() = result = result * sign -% vintDelta pos = i -proc decodeVInt*(s: cstring, pos: var int): int = +proc decodeVInt*(s: cstring, pos: var int): int = decodeIntImpl() -proc decodeVBiggestInt*(s: cstring, pos: var int): biggestInt = +proc decodeVBiggestInt*(s: cstring, pos: var int): BiggestInt = decodeIntImpl() +{.pop.} + iterator decodeVIntArray*(s: cstring): int = var i = 0 while s[i] != '\0': @@ -133,4 +175,3 @@ iterator decodeStrArray*(s: cstring): string = while s[i] != '\0': yield decodeStr(s, i) if s[i] == ' ': inc i - diff --git a/compiler/rodwrite.nim b/compiler/rodwrite.nim deleted file mode 100644 index 0221977bf..000000000 --- a/compiler/rodwrite.nim +++ /dev/null @@ -1,587 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -# This module is responsible for writing of rod files. Note that writing of -# rod files is a pass, reading of rod files is not! This is why reading and -# writing of rod files is split into two different modules. - -import - intsets, os, options, strutils, nversion, ast, astalgo, msgs, platform, - condsyms, ropes, idents, crc, rodread, passes, importer, idgen, rodutils - -# implementation - -type - TRodWriter = object of TPassContext - module: PSym - crc: TCrc32 - options: TOptions - defines: string - inclDeps: string - modDeps: string - interf: string - compilerProcs: string - index, imports: TIndex - converters, methods: string - init: string - data: string - sstack: TSymSeq # a stack of symbols to process - tstack: TTypeSeq # a stack of types to process - files: TStringSeq - - PRodWriter = ref TRodWriter - -proc newRodWriter(crc: TCrc32, module: PSym): PRodWriter -proc addModDep(w: PRodWriter, dep: string) -proc addInclDep(w: PRodWriter, dep: string) -proc addInterfaceSym(w: PRodWriter, s: PSym) -proc addStmt(w: PRodWriter, n: PNode) -proc writeRod(w: PRodWriter) - -proc getDefines(): string = - var it: TTabIter - var s = InitTabIter(it, gSymbols) - result = "" - while s != nil: - if s.position == 1: - if result.len != 0: add(result, " ") - add(result, s.name.s) - s = nextIter(it, gSymbols) - -proc fileIdx(w: PRodWriter, filename: string): int = - for i in countup(0, high(w.files)): - if w.files[i] == filename: - return i - result = len(w.files) - setlen(w.files, result + 1) - w.files[result] = filename - -template filename*(w: PRodWriter): string = - w.module.filename - -proc newRodWriter(crc: TCrc32, module: PSym): PRodWriter = - new(result) - result.sstack = @[] - result.tstack = @[] - InitIITable(result.index.tab) - InitIITable(result.imports.tab) - result.index.r = "" - result.imports.r = "" - result.crc = crc - result.module = module - result.defines = getDefines() - result.options = options.gOptions - result.files = @[] - result.inclDeps = "" - result.modDeps = "" - result.interf = newStringOfCap(2_000) - result.compilerProcs = "" - result.converters = "" - result.methods = "" - result.init = "" - result.data = newStringOfCap(12_000) - -proc addModDep(w: PRodWriter, dep: string) = - if w.modDeps.len != 0: add(w.modDeps, ' ') - encodeVInt(fileIdx(w, dep), w.modDeps) - -const - rodNL = "\x0A" - -proc addInclDep(w: PRodWriter, dep: string) = - var resolved = dep.findModule - encodeVInt(fileIdx(w, dep), w.inclDeps) - add(w.inclDeps, " ") - encodeVInt(crcFromFile(resolved), w.inclDeps) - add(w.inclDeps, rodNL) - -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) - # No need to output the file index, as this is the serialization of one - # file. - 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(ropeToStr(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 preceeding [ 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(ropeToStr(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 Nimrod's heavy compile-time evaluation features - # make that unfeasible nowadays: - encodeNode(w, s.info, s.ast, result) - when false: - var codeAst: PNode = nil - if not astNeeded(s): - codeAst = s.ast.sons[codePos] - # ugly hack to not store the AST: - s.ast.sons[codePos] = ast.emptyNode - encodeNode(w, s.info, s.ast, result) - if codeAst != nil: - # resore the AST: - s.ast.sons[codePos] = codeAst - -proc addToIndex(w: var TIndex, key, val: int) = - if key - w.lastIdxKey == 1: - # we do not store a key-diff of 1 to safe space - encodeVInt(val - w.lastIdxVal, w.r) - else: - encodeVInt(key - w.lastIdxKey, w.r) - add(w.r, ' ') - encodeVInt(val - w.lastIdxVal, w.r) - add(w.r, rodNL) - w.lastIdxKey = key - w.lastIdxVal = val - IiTablePut(w.tab, key, val) - -const debugWrittenIds = false - -when debugWrittenIds: - var debugWritten = initIntSet() - -proc symStack(w: PRodWriter): int = - var i = 0 - while i < len(w.sstack): - var s = w.sstack[i] - if sfForward in s.flags: - w.sstack[result] = s - inc result - elif IiTableGet(w.index.tab, s.id) == invalidKey: - var m = getModule(s) - if m == nil: InternalError("symStack: module nil: " & s.name.s) - if (m.id == w.module.id) or (sfFromGeneric in s.flags): - # put definition in here - var L = w.data.len - addToIndex(w.index, s.id, L) - when debugWrittenIds: incl(debugWritten, s.id) - encodeSym(w, s, w.data) - add(w.data, rodNL) - # put into interface section if appropriate: - if {sfExported, sfFromGeneric} * s.flags == {sfExported} and - s.kind in ExportableSymKinds: - encodeStr(s.name.s, w.interf) - add(w.interf, ' ') - encodeVInt(s.id, w.interf) - add(w.interf, rodNL) - if sfCompilerProc in s.flags: - encodeStr(s.name.s, w.compilerProcs) - add(w.compilerProcs, ' ') - encodeVInt(s.id, w.compilerProcs) - add(w.compilerProcs, rodNL) - if s.kind == skConverter or hasPattern(s): - if w.converters.len != 0: add(w.converters, ' ') - encodeVInt(s.id, w.converters) - if s.kind == skMethod and sfDispatcher notin s.flags: - if w.methods.len != 0: add(w.methods, ' ') - encodeVInt(s.id, w.methods) - elif IiTableGet(w.imports.tab, s.id) == invalidKey: - addToIndex(w.imports, s.id, m.id) - when debugWrittenIds: - if not Contains(debugWritten, s.id): - echo(w.filename) - debug(s) - debug(s.owner) - debug(m) - InternalError("Symbol referred to but never written") - inc(i) - setlen(w.sstack, result) - -proc typeStack(w: PRodWriter): int = - var i = 0 - while i < len(w.tstack): - var t = w.tstack[i] - if t.kind == tyForward: - w.tstack[result] = t - inc result - elif IiTableGet(w.index.tab, t.id) == invalidKey: - var L = w.data.len - addToIndex(w.index, t.id, L) - encodeType(w, t, w.data) - add(w.data, rodNL) - inc(i) - setlen(w.tstack, result) - -proc processStacks(w: PRodWriter, finalPass: bool) = - var oldS = 0 - var oldT = 0 - while true: - var slen = symStack(w) - var tlen = typeStack(w) - if slen == oldS and tlen == oldT: break - oldS = slen - oldT = tlen - if finalPass and (oldS != 0 or oldT != 0): - InternalError("could not serialize some forwarded symbols/types") - -proc rawAddInterfaceSym(w: PRodWriter, s: PSym) = - pushSym(w, s) - processStacks(w, false) - -proc addInterfaceSym(w: PRodWriter, s: PSym) = - if w == nil: return - if s.kind in ExportableSymKinds and - {sfExported, sfCompilerProc} * s.flags != {}: - rawAddInterfaceSym(w, s) - -proc addStmt(w: PRodWriter, n: PNode) = - encodeVInt(w.data.len, w.init) - add(w.init, rodNL) - encodeNode(w, UnknownLineInfo(), n, w.data) - add(w.data, rodNL) - processStacks(w, false) - -proc writeRod(w: PRodWriter) = - processStacks(w, true) - var f: TFile - if not open(f, completeGeneratedFilePath(changeFileExt(w.filename, "rod")), - fmWrite): - #echo "couldn't write rod file for: ", w.filename - return - # write header: - f.write("NIM:") - f.write(RodFileVersion) - f.write(rodNL) - var id = "ID:" - encodeVInt(w.module.id, id) - f.write(id) - f.write(rodNL) - - var crc = "CRC:" - encodeVInt(w.crc, crc) - f.write(crc) - f.write(rodNL) - - var options = "OPTIONS:" - encodeVInt(cast[int32](w.options), options) - f.write(options) - f.write(rodNL) - - var goptions = "GOPTIONS:" - encodeVInt(cast[int32](gGlobalOptions), goptions) - f.write(goptions) - f.write(rodNL) - - var cmd = "CMD:" - encodeVInt(cast[int32](gCmd), cmd) - f.write(cmd) - f.write(rodNL) - - f.write("DEFINES:") - f.write(w.defines) - f.write(rodNL) - - var files = "FILES(" & rodNL - for i in countup(0, high(w.files)): - encodeStr(w.files[i], files) - files.add(rodNL) - f.write(files) - f.write(')' & rodNL) - - f.write("INCLUDES(" & rodNL) - f.write(w.inclDeps) - f.write(')' & rodNL) - - f.write("DEPS:") - f.write(w.modDeps) - f.write(rodNL) - - f.write("INTERF(" & rodNL) - f.write(w.interf) - f.write(')' & rodNL) - - f.write("COMPILERPROCS(" & rodNL) - f.write(w.compilerProcs) - f.write(')' & rodNL) - - f.write("INDEX(" & rodNL) - f.write(w.index.r) - f.write(')' & rodNL) - - f.write("IMPORTS(" & rodNL) - f.write(w.imports.r) - f.write(')' & rodNL) - - f.write("CONVERTERS:") - f.write(w.converters) - f.write(rodNL) - - f.write("METHODS:") - f.write(w.methods) - f.write(rodNL) - - f.write("INIT(" & rodNL) - f.write(w.init) - f.write(')' & rodNL) - - f.write("DATA(" & rodNL) - f.write(w.data) - f.write(')' & rodNL) - # write trailing zero which is necessary because we use memory mapped files - # for reading: - f.write("\0") - f.close() - - #echo "interf: ", w.interf.len - #echo "index: ", w.index.r.len - #echo "init: ", w.init.len - #echo "data: ", w.data.len - -proc process(c: PPassContext, n: PNode): PNode = - result = n - if c == nil: return - var w = PRodWriter(c) - case n.kind - of nkStmtList: - for i in countup(0, sonsLen(n) - 1): discard process(c, n.sons[i]) - #var s = n.sons[namePos].sym - #addInterfaceSym(w, s) - of nkProcDef, nkMethodDef, nkIteratorDef, nkConverterDef, - nkTemplateDef, nkMacroDef: - var s = n.sons[namePos].sym - if s == nil: InternalError(n.info, "rodwrite.process") - if n.sons[bodyPos] == nil: - InternalError(n.info, "rodwrite.process: body is nil") - if n.sons[bodyPos].kind != nkEmpty or s.magic != mNone or - sfForward notin s.flags: - addInterfaceSym(w, s) - of nkVarSection, nkLetSection, nkConstSection: - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - addInterfaceSym(w, a.sons[0].sym) - of nkTypeSection: - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if a.sons[0].kind != nkSym: InternalError(a.info, "rodwrite.process") - var s = a.sons[0].sym - addInterfaceSym(w, s) - # this takes care of enum fields too - # Note: The check for ``s.typ.kind = tyEnum`` is wrong for enum - # type aliasing! Otherwise the same enum symbol would be included - # several times! - # - # if (a.sons[2] <> nil) and (a.sons[2].kind = nkEnumTy) then begin - # a := s.typ.n; - # for j := 0 to sonsLen(a)-1 do - # addInterfaceSym(w, a.sons[j].sym); - # end - of nkImportStmt: - for i in countup(0, sonsLen(n) - 1): addModDep(w, getModuleName(n.sons[i])) - addStmt(w, n) - of nkFromStmt: - addModDep(w, getModuleName(n.sons[0])) - addStmt(w, n) - of nkIncludeStmt: - for i in countup(0, sonsLen(n) - 1): addInclDep(w, getModuleName(n.sons[i])) - of nkPragma: - addStmt(w, n) - else: - nil - -proc myOpen(module: PSym): PPassContext = - if module.id < 0: InternalError("rodwrite: module ID not set") - var w = newRodWriter(module.fileIdx.GetCRC, module) - rawAddInterfaceSym(w, module) - result = w - -proc myClose(c: PPassContext, n: PNode): PNode = - result = process(c, n) - var w = PRodWriter(c) - writeRod(w) - idgen.saveMaxIds(options.gProjectPath / options.gProjectName) - -const rodwritePass* = makePass(open = myOpen, close = myClose, process = process) - diff --git a/compiler/ropes.nim b/compiler/ropes.nim index 707c29123..e0d5aa0d3 100644 --- a/compiler/ropes.nim +++ b/compiler/ropes.nim @@ -1,359 +1,158 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this # 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 Nimrod -# 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 accross 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. + +from pathutils import AbsoluteFile -import - strutils, platform, hashes, crc, options +when defined(nimPreviewSlimSystem): + import std/[assertions, syncio, formatfloat] type - TFormatStr* = string # later we may change it to CString for better - # performance of the code generator (assignments + 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) - PRope* = ref TRope - TRope*{.acyclic.} = object of TObject # the empty rope is represented - # by nil to safe space - left*, right*: PRope - length*: int - data*: string # != nil if a leaf - - TRopeSeq* = seq[PRope] - - TRopesError* = enum - rCannotOpenFile - rInvalidFormatStr - rTokenTooLong - -proc con*(a, b: PRope): PRope -proc con*(a: PRope, b: string): PRope -proc con*(a: string, b: PRope): PRope -proc con*(a: varargs[PRope]): PRope -proc app*(a: var PRope, b: PRope) -proc app*(a: var PRope, b: string) -proc prepend*(a: var PRope, b: PRope) -proc toRope*(s: string): PRope -proc toRope*(i: BiggestInt): PRope -proc ropeLen*(a: PRope): int -proc writeRopeIfNotEqual*(r: PRope, filename: string): bool -proc ropeToStr*(p: PRope): string -proc ropef*(frmt: TFormatStr, args: varargs[PRope]): PRope -proc appf*(c: var PRope, frmt: TFormatStr, args: varargs[PRope]) -proc RopeEqualsFile*(r: PRope, f: string): bool - # returns true if the rope r is the same as the contents of file f -proc RopeInvariant*(r: PRope): bool - # exported for debugging -# implementation - -var ErrorHandler*: proc(err: TRopesError, msg: string, useWarning = false) - # avoid dependency on msgs.nim - -proc ropeLen(a: PRope): int = - if a == nil: result = 0 - else: result = a.length - -proc newRope*(data: string = nil): PRope = - new(result) - if data != nil: - result.length = len(data) - result.data = data - -proc newMutableRope*(capacity = 30): PRope = - ## creates a new rope that supports direct modifications of the rope's - ## 'data' and 'length' fields. - new(result) - result.data = newStringOfCap(capacity) - -proc freezeMutableRope*(r: PRope) {.inline.} = - r.length = r.data.len - -var - cache: array[0..2048*2 -1, PRope] - -proc resetRopeCache* = - for i in low(cache)..high(cache): - cache[i] = nil - -proc RopeInvariant(r: PRope): 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): PRope = - 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 toRope(s: string): PRope = - if s.len == 0: - result = nil - else: - result = insertInCache(s) - assert(RopeInvariant(result)) - -proc RopeSeqInsert(rs: var TRopeSeq, r: PRope, at: Natural) = - var length = len(rs) - if at > length: - setlen(rs, at + 1) - else: - setlen(rs, length + 1) # move old rope elements: - for i in countdown(length, at + 1): - rs[i] = rs[i - 1] # this is correct, I used pen and paper to validate it - rs[at] = r - -proc newRecRopeToStr(result: var string, resultLen: var int, r: PRope) = - var stack = @[r] - while len(stack) > 0: - var it = pop(stack) - while it.data == nil: - add(stack, it.right) - it = it.left - assert(it.data != nil) - CopyMem(addr(result[resultLen]), addr(it.data[0]), it.length) - Inc(resultLen, it.length) - assert(resultLen <= len(result)) + Rope* = string -proc ropeToStr(p: PRope): string = - if p == nil: - result = "" - else: - result = newString(p.length) - var resultLen = 0 - newRecRopeToStr(result, resultLen, p) +proc newRopeAppender*(cap = 80): string {.inline.} = + result = newStringOfCap(cap) -proc con(a, b: PRope): PRope = - 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 con(a: PRope, b: string): PRope = result = con(a, toRope(b)) -proc con(a: string, b: PRope): PRope = result = con(toRope(a), b) +proc freeze*(r: Rope) {.inline.} = discard -proc con(a: varargs[PRope]): PRope = - for i in countup(0, high(a)): result = con(result, a[i]) +proc resetRopeCache* = discard -proc ropeConcat*(a: varargs[PRope]): PRope = - # not overloaded version of concat to speed-up `rfmt` a little bit - for i in countup(0, high(a)): result = con(result, a[i]) +template rope*(s: string): string = s -proc toRope(i: BiggestInt): PRope = - inc gCacheIntTries - result = toRope($i) +proc rope*(i: BiggestInt): Rope = + ## Converts an int to a rope. + result = rope($i) -proc app(a: var PRope, b: PRope) = a = con(a, b) -proc app(a: var PRope, b: string) = a = con(a, b) -proc prepend(a: var PRope, b: PRope) = a = con(b, a) +proc rope*(f: BiggestFloat): Rope = + ## Converts a float to a rope. + result = rope($f) -proc writeRope*(f: TFile, c: PRope) = - var stack = @[c] - while len(stack) > 0: - var it = pop(stack) - while it.data == nil: - add(stack, it.right) - it = it.left - assert(it != nil) - assert(it.data != nil) - write(f, it.data) +proc writeRope*(f: File, r: Rope) = + ## writes a rope to a file. + write(f, r) -proc WriteRope*(head: PRope, filename: string, useWarning = false) = - var f: tfile - 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: - ErrorHandler(rCannotOpenFile, filename, useWarning) + result = false -var - rnl* = tnl.newRope - softRnl* = tnl.newRope +proc prepend*(a: var Rope, b: string) = a = b & a -proc ropef(frmt: TFormatStr, args: varargs[PRope]): PRope = +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 - 1: - if frmt[i] == '$': + while i < frmt.len: + if frmt[i] == '$': inc(i) # skip '$' case frmt[i] - of '$': - app(result, "$") + of '$': + result.add("$") inc(i) - of '#': + of '#': inc(i) - app(result, args[num]) + result.add(args[num]) inc(num) - of '0'..'9': + of '0'..'9': var j = 0 - while true: - j = (j * 10) + Ord(frmt[i]) - ord('0') + while true: + j = j * 10 + ord(frmt[i]) - ord('0') inc(i) - if (i > length + 0 - 1) or not (frmt[i] in {'0'..'9'}): break + if i >= frmt.len or frmt[i] notin {'0'..'9'}: break num = j if j > high(args) + 1: - ErrorHandler(rInvalidFormatStr, $(j)) + raiseAssert "invalid format string: " & frmt + else: + result.add(args[j-1]) + of '{': + inc(i) + var j = 0 + while frmt[i] in {'0'..'9'}: + j = j * 10 + ord(frmt[i]) - ord('0') + inc(i) + num = j + if frmt[i] == '}': inc(i) + else: + raiseAssert "invalid format string: " & frmt + + if j > high(args) + 1: + raiseAssert "invalid format string: " & frmt else: - app(result, args[j - 1]) + result.add(args[j-1]) of 'n': - app(result, softRnl) - inc i + result.add("\n") + inc(i) of 'N': - app(result, rnl) + result.add("\n") inc(i) else: - ErrorHandler(rInvalidFormatStr, $(frmt[i])) - var start = i - while i < length: - if frmt[i] != '$': inc(i) - else: break - if i - 1 >= start: - app(result, substr(frmt, start, i - 1)) - assert(RopeInvariant(result)) + raiseAssert "invalid format string: " & frmt + else: + result.add(frmt[i]) + inc(i) -{.push stack_trace: off, line_trace: off.} -proc `~`*(r: expr[string]): PRope = - # this is the new optimized "to rope" operator - # the mnemonic is that `~` looks a bit like a rope :) - var r {.global.} = r.ropef - return r -{.pop.} +proc `%`*(frmt: static[FormatStr], args: openArray[Rope]): Rope = + runtimeFormat(frmt, args) -proc appf(c: var PRope, frmt: TFormatStr, args: varargs[PRope]) = - app(c, ropef(frmt, args)) +template addf*(c: var Rope, frmt: FormatStr, args: openArray[Rope]) = + ## shortcut for ``add(c, frmt % args)``. + c.add(frmt % args) -const +const bufSize = 1024 # 1 KB is reasonable -proc auxRopeEqualsFile(r: PRope, bin: var tfile, buf: Pointer): bool = - if r.data != nil: - if r.length > bufSize: - ErrorHandler(rTokenTooLong, r.data) - return - var readBytes = readBuffer(bin, buf, r.length) - result = readBytes == r.length and - equalMem(buf, addr(r.data[0]), r.length) # BUGFIX - else: - result = auxRopeEqualsFile(r.left, bin, buf) - if result: result = auxRopeEqualsFile(r.right, bin, buf) - -proc RopeEqualsFile(r: PRope, f: string): bool = - var bin: tfile - result = open(bin, f) - if not result: - return # not equal if file does not exist - var buf = alloc(BufSize) - result = auxRopeEqualsFile(r, bin, buf) - if result: - result = readBuffer(bin, buf, bufSize) == 0 # really at the end of file? - dealloc(buf) - close(bin) - -proc crcFromRopeAux(r: PRope, startVal: TCrc32): TCrc32 = - if r.data != nil: - result = startVal - for i in countup(0, len(r.data) - 1): - result = updateCrc32(r.data[i], result) - else: - result = crcFromRopeAux(r.left, startVal) - result = crcFromRopeAux(r.right, result) - -proc newCrcFromRopeAux(r: PRope, startVal: TCrc32): TCrc32 = - # XXX profiling shows this is actually expensive - var stack: TRopeSeq = @[r] - result = startVal - while len(stack) > 0: - var it = pop(stack) - while it.data == nil: - add(stack, it.right) - it = it.left - assert(it.data != nil) - var i = 0 - var L = len(it.data) - while i < L: - result = updateCrc32(it.data[i], result) - inc(i) - -proc crcFromRope(r: PRope): TCrc32 = - result = newCrcFromRopeAux(r, initCrc32) - -proc writeRopeIfNotEqual(r: PRope, filename: string): bool = - # returns true if overwritten - var c: TCrc32 - c = crcFromFile(filename) - if c != crcFromRope(r): - writeRope(r, filename) - result = true - else: - result = false +proc equalsFile*(s: Rope, f: File): bool = + ## returns true if the contents of the file `f` equal `r`. + var + buf: array[bufSize, char] = default(array[bufSize, char]) + bpos = buf.len + blen = buf.len + btotal = 0 + rtotal = 0 + + when true: + var spos = 0 + rtotal += s.len + while spos < s.len: + if bpos == blen: + # Read more data + bpos = 0 + blen = readBuffer(f, addr(buf[0]), buf.len) + btotal += blen + if blen == 0: # no more data in file + result = false + return + 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 + return + spos += n + bpos += n + + result = readBuffer(f, addr(buf[0]), 1) == 0 and + btotal == rtotal # check that we've read all + +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 = default(File) + result = open(f, filename.string) + if result: + result = equalsFile(r, f) + close(f) diff --git a/compiler/saturate.nim b/compiler/saturate.nim index e0968843b..fe6e03c8b 100644 --- a/compiler/saturate.nim +++ b/compiler/saturate.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -9,49 +9,49 @@ ## Saturated arithmetic routines. XXX Make part of the stdlib? -proc `|+|`*(a, b: biggestInt): biggestInt = +proc `|+|`*(a, b: BiggestInt): BiggestInt = ## saturated addition. result = a +% b 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 = +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): +proc `|abs|`*(a: BiggestInt): BiggestInt = + 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) +proc `|div|`*(a, b: BiggestInt): BiggestInt = + # (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 -proc `|mod|`*(a, b: biggestInt): biggestInt = +proc `|mod|`*(a, b: BiggestInt): BiggestInt = if b == 0'i64: result = a else: result = a mod b -proc `|*|`*(a, b: biggestInt): biggestInt = +proc `|*|`*(a, b: BiggestInt): BiggestInt = var resAsFloat, floatProd: float64 result = a *% b @@ -72,8 +72,8 @@ proc `|*|`*(a, b: biggestInt): biggestInt = # 32 * abs(diff) <= abs(prod) -- 5 good bits is "close enough" if 32.0 * abs(resAsFloat - floatProd) <= abs(floatProd): 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 new file mode 100644 index 000000000..e3d2bcd45 --- /dev/null +++ b/compiler/scriptconfig.nim @@ -0,0 +1,254 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Implements the new configuration system for Nim. Uses Nim as a scripting +## language. + +import + 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 std/strutils import cmpIgnoreStyle, contains + +proc listDirs(a: VmArgs, filter: set[PathComponent]) = + let dir = getString(a, 0) + var result: seq[string] = @[] + for kind, path in walkDir(dir): + if kind in filter: result.add path + setResult(a, result) + +proc setupVM*(module: PSym; cache: IdentCache; scriptName: string; + graph: ModuleGraph; idgen: IdGenerator): PEvalContext = + # For Nimble we need to export 'setupVM'. + result = newCtx(module, cache, graph, idgen) + result.mode = emRepl + registerAdditionalOps(result) + let conf = graph.config + + # captured vars: + var errorMsg: string + var vthisDir = scriptName.splitFile.dir + + template cbconf(name, body) {.dirty.} = + result.registerCallback "stdlib.system." & astToStr(name), + proc (a: VmArgs) = + body + + template cbexc(name, exc, body) {.dirty.} = + result.registerCallback "stdlib.system." & astToStr(name), + proc (a: VmArgs) = + errorMsg = "" + try: + body + 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 listFilesImpl: + listDirs(a, {pcFile, pcLinkToFile}) + cbos listDirsImpl: + listDirs(a, {pcDir}) + cbos removeDir: + if defined(nimsuggest) or graph.config.cmd == cmdCheck: + discard + else: + os.removeDir(getString(a, 0), getBool(a, 1)) + cbos removeFile: + if defined(nimsuggest) or graph.config.cmd == cmdCheck: + discard + else: + os.removeFile getString(a, 0) + cbos createDir: + os.createDir getString(a, 0) + + 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: + if defined(nimsuggest) or graph.config.cmd == cmdCheck: + discard + else: + os.moveFile(getString(a, 0), getString(a, 1)) + cbos moveDir: + if defined(nimsuggest) or graph.config.cmd == cmdCheck: + discard + else: + os.moveDir(getString(a, 0), getString(a, 1)) + cbos copyFile: + if defined(nimsuggest) or graph.config.cmd == cmdCheck: + discard + else: + os.copyFile(getString(a, 0), getString(a, 1)) + cbos copyDir: + 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: + 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)) + cbconf existsEnv: + 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: + options.setConfigVar(conf, getString(a, 0), getString(a, 1)) + cbconf get: + setResult(a, options.getConfigVar(conf, a.getString 0)) + cbconf exists: + setResult(a, options.existsConfigVar(conf, a.getString 0)) + cbconf nimcacheDir: + setResult(a, options.getNimcacheDir(conf).string) + cbconf paramStr: + setResult(a, os.paramStr(int a.getInt 0)) + cbconf paramCount: + setResult(a, os.paramCount()) + cbconf cmpIgnoreStyle: + setResult(a, strutils.cmpIgnoreStyle(a.getString 0, a.getString 1)) + cbconf cmpIgnoreCase: + setResult(a, strutils.cmpIgnoreCase(a.getString 0, a.getString 1)) + cbconf setCommand: + conf.setCommandEarly(a.getString 0) + let arg = a.getString 1 + 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, + a.getString 1, conf) + cbconf warningImpl: + processSpecificNote(a.getString 0, wWarning, passPP, module.info, + a.getString 1, conf) + cbconf patchFile: + let key = a.getString(0) & "_" & a.getString(1) + var val = a.getString(2).addFileExt(NimExt) + if {'$', '~'} in val: + val = pathSubs(conf, val, vthisDir) + elif not isAbsolute(val): + val = vthisDir / val + conf.moduleOverrides[key] = val + cbconf selfExe: + setResult(a, os.getAppFilename()) + cbconf cppDefine: + options.cppDefine(conf, a.getString(0)) + 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) + connectPipelineCallbacks(graph) + if freshDefines: initDefines(conf.symbols) + + defineSymbol(conf.symbols, "nimscript") + defineSymbol(conf.symbols, "nimconfig") + + 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) + 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) + # do not remove the defined symbols + #initDefines() + undefSymbol(conf.symbols, "nimscript") + undefSymbol(conf.symbols, "nimconfig") + conf.symbolFiles = oldSymbolFiles diff --git a/compiler/sem.nim b/compiler/sem.nim index bcdfc7939..2cf93d365 100644 --- a/compiler/sem.nim +++ b/compiler/sem.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2013 Andreas Rumpf # # See the file "copying.txt", included in this @@ -10,323 +10,860 @@ # This module implements the semantic checking pass. import - ast, strutils, hashes, lists, options, lexer, astalgo, trees, treetab, - wordrecg, ropes, msgs, os, condsyms, idents, renderer, types, platform, math, - magicsys, parser, nversion, nimsets, semfold, importer, - procfind, lookups, rodread, pragmas, passes, semdata, semtypinst, sigmatch, - semthreads, intsets, transf, evals, idgen, aliases, cgmeth, lambdalifting, - evaltempl, patterns, parampatterns, sempass2 + 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, + lowerings, plugins/active, lineinfos, int128, + isolation_check, typeallowed, modulegraphs, enumtostr, concepts, astmsgs, + extccomp + +import vtables +import std/[strtabs, math, tables, intsets, strutils, packedsets] + +when not defined(leanCompiler): + import spawn + +when defined(nimPreviewSlimSystem): + import std/[ + formatfloat, + assertions, + ] # implementation -proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode {.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): PNode -proc changeType(n: PNode, newType: PType, check: bool) +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) proc maybeAddResult(c: PContext, s: PSym, n: PNode) -proc instGenericContainer(c: PContext, n: PNode, header: PType): PType proc tryExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode -proc fixImmediateParams(n: PNode): PNode proc activate(c: PContext, n: PNode) proc semQuoteAst(c: PContext, n: PNode): PNode proc finishMethod(c: PContext, s: PSym) - -proc IndexTypesMatch(c: PContext, f, a: PType, arg: PNode): PNode - -proc typeMismatch(n: PNode, formal, actual: PType) = - if formal.kind != tyError and actual.kind != tyError: - LocalError(n.Info, errGenerated, msgKindToString(errTypeMismatch) & - typeToString(actual) & ") " & - `%`(msgKindToString(errButExpectedX), [typeToString(formal)])) - -proc fitNode(c: PContext, formal: PType, arg: PNode): PNode = +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 + +template semIdeForTemplateOrGenericCheck(conf, n, requiresCheck) = + # we check quickly if the node is where the cursor is + when defined(nimsuggest): + if n.info.fileIndex == conf.m.trackPos.fileIndex and n.info.line == conf.m.trackPos.line: + requiresCheck = true + +template semIdeForTemplateOrGeneric(c: PContext; n: PNode; + requiresCheck: bool) = + # use only for idetools support; this is pretty slow so generics and + # templates perform some quick check whether the cursor is actually in + # the generic or template. + when defined(nimsuggest): + if c.config.cmd == cmdIdeTools and requiresCheck: + #if optIdeDebug in gGlobalOptions: + # 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(arg.info, errExprXHasNoType, + localError(c.config, arg.info, "expression has no type: " & renderTree(arg, {renderNoComments})) # error correction: - result = copyNode(arg) + 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) + result = indexTypesMatch(c, formal, arg.typ, arg) if result == nil: - typeMismatch(arg, formal, arg.typ) + typeMismatch(c.config, info, formal, arg.typ, arg) # error correction: - result = copyNode(arg) + result = copyTree(arg) result.typ = formal + else: + result = fitNodePostMatch(c, formal, result) + +proc fitNodeConsiderViewType(c: PContext, formal: PType, arg: PNode; info: TLineInfo): PNode = + let a = fitNode(c, formal, arg, info) + if formal.kind in {tyVar, tyLent}: + #classifyViewType(formal) != noView: + result = newNodeIT(nkHiddenAddr, a.info, formal) + result.add a + formal.flags.incl tfVarIsPtr + else: + result = a -var CommonTypeBegin = PType(kind: tyExpr) +proc inferWithMetatype(c: PContext, formal: PType, + arg: PNode, coerceDistincts = false): PNode -proc commonType*(x, y: PType): PType = +template commonTypeBegin*(): PType = PType(kind: tyUntyped) + +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 if y == nil: return y - var a = skipTypes(x, {tyGenericInst}) - var b = skipTypes(y, {tyGenericInst}) + 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 - else: result = newType(tyTypeDesc, a.owner) - elif b.kind in {tyArray, tyArrayConstr, tySet, tySequence} and + if not a.hasElementType: result = a + else: + 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 in {tyArray, tyArrayConstr}) - if a.sons[idx].kind == tyEmpty: return y - #elif b.sons[idx].kind == tyEmpty: return x + let idx = ord(b.kind == tyArray) + 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, 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[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 + # 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(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 + # code. + result = a #.skipIntLit + elif a.kind == tyRange and b.kind != tyRange: + 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 - a = a.sons[0] - b = b.sons[0] + # bug #7601, array construction of ptr generic + 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: - if result.isNil: return x - if k != tyNone: + if result.isNil or result == a: return x + if result == b: return y + # bug #7906, tyRef/tyPtr + tyGenericInst of ref/ptr object -> + # 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) + 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 isTopLevel(c: PContext): bool {.inline.} = - result = c.currentScope.depthLevel <= 2 +proc commonType*(c: PContext; x: PType, y: PNode): PType = + # ignore exception raising branches in case/if expressions + if endsInNoReturn(y): return x + commonType(c, x, y.typ) -proc newSymS(kind: TSymKind, n: PNode, c: PContext): PSym = - result = newSym(kind, considerAcc(n), getCurrOwner(), n.info) +proc newSymS(kind: TSymKind, n: PNode, c: PContext): PSym = + 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 = # like newSymS, but considers gensym'ed symbols if n.kind == nkSym: + # and sfGenSym in n.sym.flags: result = n.sym - InternalAssert sfGenSym in result.flags - InternalAssert result.kind == kind + 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, considerAcc(n), getCurrOwner(), 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): + suggestDecl(c, n, result) proc semIdentVis(c: PContext, kind: TSymKind, n: PNode, allowed: TSymFlags): PSym - # identifier with visability -proc semIdentWithPragma(c: PContext, kind: TSymKind, n: PNode, - allowed: TSymFlags): PSym -proc semStmtScope(c: PContext, n: PNode): PNode + # identifier with visibility +proc semIdentWithPragma(c: PContext, kind: TSymKind, n: PNode, + allowed: TSymFlags, fromTopLevel = false): PSym + +proc typeAllowedCheck(c: PContext; info: TLineInfo; typ: PType; kind: TSymKind; + flags: TTypeAllowedFlags = {}) = + let t = typeAllowed(typ, kind, c, flags) + if t != nil: + var err: string + if t == typ: + err = "invalid type: '$1' for $2" % [typeToString(typ), toHumanStr(kind)] + if kind in {skVar, skLet, skConst} and taIsTemplateOrMacro in flags: + err &= ". Did you mean to call the $1 with '()'?" % [toHumanStr(typ.owner.kind)] + else: + err = "invalid type: '$1' in this context: '$2' for $3" % [typeToString(t), + typeToString(typ), toHumanStr(kind)] + localError(c.config, info, err) -proc ParamsTypeCheck(c: PContext, typ: PType) {.inline.} = - if not typeAllowed(typ, skConst): - LocalError(typ.n.info, errXisNoType, typeToString(typ)) +proc paramsTypeCheck(c: PContext, typ: PType) {.inline.} = + typeAllowedCheck(c, typ.n.info, typ, skProc) proc expectMacroOrTemplateCall(c: PContext, n: PNode): PSym +proc semDirectOp(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType = nil): PNode +proc semWhen(c: PContext, n: PNode, semCheck: bool = true): PNode +proc semTemplateExpr(c: PContext, n: PNode, s: PSym, + flags: TExprFlags = {}; expectedType: PType = nil): PNode +proc semMacroExpr(c: PContext, n, nOrig: PNode, sym: PSym, + flags: TExprFlags = {}; expectedType: PType = nil): PNode + +when false: + proc createEvalContext(c: PContext, mode: TEvalMode): PEvalContext = + result = newEvalContext(c.module, mode) + result.getType = proc (n: PNode): PNode = + result = tryExpr(c, n) + if result == nil: + result = newSymNode(errorSym(c, n)) + elif result.typ == nil: + result = newSymNode(getSysSym"void") + else: + result.typ = makeTypeDesc(c, result.typ) + + result.handleIsOperator = proc (n: PNode): PNode = + result = isOpImpl(c, n) + +proc hasCycle(n: PNode): bool = + result = false + incl n.flags, nfNone + for i in 0..<n.safeLen: + if nfNone in n[i].flags or hasCycle(n[i]): + result = true + break + excl n.flags, nfNone + +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 {tyUntyped, tyTyped, tyTypeDesc}: + result = semExprWithType(c, evaluated) + else: + result = evaluated + let expectedType = eOrig.typ.skipTypes({tyStatic}) + if hasCycle(result): + result = localErrorNode(c, eOrig, "the resulting AST is cyclic and cannot be processed further") + else: + semmacrosanity.annotateType(result, expectedType, c.config) + else: + result = semExprWithType(c, evaluated) + #result = fitNode(c, e.typ, result) inlined with special case: + let arg = result + result = indexTypesMatch(c, eOrig.typ, arg.typ, arg) + if result == nil: + result = arg + # for 'tcnstseq' we support [] to become 'seq' + if eOrig.typ.skipTypes(abstractInst).kind == tySequence and + isArrayConstr(arg): + arg.typ = eOrig.typ -proc semTemplateExpr(c: PContext, n: PNode, s: PSym, semCheck = true): PNode +proc tryConstExpr(c: PContext, n: PNode; expectedType: PType = nil): PNode = + var e = semExprWithType(c, n, expectedType = expectedType) + if e == nil: return -proc semMacroExpr(c: PContext, n, nOrig: PNode, sym: PSym, - semCheck: bool = true): PNode -proc semDirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode + result = getConstExpr(c.module, e, c.idgen, c.graph) + if result != nil: return -proc semWhen(c: PContext, n: PNode, semCheck: bool = true): PNode + let oldErrorCount = c.config.errorCounter + let oldErrorMax = c.config.errorMax + let oldErrorOutputs = c.config.m.errorOutputs -proc evalTypedExpr(c: PContext, e: PNode): PNode = - result = getConstExpr(c.module, e) - if result == nil: - result = evalConstExpr(c.module, e) + c.config.m.errorOutputs = {} + c.config.errorMax = high(int) # `setErrorMaxHighMaybe` not appropriate here + + when defined(nimsuggest): + # Remove the error hook so nimsuggest doesn't report errors there + let tempHook = c.graph.config.structuredErrorHook + c.graph.config.structuredErrorHook = nil + + try: + result = evalConstExpr(c.module, c.idgen, c.graph, e) if result == nil or result.kind == nkEmpty: - LocalError(e.info, errConstExprExpected) - # error correction: - result = e + result = nil + else: + result = fixupTypeAfterEval(c, result, e) + + 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 -proc semConstExpr(c: PContext, n: PNode): PNode = - var e = semExprWithType(c, n) +const + errConstExprExpected = "constant expression expected" + +proc semConstExpr(c: PContext, n: PNode; expectedType: PType = nil): PNode = + var e = semExprWithType(c, n, expectedType = expectedType) if e == nil: - LocalError(n.info, errConstExprExpected) + localError(c.config, n.info, errConstExprExpected) return n - result = evalTypedExpr(c, e) - -include hlo, seminst, semcall + 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.idgen, c.graph, e) + if result == nil or result.kind == nkEmpty: + if e.info != n.info: + pushInfoContext(c.config, n.info) + localError(c.config, e.info, errConstExprExpected) + popInfoContext(c.config) + else: + localError(c.config, e.info, errConstExprExpected) + # error correction: + result = e + else: + result = fixupTypeAfterEval(c, result, e) -proc symFromType(t: PType, info: TLineInfo): PSym = - if t.sym != nil: return t.sym - result = newSym(skType, getIdent"AnonType", t.owner, info) - result.flags.incl sfAnon - result.typ = t +proc semExprFlagDispatched(c: PContext, n: PNode, flags: TExprFlags; expectedType: PType = nil): PNode = + if efNeedStatic in flags: + if efPreferNilResult in flags: + return tryConstExpr(c, n, expectedType) + else: + return semConstExpr(c, n, expectedType) + else: + result = semExprWithType(c, n, flags, expectedType) + if efPreferStatic in flags: + var evaluated = getConstExpr(c.module, result, c.idgen, c.graph) + if evaluated != nil: return evaluated + evaluated = evalAtCompileTime(c, result) + if evaluated != nil: return evaluated -proc symNodeFromType(c: PContext, t: PType, info: TLineInfo): PNode = - result = newSymNode(symFromType(t, info), info) - result.typ = makeTypeDesc(c, t) +proc semGenericStmt(c: PContext, n: PNode): PNode -proc semAfterMacroCall(c: PContext, n: PNode, s: PSym): PNode = - inc(evalTemplateCounter) - if evalTemplateCounter > 100: - GlobalError(s.info, errTemplateInstantiationTooNested) +include hlo, seminst, semcall - result = n - if s.typ.sons[0] == nil: - result = semStmt(c, result) +proc resetSemFlag(n: PNode) = + if n != nil: + excl n.flags, nfSem + for i in 0..<n.safeLen: + resetSemFlag(n[i]) + +proc semAfterMacroCall(c: PContext, call, macroResult: PNode, + s: PSym, flags: TExprFlags; 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 + ## reassigned, and binding the unbound identifiers that the macro output + ## contains. + inc(c.config.evalTemplateCounter) + if c.config.evalTemplateCounter > evalTemplateLimit: + globalError(c.config, s.info, "template instantiation too nested") + c.friendModules.add(s.owner.getModule) + result = macroResult + 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) - 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 n.kind == nkStmtList: result.kind = nkStmtListType + if result.kind == nkStmtList: result.transitionSonsKind(nkStmtListType) var typ = semTypeNode(c, result, nil) - result = symNodeFromType(c, typ, n.info) + 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: - result = semExpr(c, result) - result = fitNode(c, s.typ.sons[0], result) - #GlobalError(s.info, errInvalidParamKindX, typeToString(s.typ.sons[0])) - dec(evalTemplateCounter) - -proc semMacroExpr(c: PContext, n, nOrig: PNode, sym: PSym, - semCheck: bool = true): PNode = - markUsed(n, sym) - if sym == c.p.owner: - GlobalError(n.info, errRecursiveDependencyX, sym.name.s) - - if c.evalContext == nil: - c.evalContext = newEvalContext(c.module, emStatic) - c.evalContext.getType = proc (n: PNode): PNode = - var e = tryExpr(c, n) - if e == nil: - result = symNodeFromType(c, errorType(c), n.info) - elif e.typ == nil: - result = newSymNode(getSysSym"void") + 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 = initTypeMapping() + for param, value in genericParamsInMacroCall(s, call): + 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) + + if retType.kind == tyVoid: + result = semStmt(c, result, flags) else: - result = symNodeFromType(c, e.typ, n.info) + result = semExpr(c, result, flags, expectedType) + result = fitNode(c, retType, result, result.info) + #globalError(s.info, errInvalidParamKindX, typeToString(s.typ.returnType)) + dec(c.config.evalTemplateCounter) + discard c.friendModules.pop() + +const + errMissingGenericParamsForTemplate = "'$1' has unspecified generic parameters" + +proc semMacroExpr(c: PContext, n, nOrig: PNode, sym: PSym, + flags: TExprFlags = {}; expectedType: PType = nil): PNode = + rememberExpansion(c, nOrig.info, sym) + pushInfoContext(c.config, nOrig.info, sym.detailedInfo) + + let info = getCallLineInfo(n) + markUsed(c, info, sym) + onUse(info, sym) + if sym == c.p.owner: + globalError(c.config, info, "recursive dependency: '$1'" % sym.name.s) + + let genericParams = sym.ast[genericParamsPos].len + let suppliedParams = max(n.safeLen - 1, 0) + + if suppliedParams < genericParams: + globalError(c.config, info, errMissingGenericParamsForTemplate % n.renderTree) + + #if c.evalContext == nil: + # c.evalContext = c.createEvalContext(emStatic) + result = evalMacroCall(c.module, c.idgen, c.graph, c.templInstCounter, n, nOrig, sym) + if efNoSemCheck notin flags: + result = semAfterMacroCall(c, n, result, sym, flags, 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) + +proc forceBool(c: PContext, n: PNode): PNode = + result = fitNode(c, getSysType(c.graph, n.info, tyBool), n, n.info) + if result == nil: result = n - result = evalMacroCall(c.evalContext, n, nOrig, sym) - if semCheck: result = semAfterMacroCall(c, result, sym) +proc semConstBoolExpr(c: PContext, n: PNode): PNode = + result = forceBool(c, semConstExpr(c, n, getSysType(c.graph, n.info, tyBool))) + if result.kind != nkIntLit: + localError(c.config, n.info, errConstExprExpected) +proc semConceptBody(c: PContext, n: PNode): PNode -proc forceBool(c: PContext, n: PNode): PNode = - result = fitNode(c, getSysType(tyBool), n) - if result == nil: result = n +include semtypes -proc semConstBoolExpr(c: PContext, n: PNode): PNode = - let nn = semExprWithType(c, n) - result = fitNode(c, getSysType(tyBool), nn) - if result == nil: - LocalError(n.info, errConstExprExpected) - return nn - result = getConstExpr(c.module, result) - if result == nil: - LocalError(n.info, errConstExprExpected) - result = nn +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] -include semtypes, semtempl, semgnrc, semstmts, semexprs + 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, skMethod, skConverter} and prc.magic == mNone: - if prc.ast == nil or prc.ast.sons[bodyPos] == nil: - InternalError(prc.info, "no code for " & prc.name.s) + if prc.kind in {skProc, skFunc, skMethod, skConverter} and prc.magic == mNone: + 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(module: PSym): PPassContext = - var c = newContext(module) - if c.p != nil: InternalError(module.info, "sem.myOpen") - c.semConstExpr = semConstExpr - c.semExpr = semExpr - c.semOperand = semOperand - c.semConstBoolExpr = semConstBoolExpr - c.semOverloadedCall = semOverloadedCall - c.semTypeNode = semTypeNode - pushProcCon(c, module) - pushOwner(c.module) - c.importTable = openScope(c) - c.importTable.addSym(module) # a module knows itself - if sfSystemModule in module.flags: - magicsys.SystemModule = module # set global variable! - else: - c.importTable.addSym magicsys.SystemModule # import the "System" identifier - importAllSymbols(c, magicsys.SystemModule) - c.topLevelScope = openScope(c) - result = c - -proc myOpenCached(module: PSym, rd: PRodReader): PPassContext = - result = myOpen(module) - for m in items(rd.methods): methodDef(m, true) - -proc SemStmtAndGenerateGenerics(c: PContext, n: PNode): PNode = - result = semStmt(c, n) - # BUGFIX: process newly generated generics here, not at the end! - if c.lastGenericIdx < c.generics.len: - var a = newNodeI(nkStmtList, n.info) - addCodeForGenerics(c, a) - if sonsLen(a) > 0: - # a generic has been added to `a`: - if result.kind != nkEmpty: addSon(a, result) - result = a +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 + 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: 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 c.topStmts == 0 and not isImportSystemStmt(c.graph, n): + 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: + inc c.topStmts + if sfNoForward in c.module.flags: + result = semAllTypeSections(c, n) + else: + result = n + 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 + # destructor support. + # BUGFIX: process newly generated generics here, not at the end! + if c.lastGenericIdx < c.generics.len: + var a = newNodeI(nkStmtList, n.info) + addCodeForGenerics(c, a) + if a.len > 0: + # a generic has been added to `a`: + if result.kind != nkEmpty: a.add result + result = a result = hloStmt(c, result) - if gCmd == cmdInteractive and not isEmptyType(result.typ): + if c.config.cmd == cmdInteractive and not isEmptyType(result.typ): result = buildEchoStmt(c, result) - result = transformStmt(c.module, result) - -proc RecoverContext(c: PContext) = + if c.config.cmd == cmdIdeTools: + appendToModule(c.module, result) + trackStmt(c, c.module, result, isTopLevel = true) + if optMultiMethods notin c.config.globalOptions and + c.config.selectedGC in {gcArc, gcOrc, gcAtomicArc} and + Feature.vtables in c.config.features: + sortVTableDispatchers(c.graph) + + if sfMainModule in c.module.flags: + collectVTableDispatchers(c.graph) + +proc recoverContext(c: PContext) = # clean up in case of a semantic error: We clean up the stacks, etc. This is - # faster than wrapping every stack operation in a 'try finally' block and + # faster than wrapping every stack operation in a 'try finally' block and # requires far less code. c.currentScope = c.topLevelScope - while getCurrOwner().kind != skModule: popOwner() + 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 msgs.gErrorMax <= 1: - result = SemStmtAndGenerateGenerics(c, n) + if c.config.errorMax <= 1: + result = semStmtAndGenerateGenerics(c, n) else: - let oldContextLen = msgs.getInfoContextLen() - let oldInGenericInst = c.InGenericInst + let oldContextLen = msgs.getInfoContextLen(c.config) + let oldInGenericInst = c.inGenericInst try: - result = SemStmtAndGenerateGenerics(c, n) + result = semStmtAndGenerateGenerics(c, n) except ERecoverableError, ESuggestDone: - RecoverContext(c) - c.InGenericInst = oldInGenericInst - msgs.setInfoContextLen(oldContextLen) - if getCurrentException() of ESuggestDone: result = nil - else: result = ast.emptyNode - #if gCmd == cmdIdeTools: findSuggest(c, n) - -proc checkThreads(c: PContext) = - if not needsGlobalAnalysis(): return - for i in 0 .. c.threadEntries.len-1: - semthreads.AnalyseThreadProc(c.threadEntries[i]) - -proc myClose(context: PPassContext, n: PNode): PNode = - var c = PContext(context) + recoverContext(c) + c.inGenericInst = oldInGenericInst + msgs.setInfoContextLen(c.config, oldContextLen) + if getCurrentException() of ESuggestDone: + c.suggestionsMade = true + result = nil + else: + result = newNodeI(nkEmpty, n.info) + #if c.config.cmd == cmdIdeTools: findSuggest(c, n) + storeRodNode(c, result) + + +proc reportUnusedModules(c: PContext) = + if c.config.cmd == cmdM: return + for i in 0..high(c.unusedImports): + if sfUsed notin c.unusedImports[i][0].flags: + message(c.config, c.unusedImports[i][1], warnUnusedImportX, c.unusedImports[i][0].name.s) + +proc 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(n.info, "n is not nil") #result := n; + internalError(c.config, n.info, "n is not nil") #result := n; addCodeForGenerics(c, result) if c.module.ast != nil: result.add(c.module.ast) - checkThreads(c) - popOwner() + popOwner(c) popProcCon(c) - -const semPass* = makePass(myOpen, myOpenCached, myProcess, myClose) - + sealRodFile(c) diff --git a/compiler/semcall.nim b/compiler/semcall.nim index 735e6fac8..13f2273a9 100644 --- a/compiler/semcall.nim +++ b/compiler/semcall.nim @@ -1,25 +1,28 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2013 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # -## This module implements semantic checking for calls. +## 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: + if a.kind == skMethod and b.kind == skMethod: var aa = lastSon(a.ast) var bb = lastSon(b.ast) if aa.kind == nkSym and bb.kind == nkSym: - if aa.sym == bb.sym: + if aa.sym == bb.sym: result = true else: - nil + discard # generics have no dispatcher yet, so we need to compare the method # names; however, the names are equal anyway because otherwise we # wouldn't even consider them to be overloaded. But even this does @@ -27,191 +30,952 @@ proc sameMethodDispatcher(a, b: PSym): bool = # method collide[T](a: TThing, b: TUnit[T]) is instantiated and not # method collide[T](a: TUnit[T], b: TThing)! This means we need to # *instantiate* every candidate! However, we don't keep more than 2-3 - # candidated around so we cannot implement that for now. So in order + # candidates around so we cannot implement that for now. So in order # to avoid subtle problems, the call remains ambiguous and needs to # be disambiguated by the programmer; this way the right generic is # instantiated. - + proc determineType(c: PContext, s: PSym) -proc resolveOverloads(c: PContext, n, orig: PNode, - filter: TSymKinds): TCandidate = - var initialBinding: PNode - var f = n.sons[0] - if f.kind == nkBracketExpr: - # fill in the bindings: - initialBinding = f - f = f.sons[0] - else: - initialBinding = nil - - var - o: TOverloadIter - alt, z: TCandidate - - template best: expr = result - #Message(n.info, warnUser, renderTree(n)) - var sym = initOverloadIter(o, c, f) - var symScope = o.lastOverloadScope - - if sym == nil: return - initCandidate(best, sym, initialBinding, symScope) - initCandidate(alt, sym, initialBinding, symScope) - - while sym != nil: - if sym.kind in filter: - determineType(c, sym) - initCandidate(z, sym, initialBinding, o.lastOverloadScope) - z.calleeSym = sym +proc initCandidateSymbols(c: PContext, headSymbol: PNode, + initialBinding: PNode, + filter: TSymKinds, + 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: + best = initCandidate(c, result[0].s, initialBinding, + result[0].scope, diagnostics) + alt = initCandidate(c, result[0].s, initialBinding, + result[0].scope, diagnostics) + best.state = csNoMatch + +proc pickBestCandidate(c: PContext, headSymbol: PNode, + n, orig: PNode, + initialBinding: PNode, + filter: TSymKinds, + best, alt: var TCandidate, + errors: var CandidateErrors, + diagnosticsFlag: bool, + 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) + z = initCandidate(c, sym, initialBinding, scope, diagnosticsFlag) + + # this is kinda backwards as without a check here the described + # problems in recalc would not happen, but instead it 100% + # does check forever in some cases + if c.currentScope.symbols.counter == symCount: + # may introduce new symbols with caveats described in recalc branch matches(c, n, orig, z) + if z.state == csMatch: # little hack so that iterators are preferred over everything else: - if sym.kind == skIterator: inc(z.exactMatches, 200) + if sym.kind == skIterator: + if not (efWantIterator notin flags and efWantIterable in flags): + inc(z.exactMatches, 200) + else: + dec(z.exactMatches, 200) case best.state of csEmpty, csNoMatch: best = z of csMatch: var cmp = cmpCandidates(best, z) 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 - else: nil - sym = nextOverloadIter(o, c, f) - - if best.state == csEmpty: - # no overloaded proc found - # do not generate an error yet; the semantic checking will check for - # an overloaded () operator - elif alt.state == csMatch and cmpCandidates(best, alt) == 0 and - not sameMethodDispatcher(best.calleeSym, alt.calleeSym): - if best.state != csMatch: - InternalError(n.info, "x.state is not csMatch") - #writeMatches(best) + elif errorsEnabled or z.diagnosticsEnabled: + errors.add(CandidateError( + sym: sym, + 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) + + # reset counter because syms may be in a new order + symCount = c.currentScope.symbols.counter + nextSymIndex = 0 + + # just in case, should be impossible though + if syms.len == 0: + break + + if nextSymIndex > high(syms): + # we have reached the end + break + + # advance to next sym + sym = syms[nextSymIndex].s + scope = syms[nextSymIndex].scope + inc(nextSymIndex) + + +proc effectProblem(f, a: PType; result: var string; c: PContext) = + if f.kind == tyProc and a.kind == tyProc: + if tfThread in f.flags and tfThread notin a.flags: + result.add "\n This expression is not GC-safe. Annotate the " & + "proc with {.gcsafe.} to get extended error information." + elif tfNoSideEffect in f.flags and tfNoSideEffect notin a.flags: + result.add "\n This expression can have side effects. Annotate the " & + "proc with {.noSideEffect.} to get extended error information." + else: + case compatibleEffects(f, a) + of efCompat: discard + of efRaisesDiffer: + result.add "\n The `.raises` requirements differ." + of efRaisesUnknown: + result.add "\n The `.raises` requirements differ. Annotate the " & + "proc with {.raises: [].} to get extended error information." + of efTagsDiffer: + result.add "\n The `.tags` requirements differ." + of efTagsUnknown: + result.add "\n The `.tags` requirements differ. Annotate the " & + "proc with {.tags: [].} to get extended error information." + of 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 + 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): + (TPreferedDesc, string) = + var prefer = preferName + # to avoid confusing errors like: + # got (SslPtr, SocketHandle) + # but expected one of: + # openssl.SSL_set_fd(ssl: SslPtr, fd: SocketHandle): cint + # we do a pre-analysis. If all types produce the same string, we will add + # module information. + let proto = describeArgs(c, n, 1, preferName) + for err in errors: + var errProto = "" + let n = err.sym.typ.n + for i in 1..<n.len: + var p = n[i] + if p.kind == nkSym: + 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: + candidates.add(renderTree(err.sym.ast, + {renderNoBody, renderNoComments, renderNoPragmas})) + else: + candidates.add(getProcHeader(c.config, err.sym, prefer)) + candidates.addDeclaredLocMaybe(c.config, err.sym) + candidates.add("\n") + 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: + candidates.add(" first type mismatch at position: " & $err.firstMismatch.arg) + if err.firstMismatch.kind in genericParamMismatches: + candidates.add(" in generic parameters") + # candidates.add "\n reason: " & $err.firstMismatch.kind # for debugging + case err.firstMismatch.kind + of kUnknownNamedParam: + if nArg == nil: + candidates.add("\n unknown named parameter") + else: + candidates.add("\n unknown named parameter: " & $nArg[0]) + of kAlreadyGiven: candidates.add("\n named param already provided: " & $nArg[0]) + of kPositionalAlreadyGiven: candidates.add("\n positional param was already given as named param") + of kExtraArg: candidates.add("\n extra argument given") + of kMissingParam: candidates.add("\n missing parameter: " & nameParam) + of kExtraGenericParam: + candidates.add("\n extra generic param given") + of kMissingGenericParam: + candidates.add("\n missing generic parameter: " & nameParam) + of kTypeMismatch, kGenericParamTypeMismatch, kVarNeeded: + doAssert nArg != nil + var wanted = err.firstMismatch.formal.typ + if isGenericMismatch and wanted.kind == tyGenericParam and + wanted.genericParamHasConstraints: + wanted = wanted.genericConstraint + doAssert err.firstMismatch.formal != nil + candidates.add("\n required type for " & nameParam & ": ") + candidates.addTypeDeclVerboseMaybe(c.config, wanted) + candidates.add "\n but expression '" + if err.firstMismatch.kind == kVarNeeded: + candidates.add renderNotLValue(nArg) + candidates.add "' is immutable, not 'var'" + else: + candidates.add renderTree(nArg) + candidates.add "' is of type: " + var got = nArg.typ + if isGenericMismatch: got = got.skipTypes({tyTypeDesc}) + candidates.addTypeDeclVerboseMaybe(c.config, got) + if nArg.kind in nkSymChoices: + candidates.add "\n" + candidates.add ambiguousIdentifierMsg(nArg, indent = 2) + doAssert wanted != nil + if got != nil: + if got.kind == tyProc and wanted.kind == tyProc: + # These are proc mismatches so, + # add the extra explict detail of the mismatch + candidates.addPragmaAndCallConvMismatch(wanted, got, c.config) + effectProblem(wanted, got, candidates, c) + + of kUnknown: discard "do not break 'nim check'" + candidates.add "\n" + if err.firstMismatch.arg == 1 and nArg != nil and + nArg.kind == nkTupleConstr and n.kind == nkCommand: + maybeWrongSpace = true + for diag in err.diagnostics: + candidates.add(diag & "\n") + 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:" + 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 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: + if n[0].kind in nkIdentKinds: + let ident = considerQuotedIdent(c, n[0], n).s + localError(c.config, n.info, errUndeclaredRoutine % ident) + else: + localError(c.config, n.info, "expression '$1' cannot be called" % n[0].renderTree) + return + + if verboseTypeMismatch in c.config.legacyFeatures: + legacynotFoundError(c, n, errors) + else: + 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 = default(TCandidate) + var f = n[0] + if f.kind == nkBracketExpr: + # fill in the bindings: + semOpAux(c, f) + initialBinding = f + f = f[0] + else: + initialBinding = nil + + 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, dummyErrors, efExplain in flags, + false, flags) + + let overloadsState = result.state + if overloadsState != csMatch: + if nfDotField in n.flags: + internalAssert c.config, f.kind == nkIdent and n.len >= 2 + + # leave the op head symbol empty, + # we are going to try multiple variants + n.sons[0..1] = [nil, n[1], f] + orig.sons[0..1] = [nil, orig[1], f] + + template tryOp(x) = + let op = newIdentNode(getIdent(c.cache, x), n.info) + n[0] = op + orig[0] = op + pickSpecialOp(op) + + if nfExplicitCall in n.flags: + tryOp ".()" + + if result.state in {csEmpty, csNoMatch}: + tryOp "." + + 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..^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] + pickSpecialOp(callOp) + + if overloadsState == csEmpty and result.state == csEmpty: + if efNoUndeclared notin flags: # for tests/pragmas/tcustom_pragma.nim + result.state = csNoMatch + if c.inGenericContext > 0 and nfExprCall in n.flags: + # untyped expression calls end up here, see #24099 + return + # xxx adapt/use errorUndeclaredIdentifierHint(c, n, f.ident) + localError(c.config, n.info, getMsgDiagnostic(c, flags, n, f)) + return + elif result.state != csMatch: + if nfExprCall in n.flags: + localError(c.config, n.info, "expression '$1' cannot be called" % + renderTree(n, {renderNoComments})) + else: + if {nfDotField, nfDotSetter} * n.flags != {}: + # clean up the inserted ops + n.sons.delete(2) + n[0] = f + return + if alt.state == csMatch and cmpCandidates(result, alt) == 0 and + not sameMethodDispatcher(result.calleeSym, alt.calleeSym): + internalAssert c.config, result.state == csMatch + #writeMatches(result) #writeMatches(alt) - if c.inCompilesContext > 0: + if c.config.m.errorOutputs == {}: # quick error message for performance of 'compiles' built-in: - GlobalError(n.Info, errGenerated, "ambiguous call") - elif gErrorCounter == 0: + globalError(c.config, n.info, errGenerated, "ambiguous call") + 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(n.Info, errGenerated, msgKindToString(errAmbiguousCallXYZ) % [ - getProcHeader(best.calleeSym), getProcHeader(alt.calleeSym), + 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 and - isGenericRoutine(a.sons[0].sym): - let finalCallee = generateInstance(c, a.sons[0].sym, x.bindings, a.info) - a.sons[0].sym = finalCallee - a.sons[0].typ = finalCallee.typ - #a.typ = finalCallee.typ.sons[0] + 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[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(m, f) - result = paramTypesMatch(c, m, f, a, arg, nil) +proc indexTypesMatch(c: PContext, f, a: PType, arg: PNode): PNode = + var m = newCandidate(c, f) + result = paramTypesMatch(m, f, a, arg, nil) if m.genericConverter and result != nil: instGenericConvertersArg(c, result, m) -proc ConvertTo*(c: PContext, f: PType, n: PNode): PNode = - var m: TCandidate - initCandidate(m, f) - result = paramTypesMatch(c, m, f, n.typ, n, nil) +proc inferWithMetatype(c: PContext, formal: PType, + arg: PNode, coerceDistincts = false): PNode = + var m = newCandidate(c, formal) + m.coerceDistincts = coerceDistincts + result = paramTypesMatch(m, formal, arg.typ, arg, nil) if m.genericConverter and result != nil: instGenericConvertersArg(c, result, m) + if result != nil: + # This almost exactly replicates the steps taken by the compiler during + # param matching. It performs an embarrassing amount of back-and-forth + # type jugling, but it's the price to pay for consistency and correctness + result.typ = generateTypeInstance(c, m.bindings, arg.info, + formal.skipTypes({tyCompositeTypeClass})) + else: + typeMismatch(c.config, arg.info, formal, arg.typ, arg) + # error correction: + result = copyTree(arg) + result.typ = formal + +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 semResolvedCall(c: PContext, n: PNode, x: TCandidate): PNode = +proc inheritBindings(c: PContext, x: var TCandidate, expectedType: PType) = + ## Helper proc to inherit bound generic parameters from expectedType into x. + ## Does nothing if 'inferGenericTypes' isn't in c.features. + if inferGenericTypes notin c.features: return + if expectedType == nil or x.callee.returnType == nil: return # required for inference + + var + flatUnbound: seq[PType] = @[] + flatBound: seq[PType] = @[] + # seq[(result type, expected type)] + var typeStack = newSeq[(PType, PType)]() + + template stackPut(a, b) = + ## skips types and puts the skipped version on stack + # It might make sense to skip here one by one. It's not part of the main + # type reduction because the right side normally won't be skipped + const toSkip = {tyVar, tyLent, tyStatic, tyCompositeTypeClass, tySink} + let + x = a.skipTypes(toSkip) + y = if a.kind notin toSkip: b + else: b.skipTypes(toSkip) + typeStack.add((x, y)) + + stackPut(x.callee.returnType, expectedType) + + while typeStack.len() > 0: + let (t, u) = typeStack.pop() + if t == u or t == nil or u == nil or t.kind == tyAnything or u.kind == tyAnything: + continue + case t.kind + of ConcreteTypes, tyGenericInvocation, tyUncheckedArray: + # XXX This logic makes no sense for `tyUncheckedArray` + # nested, add all the types to stack + let + startIdx = if u.kind in ConcreteTypes: 0 else: 1 + endIdx = min(u.kidsLen() - startIdx, t.kidsLen()) + + for i in startIdx ..< endIdx: + # early exit with current impl + if t[i] == nil or u[i] == nil: return + stackPut(t[i], u[i]) + of tyGenericParam: + let prebound = x.bindings.idTableGet(t) + if prebound != nil: + continue # Skip param, already bound + + # fully reduced generic param, bind it + if t notin flatUnbound: + flatUnbound.add(t) + flatBound.add(u) + else: + discard + # update bindings + for i in 0 ..< flatUnbound.len(): + x.bindings.idTablePut(flatUnbound[i], flatBound[i]) + +proc semResolvedCall(c: PContext, x: var TCandidate, + n: PNode, flags: TExprFlags; + expectedType: PType = nil): PNode = assert x.state == csMatch var finalCallee = x.calleeSym - markUsed(n.sons[0], finalCallee) - if finalCallee.ast == nil: - internalError(n.info, "calleeSym.ast is nil") # XXX: remove this check! - if finalCallee.ast.sons[genericParamsPos].kind != nkEmpty: - # a generic proc! - if not x.proxyMatch: - finalCallee = generateInstance(c, x.calleeSym, x.bindings, n.info) + let info = getCallLineInfo(n) + markUsed(c, info, finalCallee) + onUse(info, finalCallee) + assert finalCallee.ast != nil + if x.matchedErrorType: + result = x.call + 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[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: - result = x.call - result.sons[0] = newSymNode(finalCallee, result.sons[0].info) - result.typ = finalCallee.typ.sons[0] - if ContainsGenericType(result.typ): result.typ = errorType(c) - return + # For macros and templates, the resolved generic params + # are added as normal params. + c.inheritBindings(x, expectedType) + for s in instantiateGenericParamList(c, gp, x.bindings): + case s.kind + of skConst: + if not s.astdef.isNil: + x.call.add s.astdef + else: + x.call.add c.graph.emptyNode + of skType: + 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; + t != nil and t.skipTypes({tyGenericInst, tyAlias, tySink}).kind in {tyPtr, tyRef}) + +proc tryDeref(n: PNode): PNode = + result = newNodeI(nkHiddenDeref, n.info) + result.typ = n.typ.skipTypes(abstractInst)[0] + result.add n proc semOverloadedCall(c: PContext, n, nOrig: PNode, - filter: TSymKinds): PNode = - var r = resolveOverloads(c, n, nOrig, filter) - if r.state == csMatch: result = semResolvedCall(c, n, r) - -proc explicitGenericInstError(n: PNode): PNode = - LocalError(n.info, errCannotInstantiateX, renderTree(n)) + 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 + if errors.len > 0: + let (_, candidates) = presentFailedCandidates(c, n, errors) + message(c.config, n.info, hintUserRaw, + "Non-matching candidates for " & renderTree(n) & "\n" & + candidates) + result = semResolvedCall(c, r, n, flags, expectedType) + else: + 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) + result = semOverloadedCall(c, n, nOrig, filter, flags + {efExplain}) + elif efNoUndeclared notin flags: + result = nil + notFoundError(c, n, errors) + else: + result = nil + +proc explicitGenericInstError(c: PContext; n: PNode): PNode = + localError(c.config, getCallLineInfo(n), errCannotInstantiateX % renderTree(n)) result = n proc explicitGenericSym(c: PContext, n: PNode, s: PSym): PNode = - var x: TCandidate - initCandidate(x, s, n) - var newInst = generateInstance(c, s, x.bindings, n.info) - markUsed(n, s) - result = newSymNode(newInst, n.info) + if s.kind in {skTemplate, skMacro}: + internalError c.config, n.info, "cannot get explicitly instantiated symbol of " & + (if s.kind == skTemplate: "template" else: "macro") + # binding has to stay 'nil' for this to work! + var m = newCandidate(c, s, nil) + matchGenericParams(m, n, s) + if m.state != csMatch: + # state is csMatch only if *all* generic params were matched, + # including implicit parameters + return nil + var newInst = generateInstance(c, s, m.bindings, n.info) + newInst.typ.flags.excl tfUnresolved + let info = getCallLineInfo(n) + 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 = +proc explicitGenericInstantiation(c: PContext, n: PNode, s: PSym): PNode = assert n.kind == nkBracketExpr - for i in 1..sonsLen(n)-1: - n.sons[i].typ = semTypeNode(c, n.sons[i], nil) + 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(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) elif a.kind in {nkClosedSymChoice, nkOpenSymChoice}: # choose the generic proc with the proper number of type parameters. - # XXX I think this could be improved by reusing sigmatch.ParamTypesMatch. + # 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 - if candidate.kind in {skProc, skMethod, skConverter, skIterator}: - # if suffices that the candidate has the proper number of generic + 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: - result.add(explicitGenericSym(c, n, candidate)) + 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: if result.len == 1 and a.kind == nkClosedSymChoice: result = result[0] - # candidateCount != 1: return explicitGenericInstError(n) + elif result.len == 0: result = explicitGenericInstError(c, n) + # candidateCount != 1: return explicitGenericInstError(c, n) else: - result = explicitGenericInstError(n) + 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: - var call = newNode(nkCall) + 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}) - call.add(newNodeIT(nkEmpty, fn.info, t.baseOfDistinct)) - var resolved = semOverloadedCall(c, call, call, {fn.kind}) - if resolved != nil: - result = resolved.sons[0].sym + for i in 1..<fn.typ.n.len: + 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(param.typ.kind, c) + x.addSonSkipIntLit(getType(isDistinct, t), c.idgen) + else: + x = getType(isDistinct, t) + var s = copySym(param.sym, c.idgen) + s.typ = x + s.info = param.info + call.add(newSymNode(s)) + if hasDistinct: + let filter = if fn.kind in {skProc, skFunc}: {skProc, skFunc} else: {fn.kind} + var resolved = semOverloadedCall(c, call, call, filter, {}) + if resolved != nil: + result.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.state = bsNotSupported + else: + result.state = bsNoDistinct diff --git a/compiler/semdata.nim b/compiler/semdata.nim index 72d5a5fef..ca35ddc53 100644 --- a/compiler/semdata.nim +++ b/compiler/semdata.nim @@ -1,7 +1,7 @@ # # -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2017 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -9,237 +9,627 @@ ## This module contains the data structures for the semantic checking phase. -import - strutils, lists, intsets, options, lexer, ast, astalgo, trees, treetab, - wordrecg, - ropes, msgs, platform, os, condsyms, idents, renderer, types, extccomp, math, - magicsys, nversion, nimsets, parser, times, passes, rodread, evals +import std/[tables, intsets, sets] -type - TOptionEntry* = object of lists.TListEntry # entries to put on a - # stack for pragma parsing +when defined(nimPreviewSlimSystem): + import std/assertions + +import + 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 options*: TOptions defaultCC*: TCallingConvention dynlib*: PLib - Notes*: TNoteKinds + notes*: TNoteKinds + features*: set[Feature] otherPragmas*: PNode # every pragma can be pushed + warningAsErrors*: TNoteKinds POptionEntry* = ref TOptionEntry PProcCon* = ref TProcCon - TProcCon*{.final.} = 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) nestedLoopCounter*: int # whether we are in a loop or not nestedBlockCounter*: int # whether we are in a block or not - InTryStmt*: int # whether we are in a try statement; works also - # in standalone ``except`` and ``finally`` + breakInLoop*: bool # whether we are in a loop without block next*: PProcCon # used for stacking procedure contexts - + mappingExists*: bool + mapping*: Table[ItemId, PSym] + caseContext*: seq[tuple[n: PNode, idx: int]] + localBindStmts*: seq[PNode] + + TMatchedConcept* = object + candidateType*: PType + prev*: ptr TMatchedConcept + depth*: int + TInstantiationPair* = object genericSym*: PSym inst*: PInstantiation - TExprFlag* = enum - efLValue, efWantIterator, efInTypeof, efWantStmt, efDetermineType, - efAllowDestructor + TExprFlag* = enum + efLValue, efWantIterator, efWantIterable, efInTypeof, + efNeedStatic, + # Use this in contexts where a static value is mandatory + efPreferStatic, + # Use this in contexts where a static value could bring more + # information, but it's not strictly mandatory. This may become + # the default with implicit statics in the future. + efPreferNilResult, + # Use this if you want a certain result (e.g. static value), + # but you don't want to trigger a hard error. For example, + # you may be in position to supply a better error message + # to the user. + efWantStmt, efAllowStmt, efDetermineType, efExplain, + efWantValue, efOperand, efNoSemCheck, + efNoEvaluateGeneric, efInCall, efFromHlo, efNoSem2Check, + efNoUndeclared, 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] + 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 - friendModule*: PSym # current friend module; may access private data; + 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 - - threadEntries*: TSymSeq # list of thread entries to check - AmbiguousSymbols*: TIntSet # ids of all ambiguous symbols (cannot - # store this info in the syms themselves!) - InGenericContext*: int # > 0 if we are in a generic type - InUnrolledContext*: int # > 0 if we are unrolling a loop - InCompilesContext*: int # > 0 if we are in a ``compiles`` magic - InGenericInst*: int # > 0 if we are instantiating a generic - converters*: TSymSeq # sequence of converters - patterns*: TSymSeq # sequence of pattern matchers - optionStack*: TLinkedList - symMapping*: TIdTable # every gensym'ed symbol needs to be mapped - # to some new symbol in a generic instantiation - libs*: TLinkedList # 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.} + instCounter*: int # to prevent endless instantiations + 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*: seq[PSym] + patterns*: seq[PSym] # sequence of pattern matchers + optionStack*: seq[POptionEntry] + libs*: seq[PLib] # all libs used by this module + 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; 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): PNode {.nimcall.} + filter: TSymKinds, flags: TExprFlags, expectedType: PType = nil): PNode {.nimcall.} semTypeNode*: proc(c: PContext, n: PNode, prev: PType): PType {.nimcall.} - includedFiles*: TIntSet # used to detect recursive include files + 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 evalContext*: PEvalContext - UnknownIdents*: TIntSet # ids of all unknown identifiers to prevent + unknownIdents*: IntSet # ids of all unknown identifiers to prevent # naming it multiple times generics*: seq[TInstantiationPair] # pending list of instantiated generics to compile + topStmts*: int # counts the number of encountered top level statements lastGenericIdx*: int # used for the generics stack - + hloLoopDetector*: int # used to prevent endless loops in the HLO + inParallelStmt*: int + instTypeBoundOp*: proc (c: PContext; dc: PSym; t: PType; info: TLineInfo; + op: TTypeAttachedOp; col: int): PSym {.nimcall.} + cache*: IdentCache + graph*: ModuleGraph + signatures*: TStrTable + recursiveDep*: string + suggestionsMade*: bool + isAmbiguous*: bool # little hack + features*: set[Feature] + 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 c.module.filename - -proc newContext*(module: PSym): PContext - -proc lastOptionEntry*(c: PContext): POptionEntry -proc newOptionEntry*(): POptionEntry -proc newLib*(kind: TLibKind): PLib -proc addToLib*(lib: PLib, sym: PSym) -proc makePtrType*(c: PContext, baseType: PType): PType -proc makeVarType*(c: PContext, baseType: PType): PType -proc newTypeS*(kind: TTypeKind, c: PContext): PType -proc fillTypeS*(dest: PType, kind: TTypeKind, c: PContext) + result = toFilename(c.config, FileIndex c.module.position) proc scopeDepth*(c: PContext): int {.inline.} = result = if c.currentScope != nil: c.currentScope.depthLevel else: 0 -# owner handling: -proc getCurrOwner*(): PSym -proc PushOwner*(owner: PSym) -proc PopOwner*() -# implementation - -var gOwners*: seq[PSym] = @[] - -proc getCurrOwner(): PSym = +proc getCurrOwner*(c: PContext): PSym = # owner stack (used for initializing the # owner field of syms) # the documentation comment always gets # assigned to the current owner - # BUGFIX: global array is needed! - result = gOwners[high(gOwners)] - -proc PushOwner(owner: PSym) = - add(gOwners, owner) - -proc PopOwner() = - var length = len(gOwners) - if length > 0: setlen(gOwners, length - 1) - else: InternalError("popOwner") - -proc lastOptionEntry(c: PContext): POptionEntry = - result = POptionEntry(c.optionStack.tail) - -proc pushProcCon*(c: PContext, owner: PSym) {.inline.} = - if owner == nil: - InternalError("owner is nil") - return - var x: PProcCon - new(x) - x.owner = owner - x.next = c.p - c.p = x + result = c.graph.owners[^1] + +proc pushOwner*(c: PContext; owner: PSym) = + c.graph.owners.add(owner) + +proc popOwner*(c: PContext) = + if c.graph.owners.len > 0: setLen(c.graph.owners, c.graph.owners.len - 1) + else: internalError(c.config, "popOwner") + +proc lastOptionEntry*(c: PContext): POptionEntry = + result = c.optionStack[^1] proc popProcCon*(c: PContext) {.inline.} = c.p = c.p.next -proc newOptionEntry(): POptionEntry = +proc put*(p: PProcCon; key, val: PSym) = + if not p.mappingExists: + p.mapping = initTable[ItemId, PSym]() + p.mappingExists = true + #echo "put into table ", key.info + p.mapping[key.itemId] = val + +proc get*(p: PProcCon; key: PSym): PSym = + 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 + var it = c.p + while it != nil: + result = get(it, s) + if result != nil: + #echo "got from table ", result.name.s, " ", result.info + return result + it = it.next + result = s + +proc considerGenSyms*(c: PContext; n: PNode) = + 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[i]) + +proc newOptionEntry*(conf: ConfigRef): POptionEntry = new(result) - result.options = gOptions - result.defaultCC = ccDefault + result.options = conf.options + result.defaultCC = ccNimCall result.dynlib = nil - result.notes = gNotes + result.notes = conf.notes + result.warningAsErrors = conf.warningAsErrors -proc newContext(module: PSym): PContext = +proc pushOptionEntry*(c: PContext): POptionEntry = new(result) - result.AmbiguousSymbols = initIntset() - initLinkedList(result.optionStack) - initLinkedList(result.libs) - append(result.optionStack, newOptionEntry()) + 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.optionStack = @[newOptionEntry(graph.config)] + result.libs = @[] result.module = module - result.friendModule = module - result.threadEntries = @[] + result.friendModules = @[module] result.converters = @[] result.patterns = @[] result.includedFiles = initIntSet() - initStrTable(result.userPragmas) + result.pureEnumFields = initStrTable() + result.userPragmas = initStrTable() result.generics = @[] - result.UnknownIdents = initIntSet() - -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) - -proc newLib(kind: TLibKind): PLib = + result.unknownIdents = initIntSet() + result.cache = graph.cache + result.graph = graph + result.signatures = initStrTable() + result.features = graph.config.features + 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) - -proc addToLib(lib: PLib, sym: PSym) = + 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 makePtrType(c: PContext, baseType: PType): PType = - result = newTypeS(tyPtr, c) - addSonSkipIntLit(result, baseType.AssertNotNil) - -proc makeVarType(c: PContext, baseType: PType): PType = - result = newTypeS(tyVar, c) - addSonSkipIntLit(result, baseType.AssertNotNil) - -proc makeTypeDesc*(c: PContext, typ: PType): PType = - result = newTypeS(tyTypeDesc, c) - result.addSonSkipIntLit(typ.AssertNotNil) +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 = + makePtrType(getCurrOwner(c), baseType, c.idgen) + +proc makeTypeWithModifier*(c: PContext, + modifier: TTypeKind, + baseType: PType): PType = + assert modifier in {tyVar, tyLent, tyPtr, tyRef, tyStatic, tyTypeDesc} + + if modifier in {tyVar, tyLent, tyTypeDesc} and baseType.kind == modifier: + result = baseType + else: + 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, skipIntLit(baseType, c.idgen)) + +proc makeTypeSymNode*(c: PContext, typ: PType, info: TLineInfo): PNode = + let typedesc = newTypeS(tyTypeDesc, c) + incl typedesc.flags, tfCheckedForDestructor + internalAssert(c.config, typ != nil) + typedesc.addSonSkipIntLit(typ, c.idgen) + let sym = newSym(skType, c.cache.idAnon, c.idgen, getCurrOwner(c), info, + c.config.options).linkTo(typedesc) + result = newSymNode(sym, info) + +proc makeTypeFromExpr*(c: PContext, n: PNode): PType = + result = newTypeS(tyFromExpr, c) + assert n != nil + result.n = n -proc newTypeS(kind: TTypeKind, c: PContext): PType = - result = newType(kind, getCurrOwner()) +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, 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: newTypeS(tyStatic, c, n.typ) + +proc makeAndType*(c: PContext, t1, t2: PType): PType = + result = newTypeS(tyAnd, c) + 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 = + if t1.kind != tyOr and t2.kind != tyOr: + 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.kids: result.rawAddSon x + else: + result.rawAddSon t1 + addOr(t1) + addOr(t2) + propagateToOwner(result, t1) + propagateToOwner(result, t2) + result.flags.incl((t1.flags + t2.flags) * {tfHasStatic}) + result.flags.incl tfHasMeta + +proc makeNotType*(c: PContext, t1: PType): PType = + 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 = 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, son = intType) + if n.typ != nil and n.typ.n == nil: + result.flags.incl tfUnresolved + result.n = newTreeI(nkRange, n.info, newIntTypeNode(0, intType), + makeStaticExpr(c, nMinusOne(c, n))) + +template rangeHasUnresolvedStatic*(t: PType): bool = + tfUnresolved in t.flags 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) -proc fillTypeS(dest: PType, kind: TTypeKind, c: PContext) = +# 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() + dest.owner = getCurrOwner(c) dest.size = - 1 -proc makeRangeType*(c: PContext, first, last: biggestInt, - info: TLineInfo): PType = +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, newIntNode(nkIntLit, first)) - addSon(n, newIntNode(nkIntLit, last)) + n.add newIntTypeNode(first, intType) + n.add newIntTypeNode(last, intType) result = newTypeS(tyRange, c) result.n = n - rawAddSon(result, getSysType(tyInt)) # 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, skConverter, skMethod, skIterator}: + if s.kind in {skProc, skFunc, skConverter, skMethod, skIterator}: incl(s.flags, sfAddrTaken) # XXX add to 'c' for global analysis -proc illFormedAst*(n: PNode) = - GlobalError(n.info, errIllFormedAstX, renderTree(n, {renderNoComments})) - -proc checkSonsLen*(n: PNode, length: int) = - if sonsLen(n) != length: illFormedAst(n) - -proc checkMinSonsLen*(n: PNode, length: int) = - if sonsLen(n) < length: illFormedAst(n) - +proc illFormedAst*(n: PNode; conf: ConfigRef) = + globalError(conf, n.info, errIllFormedAstX, renderTree(n, {renderNoComments})) + +proc illFormedAstLocal*(n: PNode; conf: ConfigRef) = + localError(conf, n.info, errIllFormedAstX, renderTree(n, {renderNoComments})) + +proc checkSonsLen*(n: PNode, length: int; conf: ConfigRef) = + if n.len != length: illFormedAst(n, conf) + +proc checkMinSonsLen*(n: PNode, length: int; conf: ConfigRef) = + 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/semdestruct.nim b/compiler/semdestruct.nim deleted file mode 100644 index 797d8895e..000000000 --- a/compiler/semdestruct.nim +++ /dev/null @@ -1,213 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## This module implements destructors. - - -# special marker values that indicates that we are -# 1) AnalyzingDestructor: currently analyzing the type for destructor -# generation (needed for recursive types) -# 2) DestructorIsTrivial: completed the analysis before and determined -# that the type has a trivial destructor -var AnalyzingDestructor, DestructorIsTrivial: PSym -new(AnalyzingDestructor) -new(DestructorIsTrivial) - -var - destructorName = getIdent"destroy_" - destructorParam = getIdent"this_" - destructorPragma = newIdentNode(getIdent"destructor", UnknownLineInfo()) - rangeDestructorProc*: PSym - -proc instantiateDestructor(c: PContext, typ: PType): bool - -proc doDestructorStuff(c: PContext, s: PSym, n: PNode) = - let t = s.typ.sons[1].skipTypes({tyVar}) - t.destructor = s - # automatically insert calls to base classes' destructors - if n.sons[bodyPos].kind != nkEmpty: - for i in countup(0, t.sonsLen - 1): - # when inheriting directly from object - # there will be a single nil son - if t.sons[i] == nil: continue - if instantiateDestructor(c, t.sons[i]): - n.sons[bodyPos].addSon(newNode(nkCall, t.sym.info, @[ - useSym(t.sons[i].destructor), - n.sons[paramsPos][1][0]])) - -proc destroyField(c: PContext, field: PSym, holder: PNode): PNode = - if instantiateDestructor(c, field.typ): - result = newNode(nkCall, field.info, @[ - useSym(field.typ.destructor), - newNode(nkDotExpr, field.info, @[holder, useSym(field)])]) - -proc destroyCase(c: PContext, n: PNode, holder: PNode): PNode = - var nonTrivialFields = 0 - result = newNode(nkCaseStmt, n.info, @[]) - # case x.kind - result.addSon(newNode(nkDotExpr, n.info, @[holder, n.sons[0]])) - for i in countup(1, n.len - 1): - # of A, B: - var caseBranch = newNode(n[i].kind, n[i].info, n[i].sons[0 .. -2]) - let recList = n[i].lastSon - var destroyRecList = newNode(nkStmtList, n[i].info, @[]) - template addField(f: expr): stmt = - let stmt = destroyField(c, f, holder) - if stmt != nil: - destroyRecList.addSon(stmt) - inc nonTrivialFields - - case recList.kind - of nkSym: - addField(recList.sym) - of nkRecList: - for j in countup(0, recList.len - 1): - addField(recList[j].sym) - else: - internalAssert false - - caseBranch.addSon(destroyRecList) - result.addSon(caseBranch) - # maybe no fields were destroyed? - if nonTrivialFields == 0: - result = nil - -proc generateDestructor(c: PContext, t: PType): PNode = - ## generate a destructor for a user-defined object or tuple type - ## returns nil if the destructor turns out to be trivial - - template addLine(e: expr): stmt = - if result == nil: result = newNode(nkStmtList) - result.addSon(e) - - # XXX: This may be true for some C-imported types such as - # Tposix_spawnattr - if t.n == nil or t.n.sons == nil: return - internalAssert t.n.kind == nkRecList - let destructedObj = newIdentNode(destructorParam, UnknownLineInfo()) - # call the destructods of all fields - for s in countup(0, t.n.sons.len - 1): - case t.n.sons[s].kind - of nkRecCase: - let stmt = destroyCase(c, t.n.sons[s], destructedObj) - if stmt != nil: addLine(stmt) - of nkSym: - let stmt = destroyField(c, t.n.sons[s].sym, destructedObj) - if stmt != nil: addLine(stmt) - else: - internalAssert false - # base classes' destructors will be automatically called by - # semProcAux for both auto-generated and user-defined destructors - -proc instantiateDestructor(c: PContext, typ: PType): bool = - # returns true if the type already had a user-defined - # destructor or if the compiler generated a default - # member-wise one - var t = skipTypes(typ, {tyConst, tyMutable}) - - if t.destructor != nil: - # XXX: This is not entirely correct for recursive types, but we need - # it temporarily to hide the "destroy is already defined" problem - return t.destructor notin [AnalyzingDestructor, DestructorIsTrivial] - - case t.kind - of tySequence, tyArray, tyArrayConstr, tyOpenArray, tyVarargs: - if instantiateDestructor(c, t.sons[0]): - if rangeDestructorProc == nil: - rangeDestructorProc = searchInScopes(c, getIdent"nimDestroyRange") - t.destructor = rangeDestructorProc - return true - else: - return false - of tyTuple, tyObject: - t.destructor = AnalyzingDestructor - let generated = generateDestructor(c, t) - if generated != nil: - internalAssert t.sym != nil - var i = t.sym.info - let fullDef = newNode(nkProcDef, i, @[ - newIdentNode(destructorName, i), - emptyNode, - emptyNode, - newNode(nkFormalParams, i, @[ - emptyNode, - newNode(nkIdentDefs, i, @[ - newIdentNode(destructorParam, i), - useSym(t.sym), - emptyNode]), - ]), - newNode(nkPragma, i, @[destructorPragma]), - emptyNode, - generated - ]) - discard semProc(c, fullDef) - internalAssert t.destructor != nil - return true - else: - t.destructor = DestructorIsTrivial - return false - else: - return false - -proc insertDestructors(c: PContext, - varSection: PNode): tuple[outer, inner: PNode] = - # Accepts a var or let section. - # - # When a var section has variables with destructors - # the var section is split up and finally blocks are inserted - # immediately after all "destructable" vars - # - # In case there were no destrucable variables, the proc returns - # (nil, nil) and the enclosing stmt-list requires no modifications. - # - # Otherwise, after the try blocks are created, the rest of the enclosing - # stmt-list should be inserted in the most `inner` such block (corresponding - # to the last variable). - # - # `outer` is a statement list that should replace the original var section. - # It will include the new truncated var section followed by the outermost - # try block. - let totalVars = varSection.sonsLen - for j in countup(0, totalVars - 1): - let - varId = varSection[j][0] - varTyp = varId.sym.typ - info = varId.info - - if varTyp != nil and instantiateDestructor(c, varTyp) and - sfGlobal notin varId.sym.flags: - var tryStmt = newNodeI(nkTryStmt, info) - - if j < totalVars - 1: - var remainingVars = newNodeI(varSection.kind, info) - remainingVars.sons = varSection.sons[(j+1)..(-1)] - let (outer, inner) = insertDestructors(c, remainingVars) - if outer != nil: - tryStmt.addSon(outer) - result.inner = inner - else: - result.inner = newNodeI(nkStmtList, info) - result.inner.addSon(remainingVars) - tryStmt.addSon(result.inner) - else: - result.inner = newNodeI(nkStmtList, info) - tryStmt.addSon(result.inner) - - tryStmt.addSon( - newNode(nkFinally, info, @[ - semStmt(c, newNode(nkCall, info, @[ - useSym(varTyp.destructor), - useSym(varId.sym)]))])) - - result.outer = newNodeI(nkStmtList, info) - varSection.sons.setLen(j+1) - result.outer.addSon(varSection) - result.outer.addSon(tryStmt) - - return diff --git a/compiler/semexprs.nim b/compiler/semexprs.nim index ff68d6b8e..2885142a7 100644 --- a/compiler/semexprs.nim +++ b/compiler/semexprs.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2013 Andreas Rumpf # # See the file "copying.txt", included in this @@ -10,1145 +10,2120 @@ # this module does the semantic checking for expressions # included from sem.nim -proc semTemplateExpr(c: PContext, n: PNode, s: PSym, semCheck = true): PNode = - markUsed(n, s) - pushInfoContext(n.info) - result = evalTemplate(n, s, getCurrOwner()) - if semCheck: result = semAfterMacroCall(c, result, s) - popInfoContext() +when defined(nimCompilerStacktraceHints): + import std/stackframes + +const + errExprXHasNoType = "expression '$1' has no type (or is ambiguous)" + errXExpectsTypeOrValue = "'$1' expects a type or value" + errVarForOutParamNeededX = "for a 'var' type a variable needs to be passed; but '$1' is immutable" + errXStackEscape = "address of '$1' may not escape its stack frame" + errExprHasNoAddress = "expression has no address" + errCannotInterpretNodeX = "cannot evaluate '$1'" + errNamedExprExpected = "named expression expected" + errNamedExprNotAllowed = "named expression not allowed here" + errFieldInitTwice = "field initialized twice: '$1'" + errUndeclaredFieldX = "undeclared field: '$1'" + +proc semTemplateExpr(c: PContext, n: PNode, s: PSym, + 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 = 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) - if result.kind == nkEmpty: - # 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 == tyVar: result = newDeref(result) + if result.typ.kind in {tyVar, tyLent}: result = newDeref(result) + elif {efWantStmt, efAllowStmt} * flags != {}: + result.typ = newTypeS(tyVoid, c) else: - LocalError(n.info, errExprXHasNoType, + localError(c.config, n.info, errExprXHasNoType % renderTree(result, {renderNoComments})) result.typ = errorType(c) -proc semExprWithType(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = - result = semExpr(c, n, flags) - if 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 == EnforceVoidContext: - # we cannot check for 'void' in macros ... - LocalError(n.info, errExprXHasNoType, - renderTree(result, {renderNoComments})) + +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: - # XXX tyGenericInst here? - semProcvarCheck(c, result) - if result.typ.kind == tyVar: result = newDeref(result) - semDestructorCheck(c, result, flags) + 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(n.info, errExprXHasNoType, + localError(c.config, n.info, errExprXHasNoType % renderTree(result, {renderNoComments})) result.typ = errorType(c) - else: - semProcvarCheck(c, result) - semDestructorCheck(c, result, flags) proc semSymGenericInstantiation(c: PContext, n: PNode, s: PSym): PNode = result = symChoice(c, n, s, scClosed) - -proc inlineConst(n: PNode, s: PSym): PNode {.inline.} = - result = copyTree(s.ast) - result.typ = s.typ - result.info = n.info - -proc semSym(c: PContext, n: PNode, s: PSym, flags: TExprFlags): PNode = - case s.kind - of skConst: - markUsed(n, s) - case skipTypes(s.typ, abstractInst-{tyTypeDesc}).kind - of tyNil, tyChar, tyInt..tyInt64, tyFloat..tyFloat128, - tyTuple, tySet, tyUInt..tyUInt64: - result = inlineConst(n, s) - of tyArrayConstr, tySequence: - # Consider:: - # const x = [] - # proc p(a: openarray[int]) - # proc q(a: openarray[char]) - # p(x) - # q(x) - # - # 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(n, s) - else: result = newSymNode(s, n.info) - else: - result = newSymNode(s, n.info) - of skMacro: result = semMacroExpr(c, n, n, s) - of skTemplate: result = semTemplateExpr(c, n, s) - of skVar, skLet, skResult, skParam, skForVar: - markUsed(n, s) - # if a proc accesses a global variable, it is not side effect free: - if sfGlobal in s.flags: - incl(c.p.owner.flags, sfSideEffect) - elif s.kind == skParam and s.typ.kind == tyExpr and s.typ.n != nil: - # XXX see the hack in sigmatch.nim ... - return s.typ.n - 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? - of skGenericParam: - if s.ast != nil: result = semExpr(c, s.ast) - else: - InternalError(n.info, "no default for") - result = emptyNode - of skType: - markUsed(n, s) - result = newSymNode(s, n.info) - result.typ = makeTypeDesc(c, s.typ) + +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: - markUsed(n, s) - result = newSymNode(s, n.info) + 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.astdef) + if result.isNil: + localError(c.config, n.info, "constant of type '" & typeToString(s.typ) & "' has no value") + result = newSymNode(s) + else: + result.typ = s.typ + result.info = n.info type TConvStatus = enum convOK, convNotNeedeed, - convNotLegal + convNotLegal, + convNotInRange -proc checkConversionBetweenObjects(castDest, src: PType): TConvStatus = - return if inheritanceDiff(castDest, src) == high(int): +proc checkConversionBetweenObjects(castDest, src: PType; pointers: int): TConvStatus = + let diff = inheritanceDiff(castDest, src) + return if diff == high(int) or (pointers > 1 and diff != 0): convNotLegal else: convOK -const +const IntegralTypes = {tyBool, tyEnum, tyChar, tyInt..tyUInt64} -proc checkConvertible(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 = skipTypes(src, abstractVar-{tyTypeDesc}) - while (d != nil) and (d.Kind in {tyPtr, tyRef}) and (d.Kind == s.Kind): - d = base(d) - s = base(s) + var d = skipTypes(targetTyp, abstractVar) + var s = srcTyp + if s.kind in tyUserTypeClasses and s.isResolvedUserTypeClass: + 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, 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) - elif (skipTypes(castDest, abstractVarRange).Kind in IntegralTypes) and - (skipTypes(src, abstractVarRange-{tyTypeDesc}).Kind in IntegralTypes): - # accept conversion between integral types + 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: - case cmpTypes(d, s) + 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: - nil + discard -proc isCastable(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 + ## dst.size >= src.size, and typeAllowed(dst, skParam) #const - # castableTypeKinds = {tyInt, tyPtr, tyRef, tyCstring, tyString, + # castableTypeKinds = {tyInt, tyPtr, tyRef, tyCstring, tyString, # tySequence, tyPointer, tyNil, tyOpenArray, # tyProc, tySet, tyEnum, tyBool, tyChar} - var ds, ss: biggestInt - # this is very unrestrictive; cast is allowed if castDest.size >= src.size - ds = computeSize(dst) - ss = computeSize(src) - if ds < 0: - result = false - elif ss < 0: - result = false - else: - result = (ds >= ss) or + let src = src.skipTypes(tyUserTypeClasses) + if skipTypes(dst, abstractInst-{tyOpenArray}).kind == tyOpenArray: + 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: + return false + elif srcSize < 0: + return false + elif typeAllowed(dst, skParam, c, {taIsCastable}) != nil: + return false + elif dst.kind == tyProc and dst.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) - -proc isSymChoice(n: PNode): bool {.inline.} = - result = n.kind in nkSymChoices + if result and src.kind == tyNil: + return dst.size <= conf.target.ptrSize + +proc maybeLiftType(t: var PType, c: PContext, info: TLineInfo) = + # XXX: liftParamType started to perform addDecl + # we could do that instead in semTypeNode by snooping for added + # gnrc. params, then it won't be necessary to open a new scope here + openScope(c) + var lifted = liftParamType(c, skType, newNodeI(nkArgList, info), + t, ":anon", info) + closeScope(c) + if lifted != nil: t = lifted + +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, s: PSym): PNode = - if sonsLen(n) != 2: - LocalError(n.info, errConvNeedsOneArg) +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) - result.typ = semTypeNode(c, n.sons[0], nil).skipTypes({tyGenericInst}) - addSon(result, copyTree(n.sons[0])) - addSon(result, semExprWithType(c, n.sons[1])) - var op = result.sons[1] - + + 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} 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.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 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.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. + 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(result.typ, op.typ) + let status = checkConvertible(c, result.typ, op) case status - of convOK: nil + of convOK: + # handle SomeProcType(SomeGenericProc) + if op.kind == nkSym and op.sym.isGenericRoutine: + 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(n.info, hintConvFromXtoItselfNotNeeded, result.typ.typeToString) + if efNoSem2Check notin flags: + message(c.config, n.info, hintConvFromXtoItselfNotNeeded, result.typ.typeToString) of convNotLegal: - LocalError(n.info, errGenerated, MsgKindToString(errIllegalConvFromXtoY)% - [op.typ.typeToString, result.typ.typeToString]) + 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(result.typ, it.typ) - if status == convOK: - markUsed(n, it.sym) + for i in 0..<op.len: + let it = op[i] + let status = checkConvertible(c, result.typ, it) + if status in {convOK, convNotNeedeed}: + markUsed(c, n.info, it.sym) + onUse(n.info, it.sym) markIndirect(c, it.sym) return it - localError(n.info, errUseQualifier, op.sons[0].sym.name.s) - -proc semCast(c: PContext, n: PNode): PNode = - if optSafeCode in gGlobalOptions: localError(n.info, errCastNotInSafeMode) - #incl(c.p.owner.flags, sfSideEffect) - checkSonsLen(n, 2) + 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[0], nil) + let castedExpr = semExprWithType(c, n[1]) + if castedExpr.kind == nkClosedSymChoice: + errorUseQualifier(c, n[1].info, castedExpr) + if targetType == nil: + localError(c.config, n.info, "Invalid usage of cast, cast requires a type to convert to, e.g., cast[int](0d).") + if tfHasMeta in targetType.flags: + localError(c.config, n[0].info, "cannot cast to a non concrete type: '$1'" % $targetType) + if not isCastable(c, targetType, castedExpr.typ, n.info): + localError(c.config, n.info, "expression cannot be cast to '$1'" % $targetType) result = newNodeI(nkCast, n.info) - result.typ = semTypeNode(c, n.sons[0], nil) - addSon(result, copyTree(n.sons[0])) - addSon(result, semExprWithType(c, n.sons[1])) - if not isCastable(result.typ, result.sons[1].Typ): - LocalError(result.info, errExprCannotBeCastedToX, - typeToString(result.Typ)) - -proc semLowHigh(c: PContext, n: PNode, m: TMagic): PNode = - const - opToStr: array[mLow..mHigh, string] = ["low", "high"] - if sonsLen(n) != 2: - LocalError(n.info, errXExpectsTypeOrValue, opToStr[m]) - else: - n.sons[1] = semExprWithType(c, n.sons[1], {efDetermineType}) - var typ = skipTypes(n.sons[1].typ, abstractVarRange) - case typ.Kind - of tySequence, tyString, tyOpenArray, tyVarargs: - n.typ = getSysType(tyInt) - of tyArrayConstr, 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) - else: LocalError(n.info, errInvalidArgForX, opToStr[m]) - result = n + result.typ = targetType + result.add copyTree(n[0]) + result.add castedExpr -proc semSizeof(c: PContext, n: PNode): PNode = - if sonsLen(n) != 2: - LocalError(n.info, errXExpectsTypeOrValue, "sizeof") +proc semLowHigh(c: PContext, n: PNode, m: TMagic): PNode = + const + opToStr: array[mLow..mHigh, string] = ["low", "high"] + if n.len != 2: + localError(c.config, n.info, errXExpectsTypeOrValue % opToStr[m]) else: - n.sons[1] = semExprWithType(c, n.sons[1], {efDetermineType}) - #restoreOldStyleType(n.sons[1]) - n.typ = getSysType(tyInt) - result = n - -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 x.kind == tyTypeDesc or y.kind != tyTypeDesc: - LocalError(n.info, errXExpectsObjectTypes, "of") - elif b.kind != tyObject or a.kind != tyObject: - LocalError(n.info, errXExpectsObjectTypes, "of") + 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: + n.typ = getSysType(c.graph, n.info, tyInt) + of tyArray: + 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 + # that could easily turn into an infinite recursion in semtypinst + n.typ = makeTypeFromExpr(c, n.copyTree) else: - let diff = inheritanceDiff(a, b) - # | returns: 0 iff `a` == `b` - # | returns: -x iff `a` is the x'th direct superclass of `b` - # | returns: +x iff `a` is the x'th direct subclass of `b` - # | returns: `maxint` iff `a` and `b` are not compatible at all - if diff <= 0: - # optimize to true: - Message(n.info, hintConditionAlwaysTrue, renderTree(n)) - result = newIntNode(nkIntLit, 1) - result.info = n.info - result.typ = getSysType(tyBool) - return result - elif diff == high(int): - LocalError(n.info, errXcanNeverBeOfThisSubtype, typeToString(a)) - else: - LocalError(n.info, errXExpectsTwoArguments, "of") - n.typ = getSysType(tyBool) + localError(c.config, n.info, "invalid argument for: " & opToStr[m]) result = n -proc semIs(c: PContext, n: PNode): PNode = - if sonsLen(n) != 3: - LocalError(n.info, errXExpectsTwoArguments, "is") +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.len == 3 and + n[1].typ != nil and + n[2].kind in {nkStrLit..nkTripleStrLit, nkType} + 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) + 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: + res = false + else: + 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 + 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 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(tyBool) - - n.sons[1] = semExprWithType(c, n[1], {efDetermineType}) - if n[1].typ.kind != tyTypeDesc: - LocalError(n[0].info, errTypeExpected) + n.typ = boolType + var liftLhs = true + 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]) - if n[1].typ.sonsLen == 0: - # this is a typedesc variable, leave for evals - return + var lhsType = n[1].typ + if lhsType.kind != tyTypeDesc: + if liftLhs: + n[1] = makeTypeSymNode(c, lhsType, n[1].info) + lhsType = n[1].typ else: - let t1 = n[1].typ.sons[0] - # BUGFIX: don't evaluate this too early: ``T is void`` - if not containsGenericType(t1): result = evalIsOp(n) - + if c.inGenericContext > 0 and lhsType.base.containsUnresolvedType: + # BUGFIX: don't evaluate this too early: ``T is void`` + return + + result = isOpImpl(c, n, flags) + proc semOpAux(c: PContext, n: PNode) = - const flags = {efDetermineType} - for i in countup(1, n.sonsLen-1): - var a = n.sons[i] - if a.kind == nkExprEqExpr and sonsLen(a) == 2: - var info = a.sons[0].info - a.sons[0] = newIdentNode(considerAcc(a.sons[0]), 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 = +proc overloadedCallOpr(c: PContext, n: PNode): PNode = # quick check if there is *any* () operator overloaded: - var par = getIdent("()") - if searchInScopes(c, par) == nil: + var par = getIdent(c.cache, "()") + 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(n: PNode, newType: PType, check: bool) = +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(n.sons[i], elemType(newType), check) - of nkPar: - if newType.kind != tyTuple: - InternalError(n.info, "changeType: no tuple type for constructor") - elif newType.n == nil: nil - elif sonsLen(n) > 0 and n.sons[0].kind == nkExprColonExpr: - for i in countup(0, sonsLen(n) - 1): - var m = n.sons[i].sons[0] - if m.kind != nkSym: - internalError(m.info, "changeType(): invalid tuple constr") - return - var f = getSymFromList(newType.n, m.sym.name) - if f == nil: - internalError(m.info, "changeType(): invalid identifier") + 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, tyDistinct}) + if tup.kind != tyTuple: + if tup.kind == tyObject: return + globalError(c.config, n.info, "no tuple type for constructor") + elif n.len > 0 and n[0].kind == nkExprColonExpr: + # named tuple? + for i in 0..<n.len: + var m = n[i][0] + if m.kind != nkSym: + globalError(c.config, m.info, "invalid tuple constructor") return - changeType(n.sons[i].sons[1], f.typ, check) + if tup.n != nil: + var f = getSymFromList(tup.n, m.sym.name) + if f == nil: + globalError(c.config, m.info, "unknown identifier: " & m.sym.name.s) + return + changeType(c, n[i][1], f.typ, check) + else: + changeType(c, n[i][1], tup[i], check) else: - for i in countup(0, sonsLen(n) - 1): - 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, newType.sons[i], check) - n.sons[i] = a + for i in 0..<n.len: + changeType(c, n[i], tup[i], check) + when false: + 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: + if check and n.kind != nkUInt64Lit and not sameTypeOrNil(n.typ, newType): let value = n.intVal - if value < firstOrd(newType) or value > lastOrd(newType): - LocalError(n.info, errGenerated, "cannot convert " & $value & - " to " & typeToString(newType)) - else: nil + if value < firstOrd(c.config, newType) or value > lastOrd(c.config, newType): + localError(c.config, n.info, "cannot convert " & $value & + " 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(tyArrayConstr, c) +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 x = n.sons[0] - var lastIndex: biggestInt = sonsLen(n) - 1 - var t = skipTypes(n.sons[0].typ, {tyGenericInst, tyVar, tyOrdinal}) - 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(tyArrayConstr, 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: - var x = n.sons[0] - var lastIndex: biggestInt = 0 - var indexType = getSysType(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, 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]) - idx = fitNode(c, indexType, idx) + 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[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(x.info, errInvalidOrderInArrayConstructor) - x = x.sons[1] - - let xx = semExprWithType(c, x, flags*{efAllowDestructor}) + localError(c.config, x.info, "invalid order in array constructor") + x = x[1] + + 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.typ.sons[0] = makeRangeType(c, 0, sonsLen(result) - 1, n.info) - -proc fixAbstractType(c: PContext, n: PNode) = - # XXX finally rewrite that crap! - for i in countup(1, sonsLen(n) - 1): - var it = n.sons[i] - case it.kind - of nkHiddenStdConv, nkHiddenSubConv: - if it.sons[1].kind == nkBracket: - it.sons[1].typ = arrayConstrType(c, it.sons[1]) - #it.sons[1] = semArrayConstr(c, it.sons[1]) - if skipTypes(it.typ, abstractVar).kind in {tyOpenArray, tyVarargs}: - #if n.sons[0].kind == nkSym and IdentEq(n.sons[0].sym.name, "[]="): - # debug(n) - - var s = skipTypes(it.sons[1].typ, abstractVar) - if s.kind == tyArrayConstr and s.sons[1].kind == tyEmpty: - s = copyType(s, getCurrOwner(), false) - skipTypes(s, abstractVar).sons[1] = elemType( - skipTypes(it.typ, abstractVar)) - it.sons[1].typ = s - elif s.kind == tySequence and s.sons[0].kind == tyEmpty: - s = copyType(s, getCurrOwner(), false) - skipTypes(s, abstractVar).sons[0] = elemType( - skipTypes(it.typ, abstractVar)) - it.sons[1].typ = s - - elif skipTypes(it.sons[1].typ, abstractVar).kind in - {tyNil, tyArrayConstr, tyTuple, tySet}: - var s = skipTypes(it.typ, abstractVar) - changeType(it.sons[1], s, check=true) - n.sons[i] = it.sons[1] - of nkBracket: - # an implicitely constructed array (passed to an open array): - n.sons[i] = semArrayConstr(c, it, {}) - else: - nil - #if (it.typ == nil): - # InternalError(it.info, "fixAbstractType: " & renderTree(it)) - -proc skipObjConv(n: PNode): PNode = - case n.kind - of nkHiddenStdConv, nkHiddenSubConv, nkConv: - if skipTypes(n.sons[1].typ, abstractPtrs).kind in {tyTuple, tyObject}: - result = n.sons[1] - else: - result = n - of nkObjUpConv, nkObjDownConv: result = n.sons[0] - else: result = n - -proc isAssignable(c: PContext, n: PNode): TAssignableResult = + 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[i] + if it == nil: + localError(c.config, n.info, "'$1' has nil child at index $2" % [renderTree(n, {renderNoComments}), $i]) + return + # do not get rid of nkHiddenSubConv for OpenArrays, the codegen needs it: + if it.kind == nkHiddenSubConv and + skipTypes(it.typ, abstractVar).kind notin {tyOpenArray, tyVarargs}: + if skipTypes(it[1].typ, abstractVar).kind in + {tyNil, tyTuple, tySet} or it[1].isArrayConstr: + var s = skipTypes(it.typ, abstractVar + 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 newHiddenAddrTaken(c: PContext, n: PNode): PNode = - if n.kind == nkHiddenDeref: - checkSonsLen(n, 1) - result = n.sons[0] - else: +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, 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[0] + else: result = newNodeIT(nkHiddenAddr, n.info, makeVarType(c, n.typ)) - addSon(result, n) - if isAssignable(c, n) notin {arLValue, arLocalLValue}: - localError(n.info, errVarForOutParamNeeded) + 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: # n.sym.typ can be nil in 'check' mode ... if n.sym.typ != nil and - skipTypes(n.sym.typ, abstractInst-{tyTypeDesc}).kind != tyVar: + skipTypes(n.sym.typ, abstractInst-{tyTypeDesc}).kind notin {tyVar, tyLent}: incl(n.sym.flags, sfAddrTaken) - result = newHiddenAddrTaken(c, n) - of nkDotExpr: - checkSonsLen(n, 2) - if n.sons[1].kind != nkSym: - internalError(n.info, "analyseIfAddressTaken") + result = newHiddenAddrTaken(c, n, isOutParam) + of nkDotExpr: + checkSonsLen(n, 2, c.config) + if n[1].kind != nkSym: + internalError(c.config, n.info, "analyseIfAddressTaken") return - if skipTypes(n.sons[1].sym.typ, abstractInst-{tyTypeDesc}).kind != tyVar: - incl(n.sons[1].sym.flags, sfAddrTaken) - result = newHiddenAddrTaken(c, n) - of nkBracketExpr: - checkMinSonsLen(n, 1) - if skipTypes(n.sons[0].typ, abstractInst-{tyTypeDesc}).kind != tyVar: - if n.sons[0].kind == nkSym: incl(n.sons[0].sym.flags, sfAddrTaken) - result = newHiddenAddrTaken(c, n) - else: - result = newHiddenAddrTaken(c, n) - -proc analyseIfAddressTakenInCall(c: PContext, n: PNode) = - checkMinSonsLen(n, 1) - const - FakeVarParams = {mNew, mNewFinalize, mInc, ast.mDec, mIncl, mExcl, - mSetLengthStr, mSetLengthSeq, mAppendStrCh, mAppendStrStr, mSwap, - mAppendSeqElem, mNewSeq, mReset, mShallowCopy} - + 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[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, isOutParam) + +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, 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}) - - 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: - if isAssignable(c, n.sons[i]) notin {arLValue, arLocalLValue}: - if n.sons[i].kind != nkHiddenAddr: - LocalError(n.sons[i].info, errVarForOutParamNeeded) + 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] + let aa = isAssignable(c, it) + if aa notin {arLValue, arLocalLValue}: + if it.kind != nkHiddenAddr: + 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 + if arg.kind == nkHiddenDeref: arg = arg[0] + if arg.kind == nkSym and arg.sym.kind == skResult and + arg.typ.skipTypes(abstractInst).kind in {tyVar, tyLent}: + localError(c.config, n.info, errXStackEscape % renderTree(n[1], {renderNoComments})) + 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]) - semProcvarCheck(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 + # 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]) + 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) + result = semfold.getConstExpr(c.module, call, c.idgen, c.graph) if result.isNil: result = n else: return result - result.typ = semfold.getIntervalType(callee.magic, call) - + + block maybeLabelAsStatic: + # XXX: temporary work-around needed for tlateboundstatic. + # This is certainly not correct, but it will get the job + # done until we have a more robust infrastructure for + # implicit statics. + if n.len > 1: + 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 = 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 - {sfForward, sfImportc} * callee.flags == {}: - if sfCompileTime notin callee.flags and - optImplicitStatic notin gOptions: return + if callee.kind == skConst or + {sfNoSideEffect, sfCompileTime} * callee.flags != {} and + {sfForward, sfImportc} * callee.flags == {} and n.typ != nil: + + 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, skConverter} or callee.isGenericRoutine: + + if callee.kind notin {skProc, skFunc, skConverter, skConst} or + callee.isGenericRoutineStrict: return - - if n.typ != nil and not typeAllowed(n.typ, skConst): 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]) + 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, call, c.p.owner) - if result.isNil: - LocalError(n.info, errCannotInterpretNodeX, renderTree(call)) + 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, call) - if result.isNil: 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]) - result = evalStaticExpr(c.module, a, c.p.owner) +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.idgen, c.graph, a, c.p.owner) if result.isNil: - LocalError(n.info, errCannotInterpretNodeX, renderTree(n)) - result = emptyNode + localError(c.config, n.info, errCannotInterpretNodeX % renderTree(n)) + result = c.graph.emptyNode + else: + 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``. + # to 'skIterator' anymore; skIterator is preferred in sigmatch already + # for typeof support. + # for ``typeof(countup(1,3))``, see ``tests/ttoseq``. result = semOverloadedCall(c, n, nOrig, - {skProc, skMethod, skConverter, skMacro, skTemplate, skIterator}) + {skProc, skFunc, skMethod, skConverter, skMacro, skTemplate, skIterator}, flags, expectedType) else: - result = semOverloadedCall(c, n, nOrig, - {skProc, skMethod, skConverter, skMacro, skTemplate}) + result = semOverloadedCall(c, n, nOrig, + {skProc, skFunc, skMethod, skConverter, skMacro, skTemplate}, flags, expectedType) + if result != nil: - if result.sons[0].kind != nkSym: - InternalError("semDirectCallAnalyseEffects") + 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: nil + of skMacro, skTemplate: discard else: - if (callee.kind == skIterator) and (callee.id == c.p.owner.id): - LocalError(n.info, errRecursiveDependencyX, callee.name.s) - if sfNoSideEffect notin callee.flags: - if {sfImportc, sfSideEffect} * callee.flags != {}: - incl(c.p.owner.flags, sfSideEffect) - -proc semDirectCallAnalyseEffects(c: PContext, n: PNode, nOrig: PNode, - flags: TExprFlags): PNode = - result = semOverloadedCallAnalyseEffects(c, n, nOrig, flags) - -proc semObjConstr(c: PContext, n: PNode, flags: TExprFlags): PNode -proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode = + if callee.kind == skIterator and callee.id == c.p.owner.id and + not isClosureIterator(c.p.owner.typ): + localError(c.config, n.info, errRecursiveDependencyIteratorX % callee.name.s) + # error correction, prevents endless for loop elimination in transf. + # See bug #2051: + result[0] = newSymNode(errorSym(c, n)) + 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 = + result = initCandidate(c, t) + matches(c, n, nOrig, result) + +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 + + result = n + + when defined(nimsuggest): + if c.config.expandProgress: + if c.config.expandLevels == 0: + return n + else: + c.config.expandLevels -= 1 + + let callee = result[0].sym + case callee.kind + of skMacro: result = semMacroExpr(c, result, orig, callee, flags, expectedType) + of skTemplate: result = semTemplateExpr(c, result, callee, flags, expectedType) + else: + 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, 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 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; expectedType: PType = nil): PNode = result = nil - checkMinSonsLen(n, 1) - var prc = n.sons[0] - if n.sons[0].kind == nkDotExpr: - checkSonsLen(n.sons[0], 2) - n.sons[0] = semFieldAccess(c, n.sons[0]) - if n.sons[0].kind == nkDotCall: + checkMinSonsLen(n, 1, c.config) + var prc = n[0] + if n[0].kind == nkDotExpr: + checkSonsLen(n[0], 2, c.config) + let n0 = semFieldAccess(c, n[0], {efIsDotCall}) + if n0.kind == nkDotCall: # it is a static call! - result = n.sons[0] - result.kind = nkCall - for i in countup(1, sonsLen(n) - 1): addSon(result, n.sons[i]) - return semExpr(c, result, flags) - else: - n.sons[0] = semExpr(c, n.sons[0]) + result = n0 + result.transitionSonsKind(nkCall) + result.flags.incl nfExplicitCall + 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[0] = n0 + else: + n[0] = semExpr(c, n[0], {efInCall, efAllowSymChoice}) + let t = n[0].typ + if t != nil and t.kind in {tyVar, tyLent}: + n[0] = newDeref(n[0]) + elif 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 - var m: TCandidate - initCandidate(m, t) - matches(c, n, nOrig, m) + let m = resolveIndirectCall(c, n, nOrig, t) if m.state != csMatch: - if c.inCompilesContext > 0: + if c.config.m.errorOutputs == {}: # speed up error generation: - GlobalError(n.Info, errTypeMismatch, "") - return emptyNode + globalError(c.config, n.info, "type mismatch") + return c.graph.emptyNode else: var hasErrorType = false - var msg = msgKindToString(errTypeMismatch) - for i in countup(1, sonsLen(n) - 1): - if i > 1: add(msg, ", ") - let nt = n.sons[i].typ - add(msg, typeToString(nt)) - if nt.kind == tyError: + var msg = "type mismatch: got <" + 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, ")\n" & msgKindToString(errButExpected) & "\n" & - typeToString(n.sons[0].typ)) - LocalError(n.Info, errGenerated, msg) + 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) - # we assume that a procedure that calls something indirectly - # has side-effects: - if tfNoSideEffect notin t.flags: incl(c.p.owner.flags, sfSideEffect) - elif t != nil and t.kind == tyTypeDesc: - if n.len == 1: return semObjConstr(c, n, flags) - let destType = t.skipTypes({tyTypeDesc, tyGenericInst}) - result = semConv(c, n, symFromType(destType, n.info)) - return + 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: - n.sons[0] = prc - nOrig.sons[0] = prc + if result == nil or result.kind == nkEmpty: + # XXX: hmm, what kind of symbols will end up here? + # do we really need to try the overload resolution? + n[0] = prc + nOrig[0] = prc + n.flags.incl nfExprCall result = semOverloadedCallAnalyseEffects(c, n, nOrig, flags) - if result == nil: - if c.inCompilesContext > 0 or gErrorCounter == 0: - LocalError(n.info, errExprXCannotBeCalled, - renderTree(n, {renderNoComments})) - return errorNode(c, n) - fixAbstractType(c, result) - analyseIfAddressTakenInCall(c, result) - if result.sons[0].kind == nkSym and result.sons[0].sym.magic != mNone: - result = magicsAfterOverloadResolution(c, result, flags) - result = evalAtCompileTime(c, result) - -proc semDirectOp(c: PContext, n: PNode, flags: TExprFlags): 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 = overloadedCallOpr(c, n) - if result == nil: - NotFoundError(c, n) - return errorNode(c, n) - let callee = result.sons[0].sym - case callee.kind - of skMacro: result = semMacroExpr(c, result, nOrig, callee) - of skTemplate: result = semTemplateExpr(c, result, callee) + if result == nil: return errorNode(c, n) + elif result.kind notin nkCallKinds: + # the semExpr() in overloadedCallOpr can even break this condition! + # See bug #904 of how to trigger it: + return result + #result = afterCallActions(c, result, nOrig, flags) + if result[0].kind == nkSym: + result = afterCallActions(c, result, nOrig, flags, expectedType) else: - semFinishOperands(c, n) - activate(c, n) fixAbstractType(c, result) analyseIfAddressTakenInCall(c, result) - if callee.magic != mNone: - result = magicsAfterOverloadResolution(c, result, flags) - result = evalAtCompileTime(c, result) -proc buildStringify(c: PContext, arg: PNode): PNode = - if arg.typ != nil and - skipTypes(arg.typ, abstractInst-{tyTypeDesc}).kind == tyString: - result = arg - else: - result = newNodeI(nkCall, arg.info) - addSon(result, newIdentNode(getIdent"$", arg.info)) - addSon(result, arg) - -proc semEcho(c: PContext, n: PNode): PNode = - # this really is a macro - checkMinSonsLen(n, 1) - for i in countup(1, sonsLen(n) - 1): - var arg = semExprWithType(c, n.sons[i]) - n.sons[i] = semExpr(c, buildStringify(c, arg)) - - let t = n.sons[0].typ - if tfNoSideEffect notin t.flags: incl(c.p.owner.flags, sfSideEffect) - result = n - -proc buildEchoStmt(c: PContext, n: PNode): PNode = - # we MUST not check 'n' for semantics again here! +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, 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(magicsys.systemModule.Tab, getIdent"echo") + let e = systemModuleSym(c.graph, getIdent(c.cache, "echo")) if e != nil: - addSon(result, newSymNode(e)) + result.add(newSymNode(e)) else: - LocalError(n.info, errSystemNeeds, "echo") - addSon(result, errorNode(c, n)) - var arg = buildStringify(c, n) - # problem is: implicit '$' is not checked for semantics yet. So we give up - # and check 'arg' for semantics again: - addSon(result, semExpr(c, arg)) + 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}) - discardCheck(result) - -proc isTypeExpr(n: PNode): bool = + discardCheck(c, result, {}) + if isPush: popInfoContext(c.config) + +proc isTypeExpr(n: PNode): bool = case n.kind of nkType, nkTypeOfExpr: result = true of nkSym: result = n.sym.kind == skType else: result = false - -proc lookupInRecordAndBuildCheck(c: PContext, n, r: PNode, field: PIdent, - check: var PNode): PSym = + +proc createSetType(c: PContext; baseType: PType): PType = + assert baseType != nil + result = newTypeS(tySet, c) + rawAddSon(result, baseType) + +proc lookupInRecordAndBuildCheck(c: PContext, n, r: PNode, field: PIdent, + check: var PNode): PSym = # transform in a node that contains the runtime check for the # field, if it is in a case-part... result = nil case r.kind - of nkRecList: - for i in countup(0, sonsLen(r) - 1): - result = lookupInRecordAndBuildCheck(c, n, r.sons[i], field, check) - if result != nil: return - of nkRecCase: - checkMinSonsLen(r, 2) - if (r.sons[0].kind != nkSym): IllFormedAst(r) - result = lookupInRecordAndBuildCheck(c, n, r.sons[0], field, check) - if result != nil: return - var s = newNodeI(nkCurly, r.info) - for i in countup(1, sonsLen(r) - 1): - var it = r.sons[i] + of nkRecList: + 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[0].kind != nkSym): illFormedAst(r, c.config) + result = lookupInRecordAndBuildCheck(c, n, r[0], field, check) + if result != nil: return + let setType = createSetType(c, r[0].typ) + var s = newNodeIT(nkCurly, r.info, setType) + for i in 1..<r.len: + var it = r[i] case it.kind - of nkOfBranch: + 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])) - else: - if check == nil: + if result == nil: + for j in 0..<it.len-1: s.add copyTree(it[j]) + else: + if check == nil: check = newNodeI(nkCheckedFieldExpr, n.info) - addSon(check, ast.emptyNode) # make space for access node - s = newNodeI(nkCurly, n.info) - for j in countup(0, sonsLen(it) - 2): addSon(s, copyTree(it.sons[j])) - var inExpr = newNodeI(nkCall, n.info) - addSon(inExpr, newIdentNode(getIdent("in"), n.info)) - addSon(inExpr, copyTree(r.sons[0])) - addSon(inExpr, s) #writeln(output, renderTree(inExpr)); - addSon(check, semExpr(c, inExpr)) - return - of nkElse: + check.add c.graph.emptyNode # make space for access node + s = newNodeIT(nkCurly, n.info, setType) + for j in 0..<it.len - 1: s.add copyTree(it[j]) + var inExpr = newNodeIT(nkCall, n.info, getSysType(c.graph, n.info, tyBool)) + 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: + if result != nil: + if check == nil: check = newNodeI(nkCheckedFieldExpr, n.info) - addSon(check, ast.emptyNode) # make space for access node - var inExpr = newNodeI(nkCall, n.info) - addSon(inExpr, newIdentNode(getIdent("in"), n.info)) - addSon(inExpr, copyTree(r.sons[0])) - addSon(inExpr, s) - var notExpr = newNodeI(nkCall, n.info) - addSon(notExpr, newIdentNode(getIdent("not"), n.info)) - addSon(notExpr, inExpr) - addSon(check, semExpr(c, notExpr)) - return - else: illFormedAst(it) - of nkSym: + check.add c.graph.emptyNode # make space for access node + var inExpr = newNodeIT(nkCall, n.info, getSysType(c.graph, n.info, tyBool)) + 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)) + 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: if r.sym.name.id == field.id: result = r.sym - else: illFormedAst(n) - -proc makeDeref(n: PNode): PNode = - var t = skipTypes(n.typ, {tyGenericInst}) - result = n - if t.kind == tyVar: - result = newNodeIT(nkHiddenDeref, n.info, t.sons[0]) - addSon(result, n) - t = skipTypes(t.sons[0], {tyGenericInst}) - while t.kind in {tyPtr, tyRef}: - var a = result - result = newNodeIT(nkHiddenDeref, n.info, t.sons[0]) - addSon(result, a) - t = skipTypes(t.sons[0], {tyGenericInst}) - -proc builtinFieldAccess(c: PContext, n: PNode, flags: TExprFlags): PNode = - ## returns nil if it's not a built-in field access - checkSonsLen(n, 2) - # early exit for this; see tests/compile/tbindoverload.nim: - if isSymChoice(n.sons[1]): return + else: illFormedAst(n, c.config) + +const + tyTypeParamsHolders = {tyGenericInst, tyCompositeTypeClass} + tyDotOpTransparent = {tyVar, tyLent, tyPtr, tyRef, tyOwned, tyAlias, tySink} + +proc readTypeParameter(c: PContext, typ: PType, + paramName: PIdent, info: TLineInfo): PNode = + # Note: This function will return emptyNode when attempting to read + # a static type parameter that is not yet resolved (e.g. this may + # happen in proc signatures such as `proc(x: T): array[T.sizeParam, U]` + if typ.kind in {tyUserTypeClass, tyUserTypeClassInst}: + for statement in typ.n: + case statement.kind + of nkTypeSection: + for def in statement: + if def[0].sym.name.id == paramName.id: + # XXX: Instead of lifting the section type to a typedesc + # here, we could try doing it earlier in semTypeSection. + # 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, c.idgen).linkTo(foundType), info) + + of nkConstSection: + for def in statement: + if def[0].sym.name.id == paramName.id: + return def[2] + + else: + discard + + if typ.kind != tyUserTypeClass: + let ty = if typ.kind == tyCompositeTypeClass: typ.firstGenericParam.skipGenericAlias + else: typ.skipGenericAlias + 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[s + 1] + if rawTyp.kind == tyStatic: + if rawTyp.n != nil: + return rawTyp.n + else: + return c.graph.emptyNode + else: + let foundTyp = makeTypeDesc(c, rawTyp) + 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: + 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) + of tyArray, tySequence: + # Consider:: + # const x = [] + # proc p(a: openarray[int]) + # proc q(a: openarray[char]) + # p(x) + # q(x) + # + # 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.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, 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: + case s.kind + of skMacro: result = semMacroExpr(c, n, n, s, flags) + of skTemplate: result = semTemplateExpr(c, n, s, flags) + else: discard # unreachable + of skParam: + markUsed(c, n.info, s) + onUse(n.info, s) + 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: + # 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") - var s = qualifiedLookup(c, n, {checkAmbiguity, checkUndeclared}) + if n.kind != nkDotExpr: # dotExpr is already checked by builtinFieldAccess + markUsed(c, n.info, s) + onUse(n.info, s) + result = newSymNode(s, n.info) + # We cannot check for access to outer vars for example because it's still + # not sure the symbol really ends up being used: + # var len = 0 # but won't be called + # genericThatUsesLen(x) # marked as taking a closure? + if hasWarn(c.config, warnResultUsed): + message(c.config, n.info, warnResultUsed) + + of skGenericParam: + onUse(n.info, s) + if s.typ.kind == tyStatic: + result = newSymNode(s, n.info) + result.typ = s.typ + elif s.ast != nil: + result = semExpr(c, s.ast) + else: + n.typ = s.typ + return n + of skType: + 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: + # old code, not sure if it's live code: + markUsed(c, n.info, s) + onUse(n.info, s) + result = newSymNode(s, n.info) + of skModule: + # make sure type is None and not nil for discard checking + if efWantStmt in flags: s.typ = newTypeS(tyNone, c) + markUsed(c, n.info, s) + onUse(n.info, s) + result = newSymNode(s, n.info) + else: + let info = getCallLineInfo(n) + #if efInCall notin flags: + markUsed(c, info, s) + onUse(info, s) + result = newSymNode(s, info) + +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[1]): return + when defined(nimsuggest): + if c.config.cmd == cmdIdeTools: + suggestExpr(c, n) + if exactEquals(c.config.m.trackPos, n[1].info): suggestExprNoCheck(c, n) + + var s = qualifiedLookUp(c, n, {checkAmbiguity, checkUndeclared, checkModule}) if s != nil: - return semSym(c, n, s, flags) + if s.kind in OverloadableSyms: + result = symChoice(c, n, s, scClosed) + if result.kind == nkSym: result = semSym(c, n, s, flags) + else: + markUsed(c, n[1].info, s) + result = semSym(c, n, s, flags) + onUse(n[1].info, s) + return - n.sons[0] = semExprWithType(c, n.sons[0], flags+{efDetermineType}) - #restoreOldStyleType(n.sons[0]) - var i = considerAcc(n.sons[1]) - 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 - if isTypeExpr(n.sons[0]) or ty.kind == tyTypeDesc and ty.len == 1: - if ty.kind == tyTypeDesc: ty = ty.sons[0] - 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(n, f) - return - of tyGenericInst: - assert ty.sons[0].kind == tyGenericBody - let tbody = ty.sons[0] - for s in countup(0, tbody.len-2): - let tParam = tbody.sons[s] - assert tParam.kind == tyGenericParam - if tParam.sym.name == i: - let foundTyp = makeTypeDesc(c, ty.sons[s + 1]) - return newSymNode(copySym(tParam.sym).linkTo(foundTyp), n.info) - return + + if ty.kind == tyTypeDesc: + if ty.base.kind == tyNone: + # This is a still unresolved typedesc parameter. + # If this is a regular proc, then all bets are off and we must return + # tyFromExpr, but when this happen in a macro this is not a built-in + # field access and we leave the compiler to compile a normal call: + if getCurrOwner(c).kind != skMacro: + n.typ = makeTypeFromExpr(c, n.copyTree) + flags.incl efCannotBeDotCall + return n + else: + return nil else: - # echo "TYPE FIELD ACCESS" - # debug 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 - - ty = skipTypes(ty, {tyGenericInst, tyVar, tyPtr, tyRef}) + 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.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: + 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], {tyGenericInst}) + if f != nil: break + 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? - 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 - markUsed(n, f) - if check == nil: + if check == nil: result = n - else: - check.sons[0] = n + else: + check[0] = n check.typ = n.typ result = check - elif ty.kind == tyTuple and ty.n != nil: + elif ty.kind == tyTuple and ty.n != nil: f = getSymFromList(ty.n, i) if f != nil: - 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 - markUsed(n, f) -proc semFieldAccess(c: PContext, n: PNode, flags: TExprFlags): PNode = - # this is difficult, because the '.' is used in many different contexts - # in Nimrod. We first allow types in the semantic checking. - result = builtinFieldAccess(c, n, flags) + # we didn't find any field, let's look for a generic param if result == nil: - if isSymChoice(n.sons[1]): - result = newNodeI(nkDotCall, n.info) - addSon(result, n.sons[1]) - addSon(result, copyTree(n[0])) - else: - var i = considerAcc(n.sons[1]) - var f = searchInScopes(c, i) - # if f != nil and f.kind == skStub: loadStub(f) - # ``loadStub`` is not correct here as we don't care for ``f`` really - if f != nil: - # BUGFIX: do not check for (f.kind in {skProc, skMethod, skIterator}) here - # This special node kind is to merge with the call handler in `semExpr`. - result = newNodeI(nkDotCall, n.info) - addSon(result, newIdentNode(i, n[1].info)) - addSon(result, copyTree(n[0])) - else: - if not ContainsOrIncl(c.UnknownIdents, i.id): - LocalError(n.Info, errUndeclaredFieldX, i.s) - result = errorNode(c, n) + let t = n[0].typ.skipTypes(tyDotOpTransparent) + result = tryReadingGenericParam(c, n, i, t) + flags.incl efCannotBeDotCall + +proc dotTransformation(c: PContext, n: PNode): PNode = + if isSymChoice(n[1]) or + # generics usually leave field names as symchoices, but not types + (n[1].kind == nkSym and n[1].sym.kind == skType): + result = newNodeI(nkDotCall, n.info) + result.add n[1] + result.add copyTree(n[0]) + else: + var i = considerQuotedIdent(c, n[1], n) + result = newNodeI(nkDotCall, n.info) + result.flags.incl nfDotField + 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. + 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]) - -proc semDeref(c: PContext, n: PNode): PNode = - checkSonsLen(n, 1) - n.sons[0] = semExprWithType(c, n.sons[0]) + for s in n: result.add s + +proc semDeref(c: PContext, n: PNode, flags: TExprFlags): PNode = + checkSonsLen(n, 1, c.config) + n[0] = semExprWithType(c, n[0]) + let a = getConstExpr(c.module, n[0], c.idgen, c.graph) + if a != nil: + if a.kind == nkNilLit 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}) + var t = skipTypes(n[0].typ, {tyGenericInst, tyVar, tyLent, tyAlias, tySink, tyOwned}) case t.kind - of tyRef, tyPtr: n.typ = t.sons[0] + 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: - var 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) - n.sons[0] = semExprWithType(c, n.sons[0]) - var arr = skipTypes(n.sons[0].typ, {tyGenericInst, tyVar, tyPtr, tyRef}) + checkMinSonsLen(n, 2, c.config) + # 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, tyArrayConstr, tySequence, tyString, - tyCString: - checkSonsLen(n, 2) - n.sons[0] = makeDeref(n.sons[0]) - for i in countup(1, sonsLen(n) - 1): - n.sons[i] = semExprWithType(c, n.sons[i], + of tyArray, tyOpenArray, tyVarargs, tySequence, tyString, tyCstring, + tyUncheckedArray: + if n.len != 2: return nil + 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(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 + # The result so far is a tyTypeDesc bound # a tyGenericBody. The line below will substitute # it with the instantiated type. - result = symNodeFromType(c, semTypeNode(c, n, nil), n.info) - of tyTuple: - checkSonsLen(n, 2) - n.sons[0] = makeDeref(n.sons[0]) - # [] operator for tuples requires constant expression: - n.sons[1] = semConstExpr(c, n.sons[1]) - if skipTypes(n.sons[1].typ, {tyGenericInst, tyRange, tyOrdinal}).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(n.info, errInvalidIndexValueForTuple) - else: - LocalError(n.info, errIndexTypesDoNotMatch) result = n - else: nil - -proc semArrayAccess(c: PContext, n: PNode, flags: TExprFlags): PNode = + result.typ = makeTypeDesc(c, semTypeNode(c, n, nil)) + #result = symNodeFromType(c, semTypeNode(c, n, nil), n.info) + of tyTuple: + if n.len != 2: return nil + n[0] = makeDeref(n[0]) + # [] operator for tuples requires constant expression: + n[1] = semConstExpr(c, n[1]) + if skipTypes(n[1].typ, {tyGenericInst, tyRange, tyOrdinal, tyAlias, tySink}).kind in + {tyInt..tyInt64}: + let idx = getOrdValue(n[1]) + if idx >= 0 and idx < arr.len: n.typ = arr[toInt(idx)] + else: + localError(c.config, n.info, + "invalid index $1 in subscript for tuple of length $2" % + [$idx, $arr.len]) + result = n + else: + result = nil + else: + let s = if n[0].kind == nkSym: n[0].sym + elif n[0].kind in nkSymChoices + {nkOpenSym}: n[0][0].sym + else: nil + if s != nil: + case s.kind + of skProc, skFunc, skMethod, skConverter, skIterator: + # type parameters: partial generic specialization + n[0] = semSymGenericInstantiation(c, n[0], s) + result = maybeInstantiateGeneric(c, n, s) + of skMacro, skTemplate: + if efInCall in flags: + # We are processing macroOrTmpl[] in macroOrTmpl[](...) call. + # Return as is, so it can be transformed into complete macro or + # template call in semIndirectOp caller. + result = n + else: + # We are processing macroOrTmpl[] not in call. Transform it to the + # macro or template call with generic arguments here. + n.transitionSonsKind(nkCall) + case s.kind + of skMacro: result = semMacroExpr(c, n, n, s, flags) + of skTemplate: result = semTemplateExpr(c, n, s, flags) + else: discard + of skType: + result = symNodeFromType(c, semTypeNode(c, n, nil), n.info) + else: + discard + +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"[]")) + result = semExpr(c, buildOverloadedSubscripts(n, getIdent(c.cache, "[]")), flags, expectedType) proc propertyWriteAccess(c: PContext, n, nOrig, a: PNode): PNode = - var id = considerAcc(a[1]) - let setterId = newIdentNode(getIdent(id.s & '='), n.info) + var id = considerQuotedIdent(c, a[1], a) + var setterId = newIdentNode(getIdent(c.cache, id.s & '='), n.info) # a[0] is already checked for semantics, that does ``builtinFieldAccess`` # 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], semExpr(c, n[1])]) - let orig = newNode(nkCall, n.info, sons = @[setterId, aOrig[0], nOrig[1]]) - result = semDirectCallAnalyseEffects(c, result, orig, {}) - if result != nil: - fixAbstractType(c, result) - analyseIfAddressTakenInCall(c, result) - else: - if not ContainsOrIncl(c.UnknownIdents, id.id): - LocalError(n.Info, errUndeclaredFieldX, id.s) - result = errorNode(c, n) + result = newTreeI(nkCall, n.info, setterId, a[0], n[1]) + result.flags.incl nfDotSetter + let orig = newTreeI(nkCall, n.info, setterId, aOrig[0], nOrig[1]) + result = semOverloadedCallAnalyseEffects(c, result, orig, {}) -proc takeImplicitAddr(c: PContext, n: PNode): PNode = + if result != nil: + result = afterCallActions(c, result, nOrig, {}) + #fixAbstractType(c, result) + #analyseIfAddressTakenInCall(c, result) + +proc takeImplicitAddr(c: PContext, n: PNode; isLent: bool): PNode = + # See RFC #7373, calls returning 'var T' are assumed to + # 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" % [ + 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" % [ + 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] - else: nil - var valid = isAssignable(c, n) + 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: - LocalError(n.info, errXStackEscape, renderTree(n, {renderNoComments})) + if valid in {arAddressableConst, arLentValue} and isLent: + discard "ok" + elif valid == arLocalLValue: + localError(c.config, n.info, errXStackEscape % renderTree(n, {renderNoComments})) else: - LocalError(n.info, errExprHasNoAddress) - result = newNodeIT(nkHiddenAddr, n.info, makePtrType(c, n.typ)) + localError(c.config, n.info, errExprHasNoAddress) + result = newNodeIT(nkHiddenAddr, n.info, if n.typ.kind in {tyVar, tyLent}: n.typ else: makePtrType(c, n.typ)) + if n.typ.kind in {tyVar, tyLent}: + n.typ = n.typ.elementType 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 == tyVar and x.kind == nkSym and x.sym.kind == skResult: - n.sons[0] = x # 'result[]' --> 'result' - n.sons[1] = takeImplicitAddr(c, ri) - -proc semAsgn(c: PContext, n: PNode): PNode = - checkSonsLen(n, 2) - var a = n.sons[0] + 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[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: - return propertyWriteAccess(c, n, nOrig, n[0]) + a = propertyWriteAccess(c, n, nOrig, n[0]) + if a != nil: return a + # we try without the '='; proc that return 'var' or macros are still + # possible: + a = dotTransformation(c, n[0]) + if a.kind == nkDotCall: + 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"[]=") - add(result, n[1]) - return semExprNoType(c, result) + result = buildOverloadedSubscripts(n[0], getIdent(c.cache, "[]=")) + result.add(n[1]) + if mode == noOverloadedSubscript: + 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"{}=") - 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 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, 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}).kind != tyVar and - IsAssignable(c, a) == arNone: + 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(a.info, errXCannotBeAssignedTo, + 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: - n.typ = EnforceVoidContext - if lhs.sym.typ.kind == tyGenericParam: - if matchTypeClass(lhs.typ, rhs.typ): - InternalAssert c.p.resultSym != nil - lhs.typ = rhs.typ - c.p.resultSym.typ = rhs.typ - c.p.owner.typ.sons[0] = rhs.typ + 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.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.setReturnType rhsTyp else: - typeMismatch(n, lhs.typ, rhs.typ) + typeMismatch(c.config, n.info, lhs.typ, rhsTyp, rhs) + borrowCheck(c, n, lhs, rhs) + + n[1] = fitNode(c, le, rhs, goodLineInfo(n[1])) + when false: liftTypeBoundOps(c, lhs.typ, lhs.info) - n.sons[1] = fitNode(c, le, rhs) 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 = +proc semReturn(c: PContext, n: PNode): PNode = result = n - checkSonsLen(n, 1) - if c.p.owner.kind in {skConverter, skMethod, skProc, 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] = ast.emptyNode + checkSonsLen(n, 1, c.config) + 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(n.info, errNoReturnTypeDeclared) + 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(n.info, errXNotAllowedHere, "\'return\'") + 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): - # transform ``expr`` to ``result = expr``, but not if the expr is already - # ``result``: - if result.kind == nkSym and result.sym == c.p.resultSym: - nil - elif result.kind == nkNilLit: + if result.kind == nkNilLit: # or ImplicitlyDiscardable(result): # new semantic: 'result = x' triggers the void context result.typ = nil @@ -1157,119 +2132,159 @@ proc semProcBody(c: PContext, n: PNode): PNode = # nil # # comment # are not expressions: - fixNilType(result) + 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(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.setReturnType nil + else: + 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}) +proc semYieldVarResult(c: PContext, n: PNode, restype: PType) = + var t = skipTypes(restype, {tyGenericInst, tyAlias, tySink}) case t.kind - of tyVar: - n.sons[0] = takeImplicitAddr(c, n.sons[0]) + of tyVar, 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}) - if e.kind == tyVar: - if n.sons[0].kind == nkPar: - n.sons[0].sons[i] = takeImplicitAddr(c, n.sons[0].sons[i]) - elif n.sons[0].kind in {nkHiddenStdConv, nkHiddenSubConv} and - n.sons[0].sons[1].kind == nkPar: - var a = n.sons[0].sons[1] - a.sons[i] = takeImplicitAddr(c, a.sons[i]) + for i in 0..<t.len: + let e = skipTypes(t[i], {tyGenericInst, tyAlias, tySink}) + if e.kind in {tyVar, tyLent}: + 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(n.sons[0].info, errXExpected, "tuple constructor") - else: nil - -proc SemYield(c: PContext, n: PNode): PNode = + 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) + checkSonsLen(n, 1, c.config) if c.p.owner == nil or c.p.owner.kind != skIterator: - LocalError(n.info, errYieldNotAllowedHere) - elif c.p.inTryStmt > 0 and c.p.owner.typ.callConv != ccInline: - LocalError(n.info, errYieldNotAllowedInTryStmt) - elif n.sons[0].kind != nkEmpty: - n.sons[0] = SemExprWithType(c, n.sons[0]) # check for type compatibility: - var restype = c.p.owner.typ.sons[0] + localError(c.config, n.info, errYieldNotAllowedHere) + elif n[0].kind != nkEmpty: + var iterType = c.p.owner.typ + let restype = iterType[0] + n[0] = semExprWithType(c, n[0], {}, restype) # check for type compatibility: if restype != nil: - n.sons[0] = fitNode(c, restype, n.sons[0]) - if n.sons[0].typ == nil: InternalError(n.info, "semYield") - SemYieldVarResult(c, n, restype) + if n[0].typ == nil: internalError(c.config, n.info, "semYield") + + if resultTypeIsInferrable(restype): + 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(n.info, errCannotReturnExpr) - elif c.p.owner.typ.sons[0] != nil: - localError(n.info, errGenerated, "yield statement must yield a value") + localError(c.config, n.info, errCannotReturnExpr) + elif c.p.owner.typ.returnType != nil: + localError(c.config, n.info, errGenerated, "yield statement must yield a value") + +proc considerQuotedIdentOrDot(c: PContext, n: PNode, origin: PNode = nil): PIdent = + if n.kind == nkDotExpr: + let a = considerQuotedIdentOrDot(c, n[0], origin).s + let b = considerQuotedIdentOrDot(c, n[1], origin).s + var s = newStringOfCap(a.len + b.len + 1) + s.add(a) + s.add('.') + s.add(b) + result = getIdent(c.cache, s) + else: + result = considerQuotedIdent(c, n, origin) -proc lookUpForDefined(c: PContext, i: PIdent, onlyCurrentScope: bool): PSym = - if onlyCurrentScope: - result = localSearchInScope(c, i) - else: - result = searchInScopes(c, i) # no need for stub loading +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) - var m = LookupForDefined(c, n.sons[0], onlyCurrentScope) - if (m != nil) and (m.kind == skModule): - if (n.sons[1].kind == nkIdent): - var ident = n.sons[1].ident - if m == c.module: - result = StrTableGet(c.topLevelScope.symbols, ident) - else: - result = StrTableGet(m.tab, ident) - else: - LocalError(n.sons[1].info, errIdentifierExpected, "") - of nkAccQuoted: - result = lookupForDefined(c, considerAcc(n), onlyCurrentScope) + if onlyCurrentScope: return + checkSonsLen(n, 2, c.config) + 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 = someSym(c.graph, m, ident) of nkSym: result = n.sym - else: - LocalError(n.info, errIdentifierExpected, renderTree(n)) + of nkOpenSymChoice, nkClosedSymChoice: + result = n[0].sym + of nkOpenSym: + result = lookUpForDeclared(c, n[0], onlyCurrentScope) + else: + localError(c.config, n.info, "identifier expected, but got: " & renderTree(n)) result = nil -proc semDefined(c: PContext, n: PNode, onlyCurrentScope: bool): PNode = - checkSonsLen(n, 2) +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 LookUpForDefined(c, n.sons[1], onlyCurrentScope) != nil: - result.intVal = 1 - elif not onlyCurrentScope and (n.sons[1].kind == nkIdent) and - condsyms.isDefined(n.sons[1].ident): - result.intVal = 1 + result.intVal = ord lookUpForDeclared(c, n[1], onlyCurrentScope) != nil result.info = n.info - result.typ = getSysType(tyBool) - -proc setMs(n: PNode, s: PSym): PNode = - result = n - n.sons[0] = newSymNode(s) - n.sons[0].info = n.info + result.typ = getSysType(c.graph, n.info, tyBool) proc expectMacroOrTemplateCall(c: PContext, n: PNode): PSym = ## The argument to the proc should be nkCall(...) or similar ## Returns the macro/template symbol if isCallExpr(n): - var expandedSym = qualifiedLookup(c, n[0], {checkUndeclared}) + var expandedSym = qualifiedLookUp(c, n[0], {checkUndeclared}) if expandedSym == nil: - LocalError(n.info, errUndeclaredIdentifier, n[0].renderTree) + errorUndeclaredIdentifier(c, n.info, n[0].renderTree) return errorSym(c, n[0]) if expandedSym.kind notin {skMacro, skTemplate}: - LocalError(n.info, errXisNoMacroOrTemplate, expandedSym.name.s) + localError(c.config, n.info, "'$1' is not a macro or template" % expandedSym.name.s) return errorSym(c, n[0]) result = expandedSym else: - LocalError(n.info, errXisNoMacroOrTemplate, n.renderTree) + localError(c.config, n.info, "'$1' is not a macro or template" % n.renderTree) result = errorSym(c, n) proc expectString(c: PContext, n: PNode): string = @@ -1277,146 +2292,231 @@ proc expectString(c: PContext, n: PNode): string = if n.kind in nkStrKinds: return n.strVal else: - LocalError(n.info, errStringLiteralExpected) - -proc getMagicSym(magic: TMagic): PSym = - result = newSym(skProc, getIdent($magic), GetCurrOwner(), gCodegenLineInfo) - result.magic = magic + result = "" + localError(c.config, n.info, errStringLiteralExpected) -proc newAnonSym(kind: TSymKind, info: TLineInfo, - owner = getCurrOwner()): PSym = - result = newSym(kind, idAnon, owner, info) - result.flags = {sfGenSym} +proc newAnonSym(c: PContext; kind: TSymKind, info: TLineInfo): PSym = + result = newSym(kind, c.cache.idAnon, c.idgen, getCurrOwner(c), info) proc semExpandToAst(c: PContext, n: PNode): PNode = - var macroCall = n[1] - var expandedSym = expectMacroOrTemplateCall(c, macroCall) - if expandedSym.kind == skError: return n - - macroCall.sons[0] = newSymNode(expandedSym, macroCall.info) - markUsed(n, expandedSym) - - for i in countup(1, macroCall.len-1): - macroCall.sons[i] = semExprWithType(c, macroCall[i], {}) + let macroCall = n[1] + + when false: + let expandedSym = expectMacroOrTemplateCall(c, macroCall) + if expandedSym.kind == skError: return n + + macroCall[0] = newSymNode(expandedSym, macroCall.info) + markUsed(c, n.info, expandedSym) + onUse(n.info, expandedSym) + + if isCallExpr(macroCall): + 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 = default(TOverloadIter) + var symx = initOverloadIter(o, c, headSymbol) + while symx != nil: + if symx.kind in {skTemplate, skMacro} and symx.typ.len == macroCall.len: + cand = symx + inc cands + symx = nextOverloadIter(o, c, headSymbol) + if cands == 0: + localError(c.config, n.info, "expected a template that takes " & $(macroCall.len-1) & " arguments") + elif cands >= 2: + localError(c.config, n.info, "ambiguous symbol in 'getAst' context: " & $macroCall) + else: + let info = macroCall[0].info + macroCall[0] = newSymNode(cand, info) + markUsed(c, info, cand) + onUse(info, cand) + # we just perform overloading resolution here: + #n[1] = semOverloadedCall(c, macroCall, macroCall, {skTemplate, skMacro}) + else: + localError(c.config, n.info, "getAst takes a call, but got " & n.renderTree) # Preserve the magic symbol in order to be handled in evals.nim - InternalAssert n.sons[0].sym.magic == mExpandToAst - n.typ = getSysSym("PNimrodNode").typ # expandedSym.getReturnType - result = n + 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 + result.typ = sysTypeFromName(c.graph, n.info, "NimNode") 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) -proc processQuotations(n: var PNode, op: string, +proc processQuotations(c: PContext; n: var PNode, op: string, quotes: var seq[PNode], ids: var seq[PNode]) = template returnQuote(q) = quotes.add q - n = newIdentNode(getIdent($quotes.len), n.info) + n = newIdentNode(getIdent(c.cache, $quotes.len), n.info) ids.add n return - if n.kind == nkPrefix: - checkSonsLen(n, 2) - 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(examinedOp.substr(op.len)), n.info) - elif n.kind == nkAccQuoted and op == "``": - returnQuote n[0] - - if not n.isAtom: - for i in 0 .. <n.len: - processQuotations(n.sons[i], op, quotes, ids) + prefixed[0] = newIdentNode(getIdent(c.cache, examinedOp.substr(op.len)), prefixed.info) + + 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 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 - doBlk = n{-1} + quotedBlock = n[^1] op = if n.len == 3: expectString(c, n[1]) else: "``" - quotes = newSeq[PNode](1) - # the quotes will be added to a nkCall statement - # leave some room for the callee symbol - ids = newSeq[PNode]() + quotes = newSeq[PNode](2) + # the quotes will be added to a nkCall statement + # 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 = dummyTemplateSym.newSymNode, + pattern = c.graph.emptyNode, genericParams = c.graph.emptyNode, + pragmas = c.graph.emptyNode, exceptions = c.graph.emptyNode) - internalAssert doBlk.kind == nkDo - processQuotations(doBlk.sons[bodyPos], op, quotes, ids) - - doBlk.sons[namePos] = newAnonSym(skTemplate, n.info).newSymNode if ids.len > 0: - doBlk[paramsPos].sons.setLen(2) - doBlk[paramsPos].sons[0] = getSysSym("stmt").newSymNode # return type - ids.add getSysSym("expr").newSymNode # params type - ids.add emptyNode # no default value - doBlk[paramsPos].sons[1] = newNode(nkIdentDefs, n.info, ids) - - var tmpl = semTemplateDef(c, doBlk) + 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, @[ - getMagicSym(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: - let oldErrorCount = msgs.gErrorCounter - let oldErrorMax = msgs.gErrorMax - inc c.InCompilesContext - inc msgs.gSilence - # do not halt after first error: - msgs.gErrorMax = high(int) - + 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 + # 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(gOwners) + let oldOwnerLen = c.graph.owners.len let oldGenerics = c.generics - let oldContextLen = msgs.getInfoContextLen() - - let oldInGenericContext = c.InGenericContext - let oldInUnrolledContext = c.InUnrolledContext - let oldInGenericInst = c.InGenericInst + let oldErrorOutputs = c.config.m.errorOutputs + if efExplain notin flags: c.config.m.errorOutputs = {} + let oldContextLen = msgs.getInfoContextLen(c.config) + + let oldInGenericContext = c.inGenericContext + let oldInUnrolledContext = c.inUnrolledContext + let oldInGenericInst = c.inGenericInst + let oldInStaticContext = c.inStaticContext let oldProcCon = c.p c.generics = @[] + var err: string try: result = semExpr(c, n, flags) - if msgs.gErrorCounter != 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: - nil + result = nil # undo symbol table changes (as far as it's possible): + c.compilesContextId = oldCompilesId c.generics = oldGenerics - c.InGenericContext = oldInGenericContext - c.InUnrolledContext = oldInUnrolledContext - c.InGenericInst = oldInGenericInst + c.inGenericContext = oldInGenericContext + c.inUnrolledContext = oldInUnrolledContext + c.inGenericInst = oldInGenericInst + c.inStaticContext = oldInStaticContext c.p = oldProcCon - msgs.setInfoContextLen(oldContextLen) - setlen(gOwners, oldOwnerLen) + msgs.setInfoContextLen(c.config, oldContextLen) + setLen(c.graph.owners, oldOwnerLen) c.currentScope = oldScope - dec c.InCompilesContext - dec msgs.gSilence - msgs.gErrorCounter = oldErrorCount - msgs.gErrorMax = oldErrorMax + 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(tyBool) + 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) @@ -1426,527 +2526,1088 @@ proc semShallowCopy(c: PContext, n: PNode, flags: TExprFlags): PNode = else: result = semDirectOp(c, n, flags) -proc semMagic(c: PContext, n: PNode, s: PSym, flags: TExprFlags): PNode = +proc createFlowVar(c: PContext; t: PType; info: TLineInfo): PType = + 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; + info: TLineInfo): PSym = + let sym = magicsys.getCompilerProc(c.graph, "nimCreateFlowVar") + if sym == nil: + localError(c.config, info, "system needs: nimCreateFlowVar") + var bindings = initTypeMapping() + bindings.idTablePut(sym.ast[genericParamsPos][0].typ, t) + result = c.semGenerateInstance(c, sym, bindings, info) + # since it's an instantiation, we unmark it as a compilerproc. Otherwise + # codegen would fail: + if sfCompilerProc in result.flags: + result.flags.excl {sfCompilerProc, sfExportc, sfImportc} + result.loc.snippet = "" + +proc setMs(n: PNode, s: PSym): PNode = + result = n + n[0] = newSymNode(s) + n[0].info = n.info + +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; 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 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)) - of mOf: result = semOf(c, setMs(n, s)) - of mEcho: result = semEcho(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) + of mAddr: + markUsed(c, n.info, s) + checkSonsLen(n, 2, c.config) + result = semAddr(c, n[1]) + of mTypeOf: + 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: - checkSonsLen(n, 2) - result = newStrNodeT(renderTree(n[1], {renderNoComments}), n) - result.typ = getSysType(tyString) - else: result = semDirectOp(c, n, flags) + 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[bodyPos] + inc c.inParallelStmt + result[1] = semStmt(c, x, {}) + dec c.inParallelStmt + of mSpawn: + markUsed(c, n.info, s) + when defined(leanCompiler): + result = localErrorNode(c, n, "compiler was built without 'spawn' support") + else: + result = setMs(n, s) + for i in 1..<n.len: + result[i] = semExpr(c, n[i]) + + if n.len > 1 and n[1].kind notin nkCallKinds: + return localErrorNode(c, n, n[1].info, "'spawn' takes a call expression; got: " & $n[1]) + + let typ = result[^1].typ + if not typ.isEmptyType: + if spawnResult(typ, c.inParallelStmt > 0) == srFlowVar: + 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[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) + result = semOverloadedCallAnalyseEffects(c, n, nOrig, flags) + if result == nil: + result = errorNode(c, n) + else: + let callee = result[0].sym + if callee.magic == mNone: + semFinishOperands(c, result) + activate(c, result) + fixAbstractType(c, result) + analyseIfAddressTakenInCall(c, result) + if callee.magic != mNone: + result = magicsAfterOverloadResolution(c, result, flags) + of mRunnableExamples: + 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, 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 - - template setResult(e: expr) = - if semCheck: result = semStmt(c, e) # do not open a new scope! + let flags = if semCheck: {efWantStmt} else: {} + + template setResult(e: untyped) = + if semCheck: result = semExpr(c, e, flags) # do not open a new scope! else: result = e - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] + # Check if the node is "when nimvm" + # when nimvm: + # ... + # else: + # ... + var whenNimvm = false + var typ = commonTypeBegin + if n.len in 1..2 and n[0].kind == nkElifBranch and ( + n.len == 1 or n[1].kind == nkElse): + var exprNode = n[0][0] + if exprNode.kind == nkOpenSym: + exprNode = exprNode[0] + if exprNode.kind == nkIdent: + whenNimvm = lookUp(c, exprNode).magic == mNimvm + elif exprNode.kind == nkSym: + whenNimvm = exprNode.sym.magic == mNimvm + if whenNimvm: n.flags.incl nfLL + + var cannotResolve = false + for i in 0..<n.len: + var it = n[i] case it.kind - of nkElifBranch, nkElifExpr: - checkSonsLen(it, 2) - var e = semConstExpr(c, it.sons[0]) - if e.kind != nkIntLit: InternalError(n.info, "semWhen") - elif e.intVal != 0 and result == nil: - setResult(it.sons[1]) + of nkElifBranch, nkElifExpr: + checkSonsLen(it, 2, c.config) + if whenNimvm: + if semCheck: + it[1] = semExpr(c, it[1], flags) + typ = commonType(c, typ, it[1].typ) + result = n # when nimvm is not elimited until codegen + elif c.inGenericContext > 0: + let e = semExprWithType(c, it[0]) + if e.typ.kind == tyFromExpr: + it[0] = makeStaticExpr(c, e) + cannotResolve = true + else: + it[0] = forceBool(c, e) + let val = getConstExpr(c.module, it[0], c.idgen, c.graph) + if val == nil or val.kind != nkIntLit: + cannotResolve = true + elif not cannotResolve and val.intVal != 0 and result == nil: + setResult(it[1]) + return # we're not in nimvm and we already have a result + else: + let e = forceBool(c, semConstExpr(c, it[0])) + if e.kind != nkIntLit: + # can happen for cascading errors, assume false + # InternalError(n.info, "semWhen") + discard + elif e.intVal != 0 and result == nil: + setResult(it[1]) + return # we're not in nimvm and we already have a result of nkElse, nkElseExpr: - checkSonsLen(it, 1) - if result == nil: - setResult(it.sons[0]) - else: illFormedAst(n) + checkSonsLen(it, 1, c.config) + if cannotResolve: + discard + elif result == nil or whenNimvm: + if semCheck: + it[0] = semExpr(c, it[0], flags) + typ = commonType(c, typ, it[0].typ) + if typ != nil and typ.kind != tyUntyped: + it[0] = fitNode(c, typ, it[0], it[0].info) + if result == nil: + result = it[0] + else: illFormedAst(n, c.config) + if cannotResolve: + result = semGenericStmt(c, n) + result.typ = makeTypeFromExpr(c, result.copyTree) + return if result == nil: - result = newNodeI(nkEmpty, n.info) - # 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) + result = newNodeI(nkEmpty, n.info) + 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)) - else: + 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) - 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, - {tyGenericInst, tyVar, tyOrdinal}) - n.sons[i].typ = n.sons[i].sons[2].typ # range node needs type too - elif n.sons[i].kind == nkRange: + 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[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, - {tyGenericInst, tyVar, tyOrdinal}) + 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, tyOrdinal}) - if not isOrdinalType(typ): - LocalError(n.info, errOrdinalTypeExpected) - typ = makeRangeType(c, 0, MaxSetElements - 1, n.info) - elif lengthOrd(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 - if isRange(n.sons[i]): - m = newNodeI(nkRange, n.sons[i].info) - addSon(m, fitNode(c, typ, n.sons[i].sons[1])) - addSon(m, fitNode(c, typ, n.sons[i].sons[2])) - elif n.sons[i].kind == nkRange: m = n.sons[i] # already semchecked + let info = n[i].info + if isRange(n[i]): + m = newNodeI(nkRange, info) + 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]) - addSon(result, m) + m = fitNode(c, typ, n[i], info) + result.add m -proc semTableConstr(c: PContext, n: PNode): PNode = - # we simply transform ``{key: value, key2, key3: value}`` to +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): - var pair = newNodeI(nkPar, x.info) - pair.add(n.sons[j]) + 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[j]) pair.add(x[1]) result.add(pair) - var pair = newNodeI(nkPar, x.info) + var pair = newNodeI(nkTupleConstr, x.info) pair.add(x[0]) pair.add(x[1]) result.add(pair) lastKey = i+1 - if lastKey != n.len: illFormedAst(n) - result = semExpr(c, result) + if lastKey != n.len: illFormedAst(n, c.config) + result = semExpr(c, result, expectedType = expectedType) -type - TParKind = enum +type + TParKind = enum paNone, paSingle, paTupleFields, paTuplePositions -proc checkPar(n: PNode): TParKind = - var length = sonsLen(n) - if length == 0: +proc checkPar(c: PContext; n: PNode): TParKind = + if n.len == 0: result = paTuplePositions # () - elif length == 1: - result = paSingle # (expr) - else: - 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[0].kind == nkExprColonExpr: result = paTupleFields else: result = paTuplePositions - for i in countup(0, length - 1): - if result == paTupleFields: - if (n.sons[i].kind != nkExprColonExpr) or - not (n.sons[i].sons[0].kind in {nkSym, nkIdent}): - LocalError(n.sons[i].info, errNamedExprExpected) + for i in 0..<n.len: + if result == paTupleFields: + 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(n.sons[i].info, errNamedExprNotAllowed) + else: + if n[i].kind == nkExprColonExpr: + localError(c.config, n[i].info, errNamedExprNotAllowed) return paNone -proc semTupleFieldsConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = - result = newNodeI(nkPar, n.info) +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.sons[i].kind != nkExprColonExpr) or - not (n.sons[i].sons[0].kind in {nkSym, nkIdent}): - illFormedAst(n.sons[i]) - 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 - if ContainsOrIncl(ids, id.id): - localError(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) + 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[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.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 checkInitialized(n: PNode, ids: TIntSet, info: TLineInfo) = - case n.kind - of nkRecList: - for i in countup(0, sonsLen(n) - 1): - checkInitialized(n.sons[i], ids, info) - of nkRecCase: - if (n.sons[0].kind != nkSym): InternalError(info, "checkInitialized") - checkInitialized(n.sons[0], ids, info) - when false: - # XXX we cannot check here, as we don't know the branch! - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind - of nkOfBranch, nkElse: checkInitialized(lastSon(n.sons[i]), ids, info) - else: internalError(info, "checkInitialized") - of nkSym: - if tfNeedsInit in n.sym.typ.flags and n.sym.name.id notin ids: - Message(info, errGenerated, "field not initialized: " & n.sym.name.s) - else: internalError(info, "checkInitialized") +include semobjconstr -proc semObjConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = - var t = semTypeNode(c, n.sons[0], nil) +proc semBlock(c: PContext, n: PNode; flags: TExprFlags; expectedType: PType = nil): PNode = result = n - result.typ = t - result.kind = nkObjConstr - t = skipTypes(t, abstractInst) - if t.kind == tyRef: t = skipTypes(t.sons[0], abstractInst) - if t.kind != tyObject: - localError(n.info, errGenerated, "object constructor needs an object type") - return - var objType = t - var ids = initIntSet() - for i in 1.. <n.len: - let it = n.sons[i] - if it.kind != nkExprColonExpr or it.sons[0].kind notin {nkSym, nkIdent}: - localError(n.info, errNamedExprExpected) - break - var id: PIdent - if it.sons[0].kind == nkIdent: id = it.sons[0].ident - else: id = it.sons[0].sym.name - if ContainsOrIncl(ids, id.id): - localError(it.info, errFieldInitTwice, id.s) - var e = semExprWithType(c, it.sons[1], flags*{efAllowDestructor}) - var - check: PNode = nil - f: PSym - while true: - check = nil - f = lookupInRecordAndBuildCheck(c, it, t.n, id, check) - if f != nil: break - if t.sons[0] == nil: break - t = skipTypes(t.sons[0], {tyGenericInst}) - if f != nil and fieldVisible(c, f): - it.sons[0] = newSymNode(f) - e = fitNode(c, f.typ, e) - # small hack here in a nkObjConstr the ``nkExprColonExpr`` node can have - # 3 childen the last being the field check - if check != nil: - check.sons[0] = it.sons[0] - it.add(check) - else: - localError(it.info, errUndeclaredFieldX, id.s) - it.sons[1] = e - # XXX object field name check for 'case objects' if the kind is static? - if tfNeedsInit in objType.flags: - while true: - checkInitialized(objType.n, ids, n.info) - if objType.sons[0] == nil: break - objType = skipTypes(objType.sons[0], {tyGenericInst}) - -proc semBlock(c: PContext, n: PNode): PNode = - result = n - Inc(c.p.nestedBlockCounter) - checkSonsLen(n, 2) + 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(n.sons[0], 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) - Dec(c.p.nestedBlockCounter) - -proc buildCall(n: PNode): PNode = - if n.kind == nkDotExpr and n.len == 2: - # x.y --> y(x) - result = newNodeI(nkCall, n.info, 2) - result.sons[0] = n.sons[1] - result.sons[1] = n.sons[0] - elif n.kind in nkCallKinds and n.sons[0].kind == nkDotExpr: - # x.y(a) -> y(x, a) - let a = n.sons[0] - result = newNodeI(nkCall, n.info, n.len+1) - result.sons[0] = a.sons[1] - result.sons[1] = a.sons[0] - for i in 1 .. <n.len: result.sons[i+1] = n.sons[i] - else: - result = n + c.p.breakInLoop = oldBreakInLoop + dec(c.p.nestedBlockCounter) -proc doBlockIsStmtList(n: PNode): bool = - result = n.kind == nkDo and - n[paramsPos].sonsLen == 1 and - n[paramsPos][0].kind == nkEmpty - -proc fixImmediateParams(n: PNode): PNode = - # XXX: Temporary work-around until we carry out - # the planned overload resolution reforms - for i in 1 .. <safeLen(n): - if doBlockIsStmtList(n[i]): - n.sons[i] = n[i][bodyPos] - result = n +proc semExportExcept(c: PContext, n: PNode): PNode = + let moduleName = semExpr(c, n[0]) + if moduleName.kind != nkSym or moduleName.sym.kind != skModule: + localError(c.config, n.info, "The export/except syntax expects a module name") + return n + let exceptSet = readExceptSet(c, n) + let exported = moduleName.sym + 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 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) - #let L = if n.kind == nkExportExceptStmt: L = 1 else: n.len - for i in 0.. <n.len: - let a = n.sons[i] - var o: TOverloadIter + 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[i] + var o: TOverloadIter = default(TOverloadIter) var s = initOverloadIter(o, c, a) if s == nil: - localError(a.info, errGenerated, "invalid expr for 'export': " & - renderTree(a)) - while s != nil: - if s.kind in ExportableSymKinds+{skModule}: - x.add(newSymNode(s, a.info)) - s = nextOverloadIter(o, c, a) - if c.module.ast.isNil: - c.module.ast = newNodeI(nkStmtList, n.info) - assert c.module.ast.kind == nkStmtList - c.module.ast.add x - result = n + localError(c.config, a.info, errGenerated, "cannot export: " & renderTree(a)) + elif s.kind == skModule: + # forward everything from that module: + reexportSym(c, s) + for it in allSyms(c.graph, s): + if it.kind in ExportableSymKinds+{skModule}: + reexportSym(c, it) + result.add newSymNode(it, a.info) + specialSyms(c, it) + markUsed(c, n.info, s) + else: + while s != nil: + 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) + +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 + 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: + 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 - if gCmd == cmdIdeTools: suggestExpr(c, n) - if nfSem in n.flags: return + 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: - var s = lookUp(c, n) - semCaptureSym(s, c.p.owner) - result = semSym(c, n, s, flags) - if s.kind in {skProc, skMethod, skIterator, skConverter}: + 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) + 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(n.info, errInstantiateXExplicitely, s.name.s) + # 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) - of nkEmpty, nkNone, nkCommentStmt: - nil - of nkNilLit: - result.typ = getSysType(tyNil) + result = semSym(c, n, s, flags) + of nkOpenSym: + assert n.len == 1 + let inner = n[0] + result = semOpenSym(c, inner, flags, expectedType) + of nkEmpty, nkNone, nkCommentStmt, nkType: + discard + of nkNilLit: + if result.typ == nil: + result.typ = getNilType(c) + if 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(result) - of nkInt8Lit: - if result.typ == nil: result.typ = getSysType(tyInt8) - of nkInt16Lit: - if result.typ == nil: result.typ = getSysType(tyInt16) - of nkInt32Lit: - if result.typ == nil: result.typ = getSysType(tyInt32) - of nkInt64Lit: - if result.typ == nil: result.typ = getSysType(tyInt64) - of nkUIntLit: - if result.typ == nil: result.typ = getSysType(tyUInt) - of nkUInt8Lit: - if result.typ == nil: result.typ = getSysType(tyUInt8) - of nkUInt16Lit: - if result.typ == nil: result.typ = getSysType(tyUInt16) - of nkUInt32Lit: - if result.typ == nil: result.typ = getSysType(tyUInt32) - of nkUInt64Lit: - if result.typ == nil: result.typ = getSysType(tyUInt64) - of nkFloatLit: - if result.typ == nil: result.typ = getSysType(tyFloat) - of nkFloat32Lit: - if result.typ == nil: result.typ = getSysType(tyFloat32) - of nkFloat64Lit: - if result.typ == nil: result.typ = getSysType(tyFloat64) - of nkFloat128Lit: - if result.typ == nil: result.typ = getSysType(tyFloat128) - of nkStrLit..nkTripleStrLit: - if result.typ == nil: result.typ = getSysType(tyString) - of nkCharLit: - if result.typ == nil: result.typ = getSysType(tyChar) - of nkDotExpr: + 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: + 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(n.info, warnDeprecated, "bind") - result = semExpr(c, n.sons[0], flags) - of nkTypeOfExpr: + 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(newTypeS(modifier, c, baseType)) + return var typ = semTypeNode(c, n, nil).skipTypes({tyTypeDesc}) - result = symNodeFromType(c, typ, n.info) - of nkCall, nkInfix, nkPrefix, nkPostfix, nkCommand, nkCallStrLit: + 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) - var s = qualifiedLookup(c, n.sons[0], {checkUndeclared}) - if s != nil: + 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} + c.isAmbiguous = false + var s = qualifiedLookUp(c, n[0], mode) + if s != nil: case s.kind - of skMacro: - if sfImmediate notin s.flags: - result = semDirectOp(c, n, flags) - else: - var p = fixImmediateParams(n) - result = semMacroExpr(c, p, p, s) - of skTemplate: - if sfImmediate notin s.flags: - result = semDirectOp(c, n, flags) - else: - var p = fixImmediateParams(n) - result = semTemplateExpr(c, p, s) + 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, 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 Contains(c.AmbiguousSymbols, s.id): - LocalError(n.info, errUseQualifier, s.name.s) - elif s.magic == mNone: result = semDirectOp(c, n, flags) - else: result = semMagic(c, n, s, flags) - of skProc, skMethod, skConverter, skIterator: - if 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, expectedType) + else: result = semMagic(c, n, s, flags, expectedType) else: #liMessage(n.info, warnUser, renderTree(n)); - result = semIndirectOp(c, n, flags) - elif isSymChoice(n.sons[0]) or n[0].kind == nkBracketExpr and - isSymChoice(n[0][0]): - 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) else: result = semWhen(c, n, false) - result = semExpr(c, result, flags) + if result == n: + # This is a "when nimvm" stmt. + result = semWhen(c, n, true) + else: + result = semExpr(c, result, flags, expectedType) of nkBracketExpr: - checkMinSonsLen(n, 1) - var s = qualifiedLookup(c, n.sons[0], {checkUndeclared}) - if s != nil and s.kind in {skProc, skMethod, skConverter, skIterator}: - # type parameters: partial generic specialization - n.sons[0] = semSymGenericInstantiation(c, n.sons[0], s) - result = explicitGenericInstantiation(c, n, s) - else: - result = semArrayAccess(c, n, flags) + checkMinSonsLen(n, 1, c.config) + result = semArrayAccess(c, n, flags, expectedType) of nkCurlyExpr: - result = semExpr(c, buildOverloadedSubscripts(n, getIdent"{}"), flags) - of nkPragmaExpr: - # which pragmas are allowed for expressions? `likely`, `unlikely` - internalError(n.info, "semExpr() to implement") # XXX: to implement - of nkPar: - case checkPar(n) + result = semExpr(c, buildOverloadedSubscripts(n, getIdent(c.cache, "{}")), flags, expectedType) + of nkPragmaExpr: + var + 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: result = semTuplePositionsConstr(c, n, flags) - 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) - n.sons[0] = semExprWithType(c, n.sons[0]) - if isAssignable(c, n.sons[0]) notin {arLValue, arLocalLValue}: - LocalError(n.info, errExprHasNoAddress) - n.typ = makePtrType(c, n.sons[0].typ) + checkSonsLen(n, 1, c.config) + result = semAddr(c, n[0]) of nkHiddenAddr, nkHiddenDeref: - checkSonsLen(n, 1) - n.sons[0] = semExpr(c, n.sons[0], flags) + checkSonsLen(n, 1, c.config) + n[0] = semExpr(c, n[0], flags, expectedType) of nkCast: result = semCast(c, n) - of nkIfExpr, nkIfStmt: result = semIf(c, n) - of nkHiddenStdConv, nkHiddenSubConv, nkConv, nkHiddenCallConv: - checkSonsLen(n, 2) - of nkStringToCString, nkCStringToString, nkObjDownConv, nkObjUpConv: - checkSonsLen(n, 1) - of nkChckRangeF, nkChckRange64, nkChckRange: - checkSonsLen(n, 3) - of nkCheckedFieldExpr: - checkMinSonsLen(n, 2) + of nkIfExpr, nkIfStmt: result = semIf(c, n, flags, expectedType) + of nkHiddenStdConv, nkHiddenSubConv, nkConv, nkHiddenCallConv: + checkSonsLen(n, 2, c.config) + considerGenSyms(c, n) + of nkStringToCString, nkCStringToString, nkObjDownConv, nkObjUpConv: + checkSonsLen(n, 1, c.config) + considerGenSyms(c, n) + of nkChckRangeF, nkChckRange64, nkChckRange: + checkSonsLen(n, 3, c.config) + considerGenSyms(c, n) + of nkCheckedFieldExpr: + 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 - 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) + 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 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) of nkMethodDef: result = semMethod(c, n) of nkConverterDef: result = semConverterDef(c, n) of nkMacroDef: result = semMacroDef(c, n) of nkTemplateDef: result = semTemplateDef(c, n) - of nkImportStmt: - if not isTopLevel(c): LocalError(n.info, errXOnlyAtModuleScope, "import") + of nkImportStmt: + # this particular way allows 'import' in a 'compiles' context so that + # template canImport(x): bool = + # compiles: + # import x + # + # works: + if c.currentScope.depthLevel > 2 + c.compilesContextId: + localError(c.config, n.info, errXOnlyAtModuleScope % "import") result = evalImport(c, n) of nkImportExceptStmt: - if not isTopLevel(c): LocalError(n.info, errXOnlyAtModuleScope, "import") + if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "import") result = evalImportExcept(c, n) - of nkFromStmt: - if not isTopLevel(c): LocalError(n.info, errXOnlyAtModuleScope, "from") + of nkFromStmt: + if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "from") result = evalFrom(c, n) - of nkIncludeStmt: - if not isTopLevel(c): LocalError(n.info, errXOnlyAtModuleScope, "include") + of nkIncludeStmt: + #if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "include") result = evalInclude(c, n) - of nkExportStmt, nkExportExceptStmt: - if not isTopLevel(c): LocalError(n.info, errXOnlyAtModuleScope, "export") + of nkExportStmt: + if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "export") result = semExport(c, n) + of nkExportExceptStmt: + if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "export") + result = semExportExcept(c, n) of nkPragmaBlock: - result = semPragmaBlock(c, n) + result = semPragmaBlock(c, n, expectedType) of nkStaticStmt: result = semStaticStmt(c, n) + of nkDefer: + if c.currentScope == c.topLevelScope: + localError(c.config, n.info, "defer statement not supported at top level") + openScope(c) + n[0] = semExpr(c, n[0]) + closeScope(c) + if not n[0].typ.isEmptyType and not implicitlyDiscardable(n[0]): + localError(c.config, n.info, "'defer' takes a 'void' expression") + #localError(c.config, n.info, errGenerated, "'defer' not allowed in this context") + of nkGotoState, nkState: + if n.len != 1 and n.len != 2: illFormedAst(n, c.config) + 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(n.info, errInvalidExpressionX, + localError(c.config, n.info, "invalid expression: " & renderTree(n, {renderNoComments})) - incl(result.flags, nfSem) + 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 new file mode 100644 index 000000000..874055cdc --- /dev/null +++ b/compiler/semfields.nim @@ -0,0 +1,171 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## This module does the semantic transformation of the fields* iterators. +# included from semstmts.nim + +type + TFieldInstCtx = object # either 'tup[i]' or 'field' is valid + tupleType: PType # if != nil we're traversing a tuple + tupleIndex: int + field: PSym + replaceByFieldName: bool + 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 = copyNode(n) + of nkIdent, nkSym: + result = n + let ident = considerQuotedIdent(c.c, n) + 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[c.tupleIndex].sym.name.s + result = newStrNode(nkStrLit, fieldName) + return + # other fields: + for i in ord(c.replaceByFieldName)..<forLoop.len-2: + if ident.id == considerQuotedIdent(c.c, forLoop[i]).id: + var call = forLoop[^2] + var tupl = call[i+1-ord(c.replaceByFieldName)] + if c.field.isNil: + result = newNodeI(nkBracketExpr, n.info) + result.add(tupl) + result.add(newIntNode(nkIntLit, c.tupleIndex)) + else: + result = newNodeI(nkDotExpr, n.info) + result.add(tupl) + result.add(newSymNode(c.field, n.info)) + break + else: + if n.kind == nkContinueStmt: + localError(c.c.config, n.info, + "'continue' not supported in a 'fields' loop") + result = shallowCopy(n) + for i in 0..<n.len: + result[i] = instFieldLoopBody(c, n[i], forLoop) + +type + TFieldsCtx = object + c: PContext + m: TMagic + +proc semForObjectFields(c: TFieldsCtx, typ, forLoop, father: PNode) = + case typ.kind + of nkSym: + # 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, {})) + dec c.c.inUnrolledContext + closeScope(c.c) + of nkNilLit: discard + of nkRecCase: + let call = forLoop[^2] + if call.len > 2: + localError(c.c.config, forLoop.info, + "parallel 'fields' iterator does not work for 'case' objects") + return + # iterate over the selector: + semForObjectFields(c, typ[0], forLoop, father) + # we need to generate a case statement: + var caseStmt = newNodeI(nkCaseStmt, forLoop.info) + # generate selector: + var access = newNodeI(nkDotExpr, forLoop.info, 2) + 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: + var branch = copyTree(typ[i]) + branch[^1] = newNodeI(nkStmtList, forLoop.info) + semForObjectFields(c, typ[i].lastSon, forLoop, branch[^1]) + caseStmt.add(branch) + father.add(caseStmt) + of nkRecList: + for t in items(typ): semForObjectFields(c, t, forLoop, father) + else: + illFormedAstLocal(typ, c.c.config) + +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 = 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"), c.idgen, getCurrOwner(c), n.info) + trueSymbol.typ = getSysType(c.graph, n.info, tyBool) + + result[0] = newSymNode(trueSymbol, n.info) + var stmts = newNodeI(nkStmtList, n.info) + result[1] = stmts + + 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[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: + let calli = call[i] + var tupleTypeB = skipTypes(calli.typ, skippedTypesForFields) + if not sameType(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[^1] + for i in 0..<tupleTypeA.len: + openScope(c) + var fc = TFieldInstCtx( + tupleType: tupleTypeA, + tupleIndex: i, + c: c, + replaceByFieldName: m == mFieldPairs + ) + var body = instFieldLoopBody(fc, loopBody, n) + inc c.inUnrolledContext + stmts.add(semStmt(c, body, {})) + dec c.inUnrolledContext + closeScope(c) + else: + var fc = TFieldsCtx(m: m, c: c) + var t = tupleTypeA + while t.kind == tyObject: + semForObjectFields(fc, t.n, n, stmts) + 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: + if containsNode(stmts, {nkBreakStmt}): + var b = newNodeI(nkBreakStmt, n.info) + b.add(newNodeI(nkEmpty, n.info)) + stmts.add(b) + else: + result = stmts diff --git a/compiler/semfold.nim b/compiler/semfold.nim index 6fdb780c9..80144ccc0 100644 --- a/compiler/semfold.nim +++ b/compiler/semfold.nim @@ -1,7 +1,7 @@ # # -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -10,75 +10,122 @@ # this module folds constants; used by semantic checking phase # and evaluation phase -import - strutils, lists, options, ast, astalgo, trees, treetab, nimsets, times, - nversion, platform, math, msgs, os, condsyms, idents, renderer, types, - commands, magicsys, saturate +import + options, ast, trees, nimsets, + platform, msgs, idents, renderer, types, + commands, magicsys, modulegraphs, lineinfos, wordrecg -proc getConstExpr*(m: PSym, n: PNode): PNode - # evaluates the constant expression or returns nil if it is no constant - # expression -proc evalOp*(m: TMagic, n, a, b, c: PNode): PNode -proc leValueConv*(a, b: PNode): bool -proc newIntNodeT*(intVal: BiggestInt, n: PNode): PNode -proc newFloatNodeT*(floatVal: BiggestFloat, n: PNode): PNode -proc newStrNodeT*(strVal: string, n: PNode): PNode - -# implementation - -proc newIntNodeT(intVal: BiggestInt, n: PNode): PNode = - case skipTypes(n.typ, abstractVarRange).kind - of tyInt: - result = newIntNode(nkIntLit, intVal) - result.typ = getIntLitType(result) - # 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 +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): PNode = - result = newFloatNode(nkFloatLit, floatVal) +proc newFloatNodeT*(floatVal: BiggestFloat, n: PNode; g: ModuleGraph): PNode = + if n.typ.skipTypes(abstractInst).kind == tyFloat32: + result = newFloatNode(nkFloat32Lit, floatVal) + else: + result = newFloatNode(nkFloatLit, floatVal) result.typ = n.typ result.info = n.info -proc newStrNodeT(strVal: string, n: PNode): PNode = +proc newStrNodeT*(strVal: string, n: PNode; g: ModuleGraph): PNode = result = newStrNode(nkStrLit, strVal) result.typ = n.typ result.info = n.info -proc ordinalValToString(a: PNode): string = +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; idgen: IdGenerator; g: ModuleGraph): PNode + +proc checkInRange(conf: ConfigRef; n: PNode, res: Int128): bool = + res in firstOrd(conf, n.typ)..lastOrd(conf, n.typ) + +proc foldAdd(a, b: Int128, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = + let res = a + b + if checkInRange(g.config, n, res): + result = newIntNodeT(res, n, idgen, g) + else: + result = nil + +proc foldSub(a, b: Int128, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = + let res = a - b + if checkInRange(g.config, n, res): + result = newIntNodeT(res, n, idgen, g) + else: + result = nil + +proc foldUnarySub(a: Int128, n: PNode; idgen: IdGenerator, g: ModuleGraph): PNode = + if a != firstOrd(g.config, n.typ): + result = newIntNodeT(-a, n, idgen, g) + else: + result = nil + +proc foldAbs(a: Int128, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = + if a != firstOrd(g.config, n.typ): + result = newIntNodeT(abs(a), n, idgen, g) + else: + result = nil + +proc foldMul(a, b: Int128, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = + let res = a * b + if checkInRange(g.config, n, res): + return newIntNodeT(res, n, idgen, g) + else: + result = nil + +proc ordinalValToString*(a: PNode; g: ModuleGraph): string = # because $ has the param ordinal[T], `a` is not necessarily an enum, but an # ordinal var x = getInt(a) - + var t = skipTypes(a.typ, abstractRange) case t.kind - of tyChar: - result = $chr(int(x) and 0xff) + of tyChar: + 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(a.info, "ordinalValToString") - var field = n.sons[i].sym - if field.position == x: - if field.ast == nil: + 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(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 = @@ -89,627 +136,659 @@ proc pickIntRange(a, b: PType): PType = proc isIntRangeOrLit(t: PType): bool = result = isIntRange(t) or isIntLit(t) -proc pickMinInt(n: PNode): biggestInt = - if n.kind in {nkIntLit..nkUInt64Lit}: - result = n.intVal - elif isIntLit(n.typ): - result = n.typ.n.intVal - elif isIntRange(n.typ): - result = firstOrd(n.typ) - else: - InternalError(n.info, "pickMinInt") - -proc pickMaxInt(n: PNode): biggestInt = - if n.kind in {nkIntLit..nkUInt64Lit}: - result = n.intVal - elif isIntLit(n.typ): - result = n.typ.n.intVal - elif isIntRange(n.typ): - result = lastOrd(n.typ) - else: - InternalError(n.info, "pickMaxInt") - -proc makeRange(typ: PType, first, last: biggestInt): PType = - var n = newNode(nkRange) - addSon(n, newIntNode(nkIntLit, min(first, last))) - addSon(n, newIntNode(nkIntLit, max(first, last))) - result = newType(tyRange, typ.owner) - result.n = n - addSonSkipIntLit(result, skipTypes(typ, {tyRange})) - -proc makeRangeF(typ: PType, first, last: biggestFloat): 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 getIntervalType*(m: TMagic, n: PNode): PType = - # Nimrod requires interval arithmetic for ``range`` types. Lots of tedious - # work but the feature is very nice for reducing explicit conversions. - result = n.typ - - template commutativeOp(opr: expr) {.immediate.} = - let a = n.sons[1] - let b = n.sons[2] - if isIntRangeOrLit(a.typ) and isIntRangeOrLit(b.typ): - result = makeRange(pickIntRange(a.typ, b.typ), - opr(pickMinInt(a), pickMinInt(b)), - opr(pickMaxInt(a), pickMaxInt(b))) - - template binaryOp(opr: expr) {.immediate.} = - let a = n.sons[1] - let b = n.sons[2] - if isIntRange(a.typ) and b.kind in {nkIntLit..nkUInt64Lit}: - result = makeRange(a.typ, - opr(pickMinInt(a), pickMinInt(b)), - opr(pickMaxInt(a), pickMaxInt(b))) - - case m - of mUnaryMinusI, mUnaryMinusI64: - let a = n.sons[1].typ - if isIntRange(a): - # (1..3) * (-1) == (-3.. -1) - result = makeRange(a, 0|-|lastOrd(a), 0|-|firstOrd(a)) - of mUnaryMinusF64: - let a = n.sons[1].typ - if isFloatRange(a): - result = makeRangeF(a, -getFloat(a.n.sons[1]), - -getFloat(a.n.sons[0])) - of mAbsF64: - let a = n.sons[1].typ - if isFloatRange(a): - # abs(-5.. 1) == (1..5) - result = makeRangeF(a, abs(getFloat(a.n.sons[1])), - abs(getFloat(a.n.sons[0]))) - of mAbsI, mAbsI64: - let a = n.sons[1].typ - if isIntRange(a): - result = makeRange(a, `|abs|`(getInt(a.n.sons[1])), - `|abs|`(getInt(a.n.sons[0]))) - of mSucc: - let a = n.sons[1].typ - let b = n.sons[2].typ - if isIntRange(a) and isIntLit(b): - # (-5.. 1) + 6 == (-5 + 6)..(-1 + 6) - result = makeRange(a, pickMinInt(n.sons[1]) |+| pickMinInt(n.sons[2]), - pickMaxInt(n.sons[1]) |+| pickMaxInt(n.sons[2])) - of mPred: - let a = n.sons[1].typ - let b = n.sons[2].typ - if isIntRange(a) and isIntLit(b): - result = makeRange(a, pickMinInt(n.sons[1]) |-| pickMinInt(n.sons[2]), - pickMaxInt(n.sons[1]) |-| pickMaxInt(n.sons[2])) - of mAddI, mAddI64, mAddU: - commutativeOp(`|+|`) - of mMulI, mMulI64, mMulU: - commutativeOp(`|*|`) - of mSubI, mSubI64, mSubU: - binaryOp(`|-|`) - of mBitandI, mBitandI64: - var a = n.sons[1] - var b = n.sons[2] - # symmetrical: - if b.kind notin {nkIntLit..nkUInt64Lit}: swap(a, b) - if b.kind in {nkIntLit..nkUInt64Lit}: - let x = b.intVal|+|1 - if (x and -x) == x and x >= 0: - result = makeRange(a.typ, 0, b.intVal) - of mModU: - let a = n.sons[1] - let b = n.sons[2] - if b.kind in {nkIntLit..nkUInt64Lit}: - if b.intVal >= 0: - result = makeRange(a.typ, 0, b.intVal-1) - else: - result = makeRange(a.typ, b.intVal+1, 0) - of mModI, mModI64: - # so ... if you ever wondered about modulo's signedness; this defines it: - let a = n.sons[1] - let b = n.sons[2] - if b.kind in {nkIntLit..nkUInt64Lit}: - if b.intVal >= 0: - result = makeRange(a.typ, -(b.intVal-1), b.intVal-1) - else: - result = makeRange(a.typ, b.intVal+1, -(b.intVal+1)) - of mDivI, mDivI64, mDivU: - binaryOp(`|div|`) - of mMinI, mMinI64: - commutativeOp(min) - of mMaxI, mMaxI64: - commutativeOp(max) - else: nil - -discard """ - mShlI, mShlI64, - mShrI, mShrI64, mAddF64, mSubF64, mMulF64, mDivF64, mMaxF64, mMinF64 -""" - -proc evalOp(m: TMagic, n, a, b, c: PNode): 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) - of mChr: result = newIntNodeT(getInt(a), n) - of mUnaryMinusI, mUnaryMinusI64: result = newIntNodeT(- getInt(a), n) - of mUnaryMinusF64: result = newFloatNodeT(- getFloat(a), n) - of mNot: result = newIntNodeT(1 - getInt(a), n) - of mCard: result = newIntNodeT(nimsets.cardSet(a), n) - of mBitnotI, mBitnotI64: result = newIntNodeT(not getInt(a), n) - of mLengthStr: result = newIntNodeT(len(getStr(a)), n) - of mLengthArray: result = newIntNodeT(lengthOrd(a.typ), n) - of mLengthSeq, mLengthOpenArray: result = newIntNodeT(sonsLen(a), n) # BUGFIX - of mUnaryPlusI, mUnaryPlusI64, mUnaryPlusF64: result = a # throw `+` away - of mToFloat, mToBiggestFloat: - result = newFloatNodeT(toFloat(int(getInt(a))), n) - of mToInt, mToBiggestInt: result = newIntNodeT(system.toInt(getFloat(a)), n) - of mAbsF64: result = newFloatNodeT(abs(getFloat(a)), n) - of mAbsI, mAbsI64: - if getInt(a) >= 0: result = a - else: result = newIntNodeT(- getInt(a), n) - 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(a.typ) * 8) - 1), n) - of mToU8: result = newIntNodeT(getInt(a) and 0x000000FF, n) - of mToU16: result = newIntNodeT(getInt(a) and 0x0000FFFF, n) - of mToU32: result = newIntNodeT(getInt(a) and 0x00000000FFFFFFFF'i64, n) - of mUnaryLt: result = newIntNodeT(getOrdValue(a) - 1, n) - of mSucc: result = newIntNodeT(getOrdValue(a) + getInt(b), n) - of mPred: result = newIntNodeT(getOrdValue(a) - getInt(b), n) - of mAddI, mAddI64: result = newIntNodeT(getInt(a) + getInt(b), n) - of mSubI, mSubI64: result = newIntNodeT(getInt(a) - getInt(b), n) - of mMulI, mMulI64: result = newIntNodeT(getInt(a) * getInt(b), n) - of mMinI, mMinI64: - if getInt(a) > getInt(b): result = newIntNodeT(getInt(b), n) - else: result = newIntNodeT(getInt(a), n) - of mMaxI, mMaxI64: - if getInt(a) > getInt(b): result = newIntNodeT(getInt(a), n) - else: result = newIntNodeT(getInt(b), n) - of mShlI, mShlI64: + 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: + if n.typ.isUnsigned: + result = newIntNodeT(bitnot(getInt(a)).maskBytes(int(getSize(g.config, n.typ))), n, idgen, g) + else: + result = newIntNodeT(bitnot(getInt(a)), n, idgen, g) + of mLengthArray: result = newIntNodeT(lengthOrd(g.config, a.typ), n, idgen, g) + of mLengthSeq, mLengthOpenArray, mLengthStr: + if a.kind == nkNilLit: + result = newIntNodeT(Zero, n, idgen, g) + elif a.kind in {nkStrLit..nkTripleStrLit}: + if a.typ.kind == tyString: + result = newIntNodeT(toInt128(a.strVal.len), n, idgen, g) + elif a.typ.kind == tyCstring: + result = newIntNodeT(toInt128(nimCStrLen(a.strVal.cstring)), n, idgen, g) + else: + result = newIntNodeT(toInt128(a.len), n, idgen, g) + of mUnaryPlusI, mUnaryPlusF64: result = a # throw `+` away + # XXX: Hides overflow/underflow + 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: + let argA = getInt(a) + let argB = getInt(b) + result = newIntNodeT(if argA < argB: argA else: argB, n, idgen, g) + of mMaxI: + 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) - of tyInt16: result = newIntNodeT(int16(getInt(a)) shl int16(getInt(b)), n) - of tyInt32: result = newIntNodeT(int32(getInt(a)) shl int32(getInt(b)), n) - of tyInt64, tyInt, tyUInt..tyUInt64: - result = newIntNodeT(`shl`(getInt(a), getInt(b)), n) - else: InternalError(n.info, "constant folding for shl") - of mShrI, mShrI64: + 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) - of tyInt16: result = newIntNodeT(int16(getInt(a)) shr int16(getInt(b)), n) - of tyInt32: result = newIntNodeT(int32(getInt(a)) shr int32(getInt(b)), n) - of tyInt64, tyInt, tyUInt..tyUInt64: - result = newIntNodeT(`shr`(getInt(a), getInt(b)), n) - else: InternalError(n.info, "constant folding for shr") - of mDivI, mDivI64: result = newIntNodeT(getInt(a) div getInt(b), n) - of mModI, mModI64: result = newIntNodeT(getInt(a) mod getInt(b), n) - of mAddF64: result = newFloatNodeT(getFloat(a) + getFloat(b), n) - of mSubF64: result = newFloatNodeT(getFloat(a) - getFloat(b), n) - of mMulF64: result = newFloatNodeT(getFloat(a) * getFloat(b), n) - of mDivF64: - if getFloat(b) == 0.0: - if getFloat(a) == 0.0: result = newFloatNodeT(NaN, n) - else: result = newFloatNodeT(Inf, n) - else: - result = newFloatNodeT(getFloat(a) / getFloat(b), n) - of mMaxF64: - if getFloat(a) > getFloat(b): result = newFloatNodeT(getFloat(a), n) - else: result = newFloatNodeT(getFloat(b), n) - of mMinF64: - if getFloat(a) > getFloat(b): result = newFloatNodeT(getFloat(b), n) - else: result = newFloatNodeT(getFloat(a), n) - of mIsNil: result = newIntNodeT(ord(a.kind == nkNilLit), n) - of mLtI, mLtI64, mLtB, mLtEnum, mLtCh: - result = newIntNodeT(ord(getOrdValue(a) < getOrdValue(b)), n) - of mLeI, mLeI64, mLeB, mLeEnum, mLeCh: - result = newIntNodeT(ord(getOrdValue(a) <= getOrdValue(b)), n) - of mEqI, mEqI64, mEqB, mEqEnum, mEqCh: - result = newIntNodeT(ord(getOrdValue(a) == getOrdValue(b)), n) - of mLtF64: result = newIntNodeT(ord(getFloat(a) < getFloat(b)), n) - of mLeF64: result = newIntNodeT(ord(getFloat(a) <= getFloat(b)), n) - of mEqF64: result = newIntNodeT(ord(getFloat(a) == getFloat(b)), n) - of mLtStr: result = newIntNodeT(ord(getStr(a) < getStr(b)), n) - of mLeStr: result = newIntNodeT(ord(getStr(a) <= getStr(b)), n) - of mEqStr: result = newIntNodeT(ord(getStr(a) == getStr(b)), n) - of mLtU, mLtU64: - result = newIntNodeT(ord(`<%`(getOrdValue(a), getOrdValue(b))), n) - of mLeU, mLeU64: - result = newIntNodeT(ord(`<=%`(getOrdValue(a), getOrdValue(b))), n) - of mBitandI, mBitandI64, mAnd: result = newIntNodeT(a.getInt and b.getInt, n) - of mBitorI, mBitorI64, mOr: result = newIntNodeT(getInt(a) or getInt(b), n) - of mBitxorI, mBitxorI64, mXor: result = newIntNodeT(a.getInt xor b.getInt, n) - of mAddU: result = newIntNodeT(`+%`(getInt(a), getInt(b)), n) - of mSubU: result = newIntNodeT(`-%`(getInt(a), getInt(b)), n) - of mMulU: result = newIntNodeT(`*%`(getInt(a), getInt(b)), n) - of mModU: result = newIntNodeT(`%%`(getInt(a), getInt(b)), n) - of mDivU: result = newIntNodeT(`/%`(getInt(a), getInt(b)), n) - of mLeSet: result = newIntNodeT(Ord(containsSets(a, b)), n) - of mEqSet: result = newIntNodeT(Ord(equalSets(a, b)), n) - of mLtSet: - result = newIntNodeT(Ord(containsSets(a, b) and not equalSets(a, b)), n) - of mMulSet: - result = nimsets.intersectSets(a, b) - result.info = n.info - of mPlusSet: - result = nimsets.unionSets(a, b) + 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: + 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(toInt128(ord(getOrdValue(a) < getOrdValue(b))), n, idgen, g) + of mLeI, mLeB, mLeEnum, mLeCh: + result = newIntNodeT(toInt128(ord(getOrdValue(a) <= getOrdValue(b))), n, idgen, g) + of mEqI, mEqB, mEqEnum, mEqCh: + 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(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 - of mMinusSet: - result = nimsets.diffSets(a, b) + of mPlusSet: + result = nimsets.unionSets(g.config, a, b) result.info = n.info - of mSymDiffSet: - result = nimsets.symdiffSets(a, b) + of mMinusSet: + result = nimsets.diffSets(g.config, a, b) result.info = n.info - of mConStrStr: result = newStrNodeT(getStrOrChar(a) & getStrOrChar(b), n) - of mInSet: result = newIntNodeT(Ord(inSet(a, b)), n) + of mConStrStr: result = newStrNodeT(getStrOrChar(a) & getStrOrChar(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. - of mIntToStr, mInt64ToStr: result = newStrNodeT($(getOrdValue(a)), n) - of mBoolToStr: - if getOrdValue(a) == 0: result = newStrNodeT("false", n) - else: result = newStrNodeT("true", n) - of mCopyStr: result = newStrNodeT(substr(getStr(a), int(getOrdValue(b))), n) - of mCopyStrLast: - result = newStrNodeT(substr(getStr(a), int(getOrdValue(b)), - int(getOrdValue(c))), n) - of mFloatToStr: result = newStrNodeT($getFloat(a), n) - of mCStrToStr, mCharToStr: result = newStrNodeT(getStrOrChar(a), n) - of mStrToStr: result = a - of mEnumToStr: result = newStrNodeT(ordinalValToString(a), n) - of mArrToSeq: + discard + of mBoolToStr: + if getOrdValue(a) == 0: result = newStrNodeT("false", n, g) + else: result = newStrNodeT("true", n, g) + of mCStrToStr, mCharToStr: + 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(a.getStr, n.info)), n) + result = newIntNodeT(toInt128(ord(commands.testCompileOption(g.config, a.getStr, n.info))), n, idgen, g) of mCompileOptionArg: - result = newIntNodeT(Ord( - testCompileOptionArg(getStr(a), getStr(b), n.info)), n) - of mNewString, mNewStringOfCap, - mExit, mInc, ast.mDec, mEcho, mSwap, mAppendStrCh, - mAppendStrStr, mAppendSeqElem, mSetLengthStr, mSetLengthSeq, - mParseExprToAst, mParseStmtToAst, mExpandToAst, mTypeTrait, - mNLen..mNError, mEqRef, mSlurp, mStaticExec: - nil - of mRand: - result = newIntNodeT(math.random(a.getInt.int), n) - else: InternalError(a.info, "evalOp(" & $m & ')') - -proc getConstIfExpr(c: PSym, n: PNode): PNode = + result = newIntNodeT(toInt128(ord( + testCompileOptionArg(g.config, getStr(a), getStr(b), n.info))), n, idgen, g) + of mEqProc: + result = newIntNodeT(toInt128(ord( + exprStructuralEquivalent(a, b, strictSymEquality=true))), n, idgen, g) + else: discard + +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]) + 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]) - if result == nil: return + if getOrdValue(e) != 0: + if result == nil: + result = getConstExpr(c, it[1], idgen, g) + if result == nil: return elif it.len == 1: - if result == nil: result = getConstExpr(c, it.sons[0]) - else: internalError(it.info, "getConstIfExpr()") - -proc partialAndExpr(c: PSym, n: PNode): PNode = - # partial evaluation - result = n - var a = getConstExpr(c, n.sons[1]) - var b = getConstExpr(c, n.sons[2]) - if a != nil: - if getInt(a) == 0: result = a - elif b != nil: result = b - else: result = n.sons[2] - elif b != nil: - if getInt(b) == 0: result = b - else: result = n.sons[1] - -proc partialOrExpr(c: PSym, n: PNode): PNode = - # partial evaluation - result = n - var a = getConstExpr(c, n.sons[1]) - var b = getConstExpr(c, n.sons[2]) - if a != nil: - if getInt(a) != 0: result = a - elif b != nil: result = b - else: result = n.sons[2] - elif b != nil: - if getInt(b) != 0: result = b - else: result = n.sons[1] - -proc leValueConv(a, b: PNode): bool = + if result == nil: result = getConstExpr(c, it[0], idgen, g) + else: internalError(g.config, it.info, "getConstIfExpr()") + +proc leValueConv*(a, b: PNode): bool = result = false case a.kind - of nkCharLit..nkUInt64Lit: + of nkCharLit..nkUInt64Lit: case b.kind - of nkCharLit..nkUInt64Lit: result = a.intVal <= b.intVal - of nkFloatLit..nkFloat128Lit: result = a.intVal <= round(b.floatVal) - else: InternalError(a.info, "leValueConv") - of nkFloatLit..nkFloat128Lit: + 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)) - else: InternalError(a.info, "leValueConv") - else: InternalError(a.info, "leValueConv") - -proc magicCall(m: PSym, n: PNode): PNode = - if sonsLen(n) <= 1: return - - var s = n.sons[0].sym - var a = getConstExpr(m, n.sons[1]) - var b, c: PNode - if a == nil: return - if sonsLen(n) > 2: - b = getConstExpr(m, n.sons[2]) - if b == nil: return - if sonsLen(n) > 3: - c = getConstExpr(m, n.sons[3]) - if c == nil: return - else: - b = nil - result = evalOp(s.magic, n, a, b, c) - -proc getAppType(n: PNode): PNode = - if gGlobalOptions.contains(optGenDynLib): - result = newStrNodeT("lib", n) - elif gGlobalOptions.contains(optGenStaticLib): - result = newStrNodeT("staticlib", n) - elif gGlobalOptions.contains(optGenGuiApp): - result = newStrNodeT("gui", n) + 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; idgen: IdGenerator; g: ModuleGraph): PNode = + if n.len <= 1: return + + var s = n[0].sym + var a = getConstExpr(m, n[1], idgen, g) + var b, c: PNode = nil + if a == nil: return + if n.len > 2: + b = getConstExpr(m, n[2], idgen, g) + if b == nil: return + if n.len > 3: + c = getConstExpr(m, n[3], idgen, g) + if c == nil: return + result = evalOp(s.magic, n, a, b, c, idgen, g) + +proc getAppType(n: PNode; g: ModuleGraph): PNode = + if g.config.globalOptions.contains(optGenDynLib): + result = newStrNodeT("lib", n, g) + elif g.config.globalOptions.contains(optGenStaticLib): + result = newStrNodeT("staticlib", n, g) + elif g.config.globalOptions.contains(optGenGuiApp): + result = newStrNodeT("gui", n, g) else: - result = newStrNodeT("console", n) - -proc rangeCheck(n: PNode, value: biggestInt) = - if value < firstOrd(n.typ) or value > lastOrd(n.typ): - LocalError(n.info, errGenerated, "cannot convert " & $value & - " to " & typeToString(n.typ)) - -proc foldConv*(n, a: PNode; check = false): PNode = - # XXX range checks? - case skipTypes(n.typ, abstractRange).kind - of tyInt..tyInt64: - case skipTypes(a.typ, abstractRange).kind + result = newStrNodeT("console", n, g) + +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)) + +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(system.toInt(getFloat(a)), n) - of tyChar: result = newIntNodeT(getOrdValue(a), n) - else: + 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 - if check: rangeCheck(n, result.intVal) + else: + raiseAssert $srcTyp.kind + of tyInt..tyInt64, tyUInt..tyUInt64: + case srcTyp.kind + of tyFloat..tyFloat64: + result = newIntNodeT(toInt128(getFloat(a)), n, idgen, g) + of tyChar, tyUInt..tyUInt64, tyInt..tyInt64: + var val = a.getOrdValue + if 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} 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(toFloat(int(getOrdValue(a))), n) + 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: - nil - else: + of tyOpenArray, tyVarargs, tyProc, tyPointer: + result = nil + else: result = a result.typ = n.typ - -proc getArrayConstr(m: PSym, n: PNode): PNode = + +proc getArrayConstr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = if n.kind == nkBracket: result = n else: - result = getConstExpr(m, n) + result = getConstExpr(m, n, idgen, g) if result == nil: result = n - -proc foldArrayAccess(m: PSym, n: PNode): PNode = - var x = getConstExpr(m, n.sons[0]) - if x == nil or x.typ.skipTypes({tyGenericInst}).kind == tyTypeDesc: return - - var y = getConstExpr(m, n.sons[1]) + +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[1], idgen, g) if y == nil: return - - var idx = getOrdValue(y) + + var idx = toInt64(getOrdValue(y)) case x.kind - of nkPar: - if (idx >= 0) and (idx < sonsLen(x)): - result = x.sons[int(idx)] - if result.kind == nkExprColonExpr: result = result.sons[1] + of nkPar, nkTupleConstr: + if idx >= 0 and idx < x.len: + result = x.sons[idx] + if result.kind == nkExprColonExpr: result = result[1] + else: + result = nil + localError(g.config, n.info, formatErrorIndexBound(idx, x.len-1) & $n) + of nkBracket: + idx -= toInt64(firstOrd(g.config, x.typ)) + if idx >= 0 and idx < x.len: result = x[int(idx)] else: - LocalError(n.info, errIndexOutOfBounds) - of nkBracket, nkMetaNode: - if (idx >= 0) and (idx < sonsLen(x)): result = x.sons[int(idx)] - else: LocalError(n.info, errIndexOutOfBounds) - of nkStrLit..nkTripleStrLit: + 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): - nil - else: - LocalError(n.info, errIndexOutOfBounds) - else: nil - -proc foldFieldAccess(m: PSym, n: PNode): PNode = + else: + localError(g.config, n.info, formatErrorIndexBound(idx, x.strVal.len-1) & $n) + else: result = nil + +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]) - if x == nil or x.kind notin {nkObjConstr, nkPar}: return + 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(n.info, errFieldXNotFound, field.name.s) - -proc foldConStrStr(m: PSym, n: PNode): PNode = + localError(g.config, n.info, "field not found: " & field.name.s) + +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]) + 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) - result.typ = newType(tyTypeDesc, s.owner) - result.typ.addSonSkipIntLit(s.typ) + if s.typ.kind != tyTypeDesc: + result.typ = newType(tyTypeDesc, idgen, s.owner) + result.typ.addSonSkipIntLit(s.typ, idgen) + else: + result.typ = s.typ + +proc foldDefine(m, s: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = + result = nil + var name = s.name.s + let prag = extractPragma(s) + if prag != nil: + for it in prag: + if it.kind in nkPragmaCallKinds and it.len == 2 and it[0].kind == nkIdent: + let word = whichKeyword(it[0].ident) + if word in {wStrDefine, wIntDefine, wBoolDefine, wDefine}: + # should be processed in pragmas.nim already + if it[1].kind in {nkStrLit, nkRStrLit, nkTripleStrLit}: + name = it[1].strVal + if isDefined(g.config, name): + let str = g.config.symbols[name] + case s.magic + of mIntDefine: + try: + result = newIntNodeT(toInt128(str.parseInt), n, idgen, g) + except ValueError: + localError(g.config, s.info, + "{.intdefine.} const was set to an invalid integer: '" & + str & "'") + of mStrDefine: + result = newStrNodeT(str, n, g) + of mBoolDefine: + try: + result = newIntNodeT(toInt128(str.parseBool.int), n, idgen, g) + except ValueError: + localError(g.config, s.info, + "{.booldefine.} const was set to an invalid bool: '" & + str & "'") + of mGenericDefine: + let rawTyp = s.typ + # pretend we don't support distinct types + let typ = rawTyp.skipTypes(abstractVarRange-{tyDistinct}) + try: + template intNode(value): PNode = + let val = toInt128(value) + rangeCheck(n, val, g) + newIntNodeT(val, n, idgen, g) + case typ.kind + of tyString, tyCstring: + result = newStrNodeT(str, n, g) + of tyInt..tyInt64: + result = intNode(str.parseBiggestInt) + of tyUInt..tyUInt64: + result = intNode(str.parseBiggestUInt) + of tyBool: + result = intNode(str.parseBool.int) + of tyEnum: + # compile time parseEnum + let ident = getIdent(g.cache, str) + for e in typ.n: + if e.kind != nkSym: internalError(g.config, "foldDefine for enum") + let es = e.sym + let match = + if es.ast.isNil: + es.name.id == ident.id + else: + es.ast.strVal == str + if match: + result = intNode(es.position) + break + if result.isNil: + raise newException(ValueError, "invalid enum value: " & str) + else: + localError(g.config, s.info, "unsupported type $1 for define '$2'" % + [name, typeToString(rawTyp)]) + except ValueError as e: + localError(g.config, s.info, + "could not process define '$1' of type $2; $3" % + [name, typeToString(rawTyp), e.msg]) + else: result = copyTree(s.astdef) # unreachable + else: + result = copyTree(s.astdef) + if result != nil: + result.info = n.info -proc getConstExpr(m: PSym, n: PNode): PNode = +proc getConstExpr(m: PSym, n: PNode; idgen: IdGenerator; g: ModuleGraph): PNode = result = nil case n.kind - of nkSym: + of nkSym: var s = n.sym - if s.kind == skEnumField: - result = newIntNodeT(s.position, n) - elif s.kind == skConst: + case s.kind + of skEnumField: + result = newIntNodeT(toInt128(s.position), n, idgen, g) + of skConst: case s.magic - of mIsMainModule: result = newIntNodeT(ord(sfMainModule in m.flags), n) - of mCompileDate: result = newStrNodeT(times.getDateStr(), n) - of mCompileTime: result = newStrNodeT(times.getClockStr(), n) - of mNimrodVersion: result = newStrNodeT(VersionAsString, n) - of mNimrodMajor: result = newIntNodeT(VersionMajor, n) - of mNimrodMinor: result = newIntNodeT(VersionMinor, n) - of mNimrodPatch: result = newIntNodeT(VersionPatch, n) - of mCpuEndian: result = newIntNodeT(ord(CPU[targetCPU].endian), n) - of mHostOS: result = newStrNodeT(toLower(platform.OS[targetOS].name), n) - of mHostCPU: result = newStrNodeT(platform.CPU[targetCPU].name.toLower, n) - of mAppType: result = getAppType(n) - of mNaN: result = newFloatNodeT(NaN, n) - of mInf: result = newFloatNodeT(Inf, n) - of mNegInf: result = newFloatNodeT(NegInf, n) + 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 mIntDefine, mStrDefine, mBoolDefine, mGenericDefine: + result = foldDefine(m, s, n, idgen, g) else: - if sfFakeConst notin s.flags: result = copyTree(s.ast) - elif s.kind in {skProc, skMethod}: # BUGFIX + result = copyTree(s.astdef) + if result != nil: + result.info = n.info + of skProc, skFunc, skMethod: result = n - elif s.kind in {skType, skGenericParam}: - result = newSymNodeTypeDesc(s, n.info) - of nkCharLit..nkNilLit: + 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, idgen, n.info) + of skGenericParam: + if s.typ.kind == tyStatic: + if s.typ.n != nil and tfUnresolved notin s.typ.flags: + result = s.typ.n + result.typ = s.typ.base + elif s.typ.isIntLit: + result = s.typ.n + else: + result = newSymNodeTypeDesc(s, idgen, n.info) + else: discard + of nkCharLit..nkNilLit: result = copyNode(n) - of nkIfExpr: - result = getConstIfExpr(m, n) - of nkCall, nkCommand, nkCallStrLit, nkPrefix, nkInfix: - if n.sons[0].kind != nkSym: return - var s = n.sons[0].sym - if s.kind != skProc: return + of nkIfExpr: + result = getConstIfExpr(m, n, idgen, g) + of nkCallKinds: + 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: - return # XXX: if it has no sideEffect, it should be evaluated - of mSizeOf: - var a = n.sons[1] - if computeSize(a.typ) < 0: - LocalError(a.info, errCannotEvalXBecauseIncompletelyDefined, - "sizeof") - result = nil - elif skipTypes(a.typ, typedescInst).kind in - IntegralTypes+NilableTypes+{tySet}: - #{tyArray,tyObject,tyTuple}: - result = newIntNodeT(getSize(a.typ), n) + # If it has no sideEffect, it should be evaluated. But not here. + return + of mLow: + if skipTypes(n[1].typ, abstractVarRange).kind in tyFloat..tyFloat64: + result = newFloatNodeT(firstFloat(n[1].typ), n, g) else: - result = nil - # XXX: size computation for complex types is still wrong - of mLow: - result = newIntNodeT(firstOrd(n.sons[1].typ), n) - of mHigh: - if skipTypes(n.sons[1].typ, abstractVar).kind notin - {tyOpenArray, tyVarargs, tySequence, tyString}: - result = newIntNodeT(lastOrd(skipTypes(n[1].typ, abstractVar)), n) + result = newIntNodeT(firstOrd(g.config, n[1].typ), n, idgen, g) + of mHigh: + if skipTypes(n[1].typ, abstractVar+{tyUserTypeClassInst}).kind notin + {tySequence, tyString, tyCstring, tyOpenArray, tyVarargs}: + 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]) + var a = getArrayConstr(m, n[1], idgen, g) if a.kind == nkBracket: - # we can optimize it away: - result = newIntNodeT(sonsLen(a)-1, n) + # we can optimize it away: + result = newIntNodeT(toInt128(a.len-1), n, idgen, g) of mLengthOpenArray: - var a = getArrayConstr(m, n.sons[1]) + 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) + # we can optimize it away! This fixes the bug ``len(134)``. + result = newIntNodeT(toInt128(a.len), n, idgen, g) else: - result = magicCall(m, n) + 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[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) + result = newStrNodeT(renderTree(n[1], {renderNoComments}), n, g) of mConStrStr: - result = foldConStrStr(m, n) + result = foldConStrStr(m, n, idgen, g) + of mIs: + # 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) - except EOverflow: - LocalError(n.info, errOverOrUnderflow) - except EDivByZero: - LocalError(n.info, errConstantDivisionByZero) - of nkAddr: - var a = getConstExpr(m, n.sons[0]) - 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]) - if a == nil: return nil - result.sons[i] = a - incl(result.flags, nfAllConst) - of nkRange: - var a = getConstExpr(m, n.sons[0]) - if a == nil: return - var b = getConstExpr(m, n.sons[1]) - if b == nil: return + result = magicCall(m, n, idgen, g) + except OverflowDefect: + localError(g.config, n.info, "over- or underflow") + except DivByZeroDefect: + localError(g.config, n.info, "division by zero") + of nkAddr: + result = nil # don't fold paths containing nkAddr + of nkBracket, nkCurly: 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]) - if a == nil: return nil - result.sons[i] = a - incl(result.flags, nfAllConst) - of nkObjConstr: - result = copyTree(n) - for i in countup(1, sonsLen(n) - 1): - var a = getConstExpr(m, n.sons[i].sons[1]) + for son in n.items: + var a = getConstExpr(m, son, idgen, g) if a == nil: return nil - result.sons[i].sons[1] = a + result.add a incl(result.flags, nfAllConst) - of nkPar: + of nkRange: + var a = getConstExpr(m, n[0], idgen, g) + if a == nil: return + var b = getConstExpr(m, n[1], idgen, g) + if b == nil: return + result = copyNode(n) + result.add a + result.add b + #of nkObjConstr: + # result = copyTree(n) + # for i in 1..<n.len: + # var a = getConstExpr(m, n[i][1]) + # if a == nil: return nil + # 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]) + 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 - else: - for i in countup(0, sonsLen(n) - 1): - var a = getConstExpr(m, n.sons[i]) + exprNew.add a + result.add exprNew + else: + 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]) - if a == nil: return - if leValueConv(n.sons[1], a) and leValueConv(a, n.sons[2]): + of nkChckRangeF, nkChckRange64, nkChckRange: + var a = getConstExpr(m, n[0], idgen, g) + if a == nil: return + if leValueConv(n[1], a) and leValueConv(a, n[2]): result = a # a <= x and x <= b result.typ = n.typ - else: - LocalError(n.info, errGenerated, `%`( - msgKindToString(errIllegalConvFromXtoY), - [typeToString(n.sons[0].typ), typeToString(n.typ)])) - of nkStringToCString, nkCStringToString: - var a = getConstExpr(m, n.sons[0]) - if a == nil: return + 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[0].typ), typeToString(n.typ)]) + of nkStringToCString, nkCStringToString: + 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]) + of nkHiddenStdConv, nkHiddenSubConv, nkConv: + var a = getConstExpr(m, n[1], idgen, g) if a == nil: return - result = foldConv(n, a, 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]) + var a = getConstExpr(m, n[1], idgen, g) if a == nil: return - if 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) - of nkDotExpr: result = foldFieldAccess(m, n) + 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: + 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: - nil + discard diff --git a/compiler/semgnrc.nim b/compiler/semgnrc.nim index abee5de5a..2639aba6c 100644 --- a/compiler/semgnrc.nim +++ b/compiler/semgnrc.nim @@ -1,7 +1,7 @@ # # -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -13,96 +13,280 @@ # A problem is that it cannot be detected if the symbol is introduced # as in ``var x = ...`` or used because macros/templates can hide this! # So we have to eval templates/macros right here so that symbol -# lookup can be accurate. XXX But this can only be done for immediate macros! +# lookup can be accurate. # included from sem.nim -type - TSemGenericFlag = enum - withinBind, withinTypeDesc, withinMixin - TSemGenericFlags = set[TSemGenericFlag] - -proc getIdentNode(n: PNode): PNode = +proc getIdentNode(c: PContext; n: PNode): PNode = case n.kind - of nkPostfix: result = getIdentNode(n.sons[1]) - of nkPragmaExpr: result = getIdentNode(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) + illFormedAst(n, c.config) result = n - -proc semGenericStmt(c: PContext, n: PNode, flags: TSemGenericFlags, - ctx: var TIntSet): PNode -proc semGenericStmtScope(c: PContext, n: PNode, + +type + GenericCtx = object + toMixin, toBind: IntSet + cursorInBody: bool # only for nimsuggest + bracketExpr: PNode + + TSemGenericFlag = enum + withinBind, + withinTypeDesc, + withinMixin, + withinConcept + + TSemGenericFlags = set[TSemGenericFlag] + +proc semGenericStmt(c: PContext, n: PNode, + flags: TSemGenericFlags, ctx: var GenericCtx): PNode + +proc semGenericStmtScope(c: PContext, n: PNode, flags: TSemGenericFlags, - ctx: var TIntSet): PNode = + ctx: var GenericCtx): PNode = openScope(c) result = semGenericStmt(c, n, flags, ctx) closeScope(c) -template macroToExpand(s: expr): expr = - s.kind in {skMacro, skTemplate} and (s.typ.len == 1 or sfImmediate 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) -proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym): PNode = +template canOpenSym(s): bool = + {withinMixin, withinConcept} * flags == {withinMixin} and s.id notin ctx.toBind + +proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym, + ctx: var GenericCtx; flags: TSemGenericFlags, + isAmbiguous: bool, + fromDotExpr=false): PNode = + result = nil + semIdeForTemplateOrGenericCheck(c.config, n, ctx.cursorInBody) incl(s.flags, sfUsed) + template maybeDotChoice(c: PContext, n: PNode, s: PSym, fromDotExpr: bool) = + if fromDotExpr: + result = symChoice(c, n, s, scForceOpen) + if result.kind == nkOpenSymChoice and result.len == 1: + result.transitionSonsKind(nkClosedSymChoice) + else: + result = symChoice(c, n, s, scOpen) + if canOpenSym(s): + if openSym in c.features: + if result.kind == nkSym: + result = newOpenSym(result) + else: + result.typ = nil + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil case s.kind - of skUnknown: + of skUnknown: # Introduced in this pass! Leave it as an identifier. result = n - of skProc, skMethod, skIterator, skConverter: - result = symChoice(c, n, s, scOpen) - of skTemplate: - if macroToExpand(s): - let n = fixImmediateParams(n) - result = semTemplateExpr(c, n, s, false) + 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) - of skMacro: - if macroToExpand(s): - result = semMacroExpr(c, n, n, s, false) + 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 = symChoice(c, n, s, scOpen) - of skGenericParam: - result = newSymNodeTypeDesc(s, n.info) - of skParam: + 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 - of skType: - if (s.typ != nil) and (s.typ.kind != tyGenericParam): - result = newSymNodeTypeDesc(s, n.info) - else: + onUse(n.info, s) + of skType: + if (s.typ != nil) and + (s.typ.flags * {tfGenericTypeParam, tfImplicitTypeParam} == {}): + if isAmbiguous: + # ambiguous types should be symchoices since lookup behaves + # differently for them in regular expressions + maybeDotChoice(c, n, s, fromDotExpr) + return + result = newSymNodeTypeDesc(s, c.idgen, n.info) + if canOpenSym(result.sym): + if openSym in c.features: + result = newOpenSym(result) + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil + elif c.inGenericContext > 0 and withinConcept notin flags: + # don't leave generic param as identifier node in generic type, + # sigmatch will try to instantiate generic type AST without all params + # fine to give a symbol node a generic type here since + # we are in a generic context and `prepareNode` will be called + result = newSymNodeTypeDesc(s, c.idgen, n.info) + if canOpenSym(result.sym): + if openSym in c.features: + result = newOpenSym(result) + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil + else: result = n - else: result = newSymNode(s, n.info) + onUse(n.info, s) + else: + result = newSymNode(s, n.info) + if canOpenSym(result.sym): + if openSym in c.features: + result = newOpenSym(result) + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil + onUse(n.info, s) -proc Lookup(c: PContext, n: PNode, flags: TSemGenericFlags, - ctx: var TIntSet): PNode = +proc lookup(c: PContext, n: PNode, flags: TSemGenericFlags, + ctx: var GenericCtx): PNode = result = n - let ident = considerAcc(n) - var s = searchInScopes(c, ident) + let ident = considerQuotedIdent(c, n) + 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: - if ident.id notin ctx and withinMixin notin flags: - localError(n.info, errUndeclaredIdentifier, ident.s) + 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: + elif s.isMixedIn: result = symChoice(c, n, s, scForceOpen) else: - result = semGenericStmtSymbol(c, n, s) + result = semGenericStmtSymbol(c, n, s, ctx, flags, amb) # else: leave as nkIdent - -proc semGenericStmt(c: PContext, n: PNode, - flags: TSemGenericFlags, ctx: var TIntSet): PNode = + +proc newDot(n, b: PNode): PNode = + result = newNodeI(nkDotExpr, n.info) + result.add(n[0]) + result.add(b) + +proc fuzzyLookup(c: PContext, n: PNode, flags: TSemGenericFlags, + 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: + isMacro = s.kind in {skTemplate, skMacro} + result = semGenericStmtSymbol(c, n, s, ctx, flags, c.isAmbiguous) + else: + n[0] = semGenericStmt(c, n[0], flags, ctx) + result = n + let n = n[1] + let ident = considerQuotedIdent(c, n) + # could be type conversion if like a.T and not a.T() + let symKinds = if inCall: routineKinds else: routineKinds+{skType} + var candidates = searchInScopesFilterBy(c, ident, symKinds) + if candidates.len > 0: + let s = candidates[0] # XXX take into account the other candidates! + isMacro = s.kind in {skTemplate, skMacro} + if withinBind in flags or s.id in ctx.toBind: + 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: + 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, n.info, s, kind) + onDef(n.info, s) + +proc addTempDeclToIdents(c: PContext; n: PNode; kind: TSymKind; inCall: bool) = + case n.kind + of nkIdent: + if inCall: + addTempDecl(c, n, kind) + of nkCallKinds: + for s in n: + addTempDeclToIdents(c, s, kind, true) + else: + for s in n: + addTempDeclToIdents(c, s, kind, inCall) + +proc semGenericStmt(c: PContext, n: PNode, + flags: TSemGenericFlags, ctx: var GenericCtx): PNode = result = n - if gCmd == cmdIdeTools: suggestStmt(c, n) + + when defined(nimsuggest): + if withinTypeDesc in flags: inc c.inTypeContext + + #if conf.cmd == cmdIdeTools: suggestStmt(c, n) + semIdeForTemplateOrGenericCheck(c.config, n, ctx.cursorInBody) + case n.kind of nkIdent, nkAccQuoted: - result = Lookup(c, n, flags, ctx) + 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) + #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... - of nkEmpty, nkSym..nkNilLit: + var dummy: bool = false + result = fuzzyLookup(c, n, flags, ctx, dummy) + of nkSym: + let a = n.sym + let b = getGenSym(c, a) + if b != a: n.sym = b + of nkEmpty, succ(nkSym)..nkNilLit, nkComesFrom: # see tests/compile/tgensymgeneric.nim: # We need to open the gensym'ed symbol again so that the instantiation # creates a fresh copy; but this is wrong the very first reason for gensym @@ -110,212 +294,366 @@ proc semGenericStmt(c: PContext, n: PNode, # not work. Copying the symbol does not work either because we're already # the owner of the symbol! What we need to do is to copy the symbol # in the generic instantiation process... - nil + 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) - of nkCall, nkHiddenCallConv, nkInfix, nkPrefix, nkCommand, nkCallStrLit: + 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) - let fn = n.sons[0] - var s = qualifiedLookup(c, fn, {}) - if s == nil and withinMixin notin flags and - fn.kind in {nkIdent, nkAccQuoted} and considerAcc(fn).id notin ctx: - localError(n.info, errUndeclaredIdentifier, fn.renderTree) - - var first = 0 - var isDefinedMagic = false - if s != nil: + checkMinSonsLen(n, 1, c.config) + let fn = n[0] + c.isAmbiguous = false + var s = qualifiedLookUp(c, fn, {}) + let ambig = c.isAmbiguous + if s == nil and + {withinMixin, withinConcept}*flags == {} and + fn.kind in {nkIdent, nkAccQuoted} and + considerQuotedIdent(c, fn).id notin ctx.toMixin: + errorUndeclaredIdentifier(c, n.info, fn.renderTree) + + var first = int ord(withinConcept in flags) + var mixinContext = false + if s != nil: incl(s.flags, sfUsed) - isDefinedMagic = s.magic in {mDefined, mDefinedInScope, mCompiles} - let scOption = if s.name.id in ctx: 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): - result = semMacroExpr(c, n, n, s, false) + 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] = symChoice(c, n.sons[0], s, scOption) - result = n - of skTemplate: - if macroToExpand(s): - let n = fixImmediateParams(n) - result = semTemplateExpr(c, n, s, false) - else: - n.sons[0] = symChoice(c, n.sons[0], s, scOption) + n[0] = sc result = n # BUGFIX: we must not return here, we need to do first phase of - # symbol lookup ... - of skUnknown, skParam: + # symbol lookup. Also since templates and macros can do scope injections + # we need to put the ``c`` in ``t(c)`` in a mixin context to prevent + # the famous "undeclared identifier: it" bug: + mixinContext = true + of skUnknown, skParam: # Leave it as an identifier. - of skProc, skMethod, skIterator, skConverter: - result.sons[0] = symChoice(c, n.sons[0], s, scOption) + discard + of skProc, skFunc, skMethod, skIterator, skConverter, skModule: + 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, n.sons[0].info) + result[0] = newSymNodeTypeDesc(s, c.idgen, fn.info) + onUse(fn.info, s) first = 1 - of skType: + of skType: # bad hack for generics: - if (s.typ != nil) and (s.typ.kind != tyGenericParam): - result.sons[0] = newSymNodeTypeDesc(s, n.sons[0].info) + if (s.typ != nil) and (s.typ.kind != tyGenericParam): + 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, n.sons[0].info) + result[0] = newSymNode(s, fn.info) + onUse(fn.info, s) first = 1 - # Consider 'when defined(globalsSlot): ThreadVarSetValue(globalsSlot, ...)' - # in threads.nim: the subtle preprocessing here binds 'globalsSlot' which + elif fn.kind == nkDotExpr: + 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 isDefinedMagic: flags+{withinMixin} else: flags - for i in countup(first, sonsLen(result) - 1): - result.sons[i] = semGenericStmt(c, result.sons[i], flags, ctx) - of nkIfStmt: - for i in countup(0, sonsLen(n)-1): - n.sons[i] = semGenericStmtScope(c, n.sons[i], flags, ctx) + let flags = if mixinContext: flags+{withinMixin} else: flags + 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]) + 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]) + result = semGenericStmt(c, result, flags, ctx) + of nkAsgn, nkFastAsgn, nkSinkAsgn: + checkSonsLen(n, 2, c.config) + 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]) + 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]) + result.add(b) + result = semGenericStmt(c, result, flags, ctx) + else: + for i in 0..<n.len: + result[i] = semGenericStmt(c, n[i], flags, ctx) + of nkIfStmt: + 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) - of nkWhileStmt: + 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: + 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] - checkMinSonsLen(a, 1) - 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) + n[0] = semGenericStmt(c, n[0], flags, ctx) + for i in 1..<n.len: + var a = n[i] + checkMinSonsLen(a, 1, c.config) + 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) + of nkForStmt, nkParForStmt: + openScope(c) + 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 - 2] = semGenericStmt(c, n.sons[L-2], flags, ctx) - for i in countup(0, L - 3): - addPrelimDecl(c, newSymS(skUnknown, n.sons[i], c)) - n.sons[L - 1] = semGenericStmt(c, n.sons[L-1], flags, ctx) + n[^1] = semGenericStmt(c, n[^1], flags, ctx) closeScope(c) - of nkBlockStmt, nkBlockExpr, nkBlockType: - checkSonsLen(n, 2) + closeScope(c) + of nkBlockStmt, nkBlockExpr, nkBlockType: + checkSonsLen(n, 2, c.config) openScope(c) - if n.sons[0].kind != nkEmpty: - addPrelimDecl(c, newSymS(skUnknown, n.sons[0], c)) - 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: - checkMinSonsLen(n, 2) - n.sons[0] = semGenericStmtScope(c, n.sons[0], flags, ctx) - for i in countup(1, sonsLen(n)-1): - var a = n.sons[i] - checkMinSonsLen(a, 1) - var L = sonsLen(a) - for j in countup(0, L-2): - a.sons[j] = semGenericStmt(c, a.sons[j], flags+{withinTypeDesc}, ctx) - a.sons[L-1] = semGenericStmtScope(c, a.sons[L-1], flags, ctx) - 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) - checkMinSonsLen(a, 3) - 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): - addPrelimDecl(c, newSymS(skUnknown, getIdentNode(a.sons[j]), c)) - of nkGenericParams: - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if (a.kind != nkIdentDefs): IllFormedAst(a) - checkMinSonsLen(a, 3) - var L = sonsLen(a) - a.sons[L-2] = semGenericStmt(c, a.sons[L-2], flags+{withinTypeDesc}, - ctx) - # do not perform symbol lookup for default expressions - for j in countup(0, L-3): - addPrelimDecl(c, newSymS(skUnknown, getIdentNode(a.sons[j]), c)) - 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) - checkSonsLen(a, 3) - addPrelimDecl(c, newSymS(skUnknown, getIdentNode(a.sons[0]), c)) - a.sons[1] = semGenericStmt(c, a.sons[1], flags+{withinTypeDesc}, ctx) - a.sons[2] = semGenericStmt(c, a.sons[2], flags, ctx) - of nkTypeSection: - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if (a.kind != nkTypeDef): IllFormedAst(a) - checkSonsLen(a, 3) - addPrelimDecl(c, newSymS(skUnknown, getIdentNode(a.sons[0]), c)) - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if (a.kind != nkTypeDef): IllFormedAst(a) - checkSonsLen(a, 3) - if a.sons[1].kind != nkEmpty: + of nkTryStmt, nkHiddenTryStmt: + checkMinSonsLen(n, 2, c.config) + n[0] = semGenericStmtScope(c, n[0], flags, ctx) + for i in 1..<n.len: + var a = n[i] + checkMinSonsLen(a, 1, c.config) + openScope(c) + 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[j] = semGenericStmt(c, a[j], flags+{withinTypeDesc}, ctx) + a[^1] = semGenericStmtScope(c, a[^1], flags, ctx) + closeScope(c) + + 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 0..<n.len: + var a = n[i] + if (a.kind != nkIdentDefs): illFormedAst(a, c.config) + checkMinSonsLen(a, 3, c.config) + a[^2] = semGenericStmt(c, a[^2], flags+{withinTypeDesc}, ctx) + # do not perform symbol lookup for default expressions + for j in 0..<a.len-2: + addTempDecl(c, getIdentNode(c, a[j]), skType) + of nkTypeSection: + 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[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[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) - 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] - else: illFormedAst(n) - addDecl(c, newSymS(skUnknown, getIdentNode(a.sons[i]), c)) - of nkObjectTy, nkTupleTy: - nil - of nkFormalParams: - checkMinSonsLen(n, 1) - 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] - if (a.kind != nkIdentDefs): IllFormedAst(a) - checkMinSonsLen(a, 3) - 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): - addPrelimDecl(c, newSymS(skUnknown, getIdentNode(a.sons[j]), c)) - of nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef, nkTemplateDef, - nkIteratorDef, nkLambdaKinds: - checkSonsLen(n, bodyPos + 1) - if n.kind notin nkLambdaKinds: - addPrelimDecl(c, newSymS(skUnknown, getIdentNode(n.sons[0]), c)) + else: + a[2] = semGenericStmt(c, a[2], flags+{withinTypeDesc}, ctx) + of nkEnumTy: + 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 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) + for i in 1..<n.len: + var a = n[i] + if (a.kind != nkIdentDefs): illFormedAst(a, c.config) + checkMinSonsLen(a, 3, c.config) + a[^2] = semGenericStmt(c, a[^2], flags+{withinTypeDesc}, ctx) + a[^1] = semGenericStmt(c, a[^1], flags, ctx) + for j in 0..<a.len-2: + addTempDecl(c, getIdentNode(c, a[j]), 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[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("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: body = n.sons[namePos].sym.getBody - else: body = n.sons[bodyPos] - n.sons[bodyPos] = semGenericStmtScope(c, body, flags, ctx) + if n[namePos].kind == nkSym: + let s = n[namePos].sym + if sfGenSym in s.flags and s.ast == nil: + body = n[bodyPos] + else: + 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: nil - of nkExprColonExpr: - checkMinSonsLen(n, 2) - result.sons[1] = semGenericStmt(c, n.sons[1], flags, ctx) + of nkPragma, nkPragmaExpr: discard + of nkExprColonExpr, nkExprEqExpr: + checkMinSonsLen(n, 2, c.config) + result[1] = semGenericStmt(c, n[1], flags, ctx) + of nkObjConstr: + for i in 0..<n.len: + result[i] = semGenericStmt(c, n[i], flags, ctx) + if result[0].kind == nkSym: + let fmoduleId = getModule(result[0].sym).id + var isVisable = false + for module in c.friendModules: + if module.id == fmoduleId: + isVisable = true + break + if isVisable: + for i in 1..<result.len: + if result[i].kind == nkExprColonExpr: + result[i][1].flags.incl nfSkipFieldChecking else: - for i in 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( + toMixin: initIntSet(), + toBind: initIntSet() + ) + result = semGenericStmt(c, n, {}, ctx) + semIdeForTemplateOrGeneric(c, result, ctx.cursorInBody) + +proc semConceptBody(c: PContext, n: PNode): PNode = + 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 9dc99d173..1bc6d31a2 100644 --- a/compiler/seminst.nim +++ b/compiler/seminst.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -10,184 +10,463 @@ # This module implements the instantiation of generic procs. # included from sem.nim -proc instantiateGenericParamList(c: PContext, n: PNode, pt: TIdTable, - entry: var TInstantiation) = - if n.kind != nkGenericParams: - InternalError(n.info, "instantiateGenericParamList; no generic params") - newSeq(entry.concreteTypes, n.len) - for i in countup(0, n.len - 1): - var a = n.sons[i] - if a.kind != nkSym: - InternalError(a.info, "instantiateGenericParamList; no symbol") +proc addObjFieldsToLocalScope(c: PContext; n: PNode) = + template rec(n) = addObjFieldsToLocalScope(c, n) + case n.kind + of nkRecList: + for i in 0..<n.len: + rec n[i] + of nkRecCase: + 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 + if f.kind == skField and fieldVisible(c, f): + c.currentScope.symbols.strTableIncl(f, onConflictKeepOld=true) + incl(f.flags, sfUsed) + # it is not an error to shadow fields via parameters + else: discard + +proc pushProcCon*(c: PContext; owner: PSym) = + c.p = PProcCon(owner: owner, next: c.p) + +const + errCannotInstantiateX = "cannot instantiate: '$1'" + +iterator instantiateGenericParamList(c: PContext, n: PNode, pt: TypeMapping): PSym = + internalAssert c.config, n.kind == nkGenericParams + for a in n.items: + internalAssert c.config, a.kind == nkSym var q = a.sym - if q.typ.kind notin {tyTypeDesc, tyGenericParam, tyTypeClass, tyExpr}: continue - var s = newSym(skType, q.name, getCurrOwner(), 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(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: - InternalError(a.info, "instantiateGenericParamList: " & q.name.s) - elif t.kind == tyGenericInvokation: - #t = instGenericContainer(c, a, t) - t = generateTypeInstance(c, pt, a, t) - #t = ReplaceTypeVarsT(cl, t) - t.flags.incl tfInstantiated - s.typ = t - addDecl(c, s) - entry.concreteTypes[i] = t + 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 = {TypeDescExactMatch}): return + flags = {ExactTypeDescValues, + ExactGcSafety, + PickyCAliases}): return result = true + else: + result = false -proc GenericCacheGet(genericSym: Psym, entry: TInstantiation): PSym = - if genericSym.procInstCache != nil: - for inst in genericSym.procInstCache: - if sameInstantiation(entry, inst[]): - return inst.sym +proc genericCacheGet(g: ModuleGraph; genericSym: PSym, entry: TInstantiation; + id: CompilesId): PSym = + result = nil + for inst in procInstCacheItems(g, genericSym): + if (inst.compilesId == 0 or inst.compilesId == id) and sameInstantiation(entry, inst[]): + return inst.sym -proc removeDefaultParamValues(n: PNode) = - # we remove default params, because they cannot be instantiated properly - # and they are not needed anyway for instantiation (each param is already - # provided). - when false: - for i in countup(1, sonsLen(n)-1): - var a = n.sons[i] - if a.kind != nkIdentDefs: IllFormedAst(a) - var L = a.len - if a.sons[L-1].kind != nkEmpty and a.sons[L-2].kind != nkEmpty: - # ``param: typ = defaultVal``. - # We don't need defaultVal for semantic checking and it's wrong for - # ``cmp: proc (a, b: T): int = cmp``. Hm, for ``cmp = cmp`` that is - # not possible... XXX We don't solve this issue here. - a.sons[L-1] = ast.emptyNode - -proc freshGenSyms(n: PNode, owner: PSym, symMap: var TIdTable) = +when false: + proc `$`(x: PSym): string = + result = x.name.s & " " & " id " & $x.id + +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: - var x = PSym(IdTableGet(symMap, n.sym)) - if x == nil: - x = copySym(n.sym, false) + #if n.kind == nkSym and sfGenSym in n.sym.flags: + # if n.sym.owner != orig: + # echo "symbol ", n.sym.name.s, " orig ", orig, " owner ", n.sym.owner + 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 = idTableGet(symMap, s) + if x != nil: + n.sym = x + elif s.owner == nil or s.owner.kind == skPackage: + #echo "copied this ", s.name.s + x = copySym(s, c.idgen) x.owner = owner - IdTablePut(symMap, n.sym, x) - n.sym = x + idTablePut(symMap, s, x) + n.sym = x else: - for i in 0 .. <safeLen(n): freshGenSyms(n.sons[i], owner, symMap) + for i in 0..<n.safeLen: freshGenSyms(c, n[i], owner, orig, symMap) -proc instantiateBody(c: PContext, n: PNode, result: PSym) = - if n.sons[bodyPos].kind != nkEmpty: +proc addParamOrResult(c: PContext, param: PSym, kind: TSymKind) + +proc instantiateBody(c: PContext, n, params: PNode, result, orig: PSym) = + if n[bodyPos].kind != nkEmpty: + let procParams = result.typ.n + 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: - addDecl(c, result) - pushProcCon(c, result) - maybeAddResult(c, result, n) - var b = n.sons[bodyPos] - var symMap: TIdTable - InitIdTable symMap - freshGenSyms(b, result, symMap) - b = semProcBody(c, b) - b = hloBody(c, b) - n.sons[bodyPos] = transformBody(c.module, b, result) - #echo "code instantiated ", result.name.s + var b = n[bodyPos] + var symMap = initSymMapping() + if params != nil: + for i in 1..<params.len: + let param = params[i].sym + if sfGenSym in param.flags: + idTablePut(symMap, params[i].sym, result.typ.n[param.position+1].sym) + freshGenSyms(c, b, result, orig, symMap) + + 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) - popProcCon(c) + 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 - pushInfoContext(oldPrc.info) + pushProcCon(c, oldPrc) + pushOwner(c, oldPrc) + pushInfoContext(c.config, oldPrc.info) openScope(c) var n = oldPrc.ast - n.sons[bodyPos] = copyTree(s.getBody) - if n.sons[paramsPos].kind != nkEmpty: - addParams(c, oldPrc.typ.n, oldPrc.kind) - instantiateBody(c, n, oldPrc) + n[bodyPos] = copyTree(getBody(c.graph, s)) + instantiateBody(c, n, oldPrc.typ.n, oldPrc, s) closeScope(c) - popInfoContext() + popInfoContext(c.config) + popOwner(c) + popProcCon(c) + +proc sideEffectsCheck(c: PContext, s: PSym) = + when false: + if {sfNoSideEffect, sfSideEffect} * s.flags == + {sfNoSideEffect, sfSideEffect}: + localError(s.info, errXhasSideEffects, s.name.s) + +proc instGenericContainer(c: PContext, info: TLineInfo, header: PType, + allowMetaTypes = false): PType = + internalAssert c.config, header.kind == tyGenericInvocation + + var cl: TReplTypeVars = TReplTypeVars(symMap: initSymMapping(), + localCache: initTypeMapping(), typeMap: LayeredIdTable(), + info: info, c: c, 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. + # XXX: This looks quite similar to the code in matchUserTypeClass, + # perhaps the code can be extracted in a shared function. + openScope(c) + let genericTyp = header.base + for i, genParam in genericBodyParams(genericTyp): + var param: PSym + + template paramSym(kind): untyped = + newSym(kind, genParam.sym.name, c.idgen, genericTyp.sym, genParam.sym.info) + + if genParam.kind == tyStatic: + param = paramSym skConst + param.ast = header[i+1].n + param.typ = header[i+1] + else: + param = paramSym skType + param.typ = makeTypeDesc(c, header[i+1]) + + # this scope was not created by the user, + # unused params shouldn't be reported. + param.flags.incl sfUsed + addDecl(c, param) + + result = replaceTypeVarsT(cl, header) + closeScope(c) + +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): 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: 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 + # will need to use openScope, addDecl, etc. + #addDecl(c, prc) + pushInfoContext(c.config, info) + var typeMap = initLayeredTypeMap(pt) + var cl = initTypeVars(c, typeMap, info, nil) + var result = instCopyType(cl, prc.typ) + let originalParams = result.n + result.n = originalParams.shallowCopy + for i, resulti in paramTypes(result): + # twrong_field_caching requires these 'resetIdTable' calls: + if i > FirstParamAt: + resetIdTable(cl.symMap) + resetIdTable(cl.localCache) + + # take a note of the original type. If't a free type or static parameter + # we'll need to keep it unbound for the `fitNode` operation below... + var typeToFit = 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 + 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) + 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]) -proc sideEffectsCheck(c: PContext, s: PSym) = - if {sfNoSideEffect, sfSideEffect} * s.flags == - {sfNoSideEffect, sfSideEffect}: - LocalError(s.info, errXhasSideEffects, s.name.s) - elif sfThread in s.flags and semthreads.needsGlobalAnalysis() and - s.ast.sons[genericParamsPos].kind == nkEmpty: - c.threadEntries.add(s) + eraseVoidParams(result) + skipIntLiteralParams(result, c.idgen) -proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, + prc.typ = result + popInfoContext(c.config) + +proc instantiateOnlyProcType(c: PContext, pt: TypeMapping, prc: PSym, info: TLineInfo): PType = + # instantiates only the type of a given proc symbol + # used by sigmatch for explicit generics + # wouldn't be needed if sigmatch could handle complex cases, + # examples are in texplicitgenerics + # might be buggy, see rest of generateInstance if problems occur + let fakeSym = copySym(prc, c.idgen) + incl(fakeSym.flags, sfFromGeneric) + fakeSym.instantiatedFrom = prc + openScope(c) + for s in instantiateGenericParamList(c, prc.ast[genericParamsPos], pt): + addDecl(c, s) + instantiateProcType(c, pt, fakeSym, info) + closeScope(c) + result = fakeSym.typ + +proc fillMixinScope(c: PContext) = + var p = c.p + while p != nil: + 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 + ## parameters to their concrete types within the generic instance. # no need to instantiate generic templates/macros: - if fn.kind in {skTemplate, skMacro}: return fn - + internalAssert c.config, fn.kind notin {skMacro, skTemplate} # generates an instantiated proc - if c.InstCounter > 1000: InternalError(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: - var oldFriend = c.friendModule - c.friendModule = getModule(fn) - result = copySym(fn, false) + 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, c.idgen) incl(result.flags, sfFromGeneric) - # keep the owner if it's an inner proc (for proper closure transformations): - if fn.owner.kind == skModule: - result.owner = getCurrOwner().owner + 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(result) + pushOwner(c, result) + + # mixin scope: + openScope(c) + fillMixinScope(c) + openScope(c) - if n.sons[genericParamsPos].kind == nkEmpty: - InternalError(n.info, "generateInstance") - n.sons[namePos] = newSymNode(result) - pushInfoContext(info) + 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 - instantiateGenericParamList(c, n.sons[genericParamsPos], pt, entry[]) - n.sons[genericParamsPos] = ast.emptyNode - # semantic checking for the parameters: - if n.sons[paramsPos].kind != nkEmpty: - removeDefaultParamValues(n.sons[ParamsPos]) - semParamList(c, n.sons[ParamsPos], nil, result) - else: - result.typ = newTypeS(tyProc, c) - rawAddSon(result.typ, nil) - result.typ.callConv = fn.typ.callConv - if result.kind == skIterator: result.typ.flags.incl(tfIterator) - var oldPrc = GenericCacheGet(fn, entry[]) + # 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.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 + c.matchedConcept = nil + pushProcCon(c, result) + instantiateProcType(c, pt, result, info) + for _, param in paramTypes(result.typ): + entry.concreteTypes[i] = param + inc i + #echo "INSTAN ", fn.name.s, " ", typeToString(result.typ), " ", entry.concreteTypes.len + if tfTriggersCompileTime in result.typ.flags: + incl(result.flags, sfCompileTime) + n[genericParamsPos] = c.graph.emptyNode + var oldPrc = genericCacheGet(c.graph, fn, entry[], c.compilesContextId) if oldPrc == nil: - fn.procInstCache.safeAdd(entry) + # 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: + entry.compilesId = c.compilesContextId + 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 fn.kind != skTemplate: - instantiateBody(c, n, result) - sideEffectsCheck(c, result) - ParamsTypeCheck(c, result.typ) + # 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 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 - popInfoContext() + popProcCon(c) + popInfoContext(c.config) closeScope(c) # close scope for parameters - popOwner() - c.friendModule = oldFriend - dec(c.InstCounter) + closeScope(c) # close scope for 'mixin' declarations + popOwner(c) + c.currentScope = oldScope + discard c.friendModules.pop() + c.matchedConcept = oldMatchedConcept if result.kind == skMethod: finishMethod(c, result) - -proc instGenericContainer(c: PContext, n: PNode, header: PType): PType = - var cl: TReplTypeVars - InitIdTable(cl.symMap) - InitIdTable(cl.typeMap) - cl.info = n.info - cl.c = c - result = ReplaceTypeVarsT(cl, header) + # inform IC of the generic + #addGeneric(c.ic, result, entry.concreteTypes) diff --git a/compiler/semmacrosanity.nim b/compiler/semmacrosanity.nim new file mode 100644 index 000000000..727f36470 --- /dev/null +++ b/compiler/semmacrosanity.nim @@ -0,0 +1,126 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Implements type sanity checking for ASTs resulting from macros. Lots of +## room for improvement here. + +import ast, msgs, types, options + +proc ithField(n: PNode, field: var int): PSym = + result = nil + case n.kind + of nkRecList: + for i in 0..<n.len: + result = ithField(n[i], field) + if result != nil: return + of nkRecCase: + if n[0].kind != nkSym: return + result = ithField(n[0], field) + if result != nil: return + for i in 1..<n.len: + case n[i].kind + of nkOfBranch, nkElse: + result = ithField(lastSon(n[i]), field) + if result != nil: return + else: discard + of nkSym: + if field == 0: result = n.sym + 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' + # to not to skip tyGenericInst + case n.kind + of nkObjConstr: + let x = t.skipTypes(abstractPtrs) + n.typ = t + n[0].typ = t + for i in 1..<n.len: + var j = i-1 + let field = x.ithField(j) + if field.isNil: + globalError conf, n.info, "invalid field at index " & $i + else: + 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.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: + if x.kind in {tyArray, tySequence, tyOpenArray}: + n.typ = t + for m in n: annotateType(m, x.elemType, conf) + else: + globalError(conf, n.info, "[] must have some form of array type") + of nkCurly: + if x.kind in {tySet}: + n.typ = t + for m in n: annotateType(m, x.elemType, conf) + else: + globalError(conf, n.info, "{} must have the set type") + of nkFloatLit..nkFloat128Lit: + if x.kind in {tyFloat..tyFloat128}: + n.typ = t + else: + globalError(conf, n.info, "float literal must have some float type") + of nkCharLit..nkUInt64Lit: + if x.kind in {tyInt..tyUInt64, tyBool, tyChar, tyEnum}: + n.typ = t + else: + globalError(conf, n.info, "integer literal must have some int type") + of nkStrLit..nkTripleStrLit: + if x.kind in {tyString, tyCstring}: + n.typ = t + else: + globalError(conf, n.info, "string literal must be of some string type") + of nkNilLit: + if x.kind in NilableTypes+{tyString, tySequence}: + n.typ = t + else: + globalError(conf, n.info, "nil literal must be of some pointer type") + else: discard diff --git a/compiler/semmagic.nim b/compiler/semmagic.nim index 41c379133..a12e933e7 100644 --- a/compiler/semmagic.nim +++ b/compiler/semmagic.nim @@ -1,7 +1,7 @@ # # -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -10,111 +10,700 @@ # This include file implements the semantic checking for magics. # included from sem.nim +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) 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) + 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 + SemAsgnMode = enum asgnNormal, noOverloadedSubscript, noOverloadedAsgn + +proc semAsgn(c: PContext, n: PNode; mode=asgnNormal): PNode +proc semSubscript(c: PContext, n: PNode, flags: TExprFlags): PNode + +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[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 = 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].skipHiddenAddr) + for i in 2..<n.len-1: b.add(n[i]) + result = newNodeI(nkAsgn, n.info, 2) + result[0] = b + result[1] = n.lastSon + result = semAsgn(c, result, noOverloadedSubscript) + +proc semAsgnOpr(c: PContext; n: PNode; 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) - + 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(n.info, errIntLiteralExpected) + else: + result = 0 + localError(c.config, n.info, errIntLiteralExpected) proc semInstantiationInfo(c: PContext, n: PNode): PNode = - result = newNodeIT(nkPar, n.info, n.typ) - let idx = expectIntLit(c, n.sons[1]) - let useFullPaths = expectIntLit(c, n.sons[2]) - let info = getInfoContext(idx) - var filename = newNodeIT(nkStrLit, n.info, getSysType(tyString)) - filename.strVal = if useFullPaths != 0: info.toFullPath else: info.ToFilename - var line = newNodeIT(nkIntLit, n.info, getSysType(tyInt)) - line.intVal = ToLinenumber(info) - result.add(filename) - result.add(line) + result = newNodeIT(nkTupleConstr, n.info, n.typ) + 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) + var line = newNodeIT(nkIntLit, n.info, getSysType(c.graph, n.info, tyInt)) + line.intVal = toLinenumber(info) + var column = newNodeIT(nkIntLit, n.info, getSysType(c.graph, n.info, tyInt)) + column.intVal = toColumn(info) + # 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) + +const + # these are types that use the bracket syntax for instantiation + # they can be subjected to the type traits `genericHead` and + # `Uninstantiated` + tyUserDefinedGenerics* = {tyGenericInst, tyGenericInvocation, + tyUserTypeClassInst} + + tyMagicGenerics* = {tySet, tySequence, tyArray, tyOpenArray} + + tyGenericLike* = tyUserDefinedGenerics + + tyMagicGenerics + + {tyCompositeTypeClass} + +proc uninstantiate(t: PType): PType = + result = case t.kind + of tyMagicGenerics: t + of tyUserDefinedGenerics: t.base + 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] + internalAssert c.config, trait.kind == nkSym + var operand = operand.skipTypes(skippedTypes) + + template operand2: PType = + traitCall[2].typ.skipTypes({tyTypeDesc}) + + if operand.kind == tyGenericParam or (traitCall.len > 2 and operand2.kind == tyGenericParam): + return traitCall ## too early to evaluate + + let s = trait.sym.name.s + case s + of "or", "|": + return buildBinaryPredicate(tyOr, c, context, operand, operand2).toNode(traitCall.info) + of "and": + return buildBinaryPredicate(tyAnd, c, context, operand, operand2).toNode(traitCall.info) + of "not": + 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 = getSysType(c.graph, traitCall[1].info, tyString) + result.info = traitCall.info + of "arity": + result = newIntNode(nkIntLit, operand.len - ord(operand.kind==tyProc)) + result.typ = newType(tyInt, c.idgen, context) + result.info = traitCall.info + of "genericHead": + 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(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: " & s) + result = newNodeI(nkEmpty, traitCall.info) proc semTypeTraits(c: PContext, n: PNode): PNode = - checkMinSonsLen(n, 2) - internalAssert n.sons[1].kind == nkSym - let typArg = n.sons[1].sym - if typArg.kind == skType or - (typArg.kind == skParam and typArg.typ.sonsLen > 0): + checkMinSonsLen(n, 2, c.config) + 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(n, GetCurrOwner()) + result = evalTypeTrait(c, n, t, getCurrOwner(c)) else: # a typedesc variable, pass unmodified to evals result = n proc semOrd(c: PContext, n: PNode): PNode = result = n - result.typ = makeRangeType(c, firstOrd(n.sons[1].typ), - lastOrd(n.sons[1].typ), n.info) + let parType = n[1].typ + if isOrdinalType(parType, allowEnumWithHoles=true): + discard + else: + 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]) - - let sl = semConstExpr(c, n.sons[1]) - if sl.kind notin {nkStrLit, nkRStrLit, nkTripleStrLit}: - LocalError(n.sons[1].info, errStringLiteralExpected) - return errorNode(c, n) - - let isMixin = semConstExpr(c, n.sons[2]) + result.add(n[0]) + + let sl = semConstExpr(c, n[1]) + if sl.kind notin {nkStrLit, nkRStrLit, nkTripleStrLit}: + return localErrorNode(c, n, n[1].info, errStringLiteralExpected) + + let isMixin = semConstExpr(c, n[2]) if isMixin.kind != nkIntLit or isMixin.intVal < 0 or isMixin.intVal > high(TSymChoiceRule).int: - LocalError(n.sons[2].info, errConstExprExpected) - return errorNode(c, n) - - let id = newIdentNode(getIdent(sl.strVal), n.info) - let s = QualifiedLookUp(c, id) + return localErrorNode(c, n, n[2].info, errConstExprExpected) + + let id = newIdentNode(getIdent(c.cache, sl.strVal), n.info) + let s = qualifiedLookUp(c, id, {checkUndeclared}) if s != nil: # we need to mark all symbols: var sc = symChoice(c, id, s, TSymChoiceRule(isMixin.intVal)) + if not (c.inStaticContext > 0 or getCurrOwner(c).isCompileTimeProc): + # inside regular code, bindSym resolves to the sym-choice + # nodes (see tinspectsymbol) + return sc result.add(sc) else: - LocalError(n.sons[1].info, errUndeclaredIdentifier, sl.strVal) - -proc semLocals(c: PContext, n: PNode): PNode = - var counter = 0 - var tupleType = newTypeS(tyTuple, c) - result = newNodeIT(nkPar, n.info, tupleType) - tupleType.n = newNodeI(nkRecList, n.info) - # for now we skip openarrays ... - for scope in walkScopes(c.currentScope): - if scope == c.topLevelScope: break - 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, tyExpr, tyStmt, tyEmpty}: - - var field = newSym(skField, it.name, getCurrOwner(), n.info) - field.typ = it.typ.skipTypes({tyGenericInst, tyVar}) - field.position = counter - inc(counter) - - addSon(tupleType.n, newSymNode(field)) - addSonSkipIntLit(tupleType, field.typ) - - var a = newSymNode(it, result.info) - if it.typ.skipTypes({tyGenericInst}).kind == tyVar: a = newDeref(a) - result.add(a) + 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 magicsAfterOverloadResolution(c: PContext, n: PNode, - flags: TExprFlags): PNode = + +proc semOf(c: PContext, n: PNode): PNode = + 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") + elif b.kind != tyObject or a.kind != tyObject: + localError(c.config, n.info, "'of' takes object types") + else: + let diff = inheritanceDiff(a, b) + # | returns: 0 iff `a` == `b` + # | returns: -x iff `a` is the x'th direct superclass of `b` + # | returns: +x iff `a` is the x'th direct subclass of `b` + # | returns: `maxint` iff `a` and `b` are not compatible at all + if diff <= 0: + # optimize to true: + message(c.config, n.info, hintConditionAlwaysTrue, renderTree(n)) + result = newIntNode(nkIntLit, 1) + result.info = n.info + result.typ = getSysType(c.graph, n.info, tyBool) + return result + elif diff == high(int): + if commonSuperclass(a, b) == nil: + localError(c.config, n.info, "'$1' cannot be of this subtype" % typeToString(a)) + 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; 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[1]) + of mTypeOf: + 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, nkAsgn) + elif n[0].sym.name.s == "=sink": + result = semAsgnOpr(c, n, nkSinkAsgn) + else: + result = semShallowCopy(c, n, flags) of mIsPartOf: result = semIsPartOf(c, n, flags) of mTypeTrait: result = semTypeTraits(c, n) of mAstToStr: - result = newStrNodeT(renderTree(n[1], {renderNoComments}), n) - result.typ = getSysType(tyString) + result = newStrNodeT(renderTree(n[1], {renderNoComments}), n, c.graph) + result.typ = getSysType(c.graph, n.info, tyString) of mInstantiationInfo: result = semInstantiationInfo(c, n) of mOrd: result = semOrd(c, n) + of mOf: result = semOf(c, n) + 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 mLocals: result = semLocals(c, n) - else: result = 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 mPlugin: + let plugin = getPlugin(c.cache, n[0].sym) + if plugin.isNil: + localError(c.config, n.info, "cannot find plugin " & n[0].sym.name.s) + result = n + else: + result = plugin(c, n) + of mNew: + if n[0].sym.name.s == "unsafeNew": # special case for unsafeNew + result = n + else: + result = addDefaultFieldForNew(c, n) + of mNewFinalize: + 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 new file mode 100644 index 000000000..048053115 --- /dev/null +++ b/compiler/semobjconstr.nim @@ -0,0 +1,536 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Nim Contributors +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## This module implements Nim's object construction rules. + +# included from sem.nim + +from std/sugar import dup + +type + 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: + existing = newStatus + of initPartial: + if existing in {initUnknown, initFull, initNone}: + existing = initPartial + of initNone: + if existing == initUnknown: + existing = initNone + elif existing == initFull: + existing = initPartial + of initFull: + if existing == initUnknown: + existing = initFull + elif existing == initNone: + existing = initPartial + of initUnknown: + discard + +proc invalidObjConstr(c: PContext, n: PNode) = + if n.kind == nkInfix and n[0].kind == nkIdent and n[0].ident.s[0] == ':': + localError(c.config, n.info, "incorrect object construction syntax; use a space after the colon") + else: + localError(c.config, n.info, "incorrect object construction syntax") + +proc locateFieldInInitExpr(c: PContext, field: PSym, initExpr: PNode): PNode = + # Returns the assignment nkExprColonExpr node or nil + result = nil + let fieldId = field.name.id + for i in 1..<initExpr.len: + let assignment = initExpr[i] + if assignment.kind != nkExprColonExpr: + invalidObjConstr(c, assignment) + elif fieldId == considerQuotedIdent(c, assignment[0]).id: + return assignment + +proc semConstrField(c: PContext, flags: TExprFlags, + field: PSym, initExpr: PNode): PNode = + let assignment = locateFieldInInitExpr(c, field, initExpr) + if assignment != nil: + if nfSem in assignment.flags: return assignment[1] + 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, field.typ) + if initValue != nil: + initValue = fitNodeConsiderViewType(c, field.typ, initValue, assignment.info) + initValue.flags.incl nfSkipFieldChecking + assignment[0] = newSymNode(field) + assignment[1] = initValue + assignment.flags.incl nfSem + 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 - int(endsWithElse): + if caseExpr[i].caseBranchMatchesExpr(matched): + return caseExpr[i] + + if endsWithElse: + result = caseExpr[^1] + else: + result = nil + +iterator directFieldsInRecList(recList: PNode): PNode = + # XXX: We can remove this case by making all nkOfBranch nodes + # regular. Currently, they try to avoid using nkRecList if they + # include only a single field + if recList.kind == nkSym: + yield recList + else: + doAssert recList.kind == nkRecList + for field in recList: + 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): + if locateFieldInInitExpr(c, field.sym, initExpr) != nil: + if result.len != 0: result.add ", " + result.add field.sym.name.s.quoteStr + +proc locateFieldInDefaults(sym: PSym, defaults: seq[PNode]): bool = + result = false + for d in defaults: + if sym.id == d[0].sym.id: + return true + +proc collectMissingFields(c: PContext, fieldsRecList: PNode, + constrCtx: var ObjConstrContext, 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 + +proc collectMissingCaseFields(c: PContext, branchNode: PNode, + constrCtx: var ObjConstrContext, defaults: seq[PNode]): seq[PSym] = + if branchNode != nil: + let fieldsRecList = branchNode[^1] + result = collectMissingFields(c, fieldsRecList, constrCtx, defaults) + else: + result = @[] + +proc collectOrAddMissingCaseFields(c: PContext, branchNode: PNode, + constrCtx: var ObjConstrContext, defaults: var seq[PNode]) = + let res = collectMissingCaseFields(c, branchNode, constrCtx, defaults) + for sym in res: + let asgnType = newType(tyTypeDesc, c.idgen, sym.typ.owner) + let recTyp = sym.typ.skipTypes(defaultFieldsSkipTypes) + rawAddSon(asgnType, recTyp) + let asgnExpr = newTree(nkCall, + newSymNode(getSysMagic(c.graph, constrCtx.initExpr.info, "zeroDefault", mZeroDefault)), + newNodeIT(nkType, constrCtx.initExpr.info, asgnType) + ) + asgnExpr.flags.incl nfSkipFieldChecking + asgnExpr.typ = recTyp + defaults.add newTree(nkExprColonExpr, newSymNode(sym), asgnExpr) + +proc collectBranchFields(c: PContext, n: PNode, discriminatorVal: PNode, + constrCtx: var ObjConstrContext, flags: TExprFlags) = + # All bets are off. If any of the branches has a mandatory + # fields we must produce an error: + for i in 1..<n.len: + let branchNode = n[i] + if branchNode != nil: + let oldCheckDefault = constrCtx.checkDefault + constrCtx.checkDefault = true + let (_, defaults) = semConstructFields(c, branchNode[^1], constrCtx, flags) + constrCtx.checkDefault = oldCheckDefault + if len(defaults) > 0: + localError(c.config, discriminatorVal.info, "branch initialization " & + "with a runtime discriminator is not supported " & + "for a branch whose fields have default values.") + discard collectMissingCaseFields(c, n[i], constrCtx, @[]) + +proc semConstructFields(c: PContext, n: PNode, constrCtx: var ObjConstrContext, + flags: TExprFlags): tuple[status: InitStatus, defaults: seq[PNode]] = + result = (initUnknown, @[]) + case n.kind + of nkRecList: + for field in n: + let (subSt, subDf) = semConstructFields(c, field, constrCtx, flags) + result.status.mergeInitStatus subSt + result.defaults.add subDf + of nkRecCase: + template fieldsPresentInBranch(branchIdx: int): string = + let branch = n[branchIdx] + let fields = branch[^1] + fieldsPresentInInitExpr(c, fields, constrCtx.initExpr) + + let discriminator = n[0] + internalAssert c.config, discriminator.kind == nkSym + var selectedBranch = -1 + + for i in 1..<n.len: + let innerRecords = n[i][^1] + let (status, _) = semConstructFields(c, innerRecords, constrCtx, flags) # todo + if status notin {initNone, initUnknown}: + result.status.mergeInitStatus status + if selectedBranch != -1: + let prevFields = fieldsPresentInBranch(selectedBranch) + let currentFields = fieldsPresentInBranch(i) + 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.status = initConflict + else: + selectedBranch = i + + if selectedBranch != -1: + 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, constrCtx.initExpr.info, + ("a case selecting discriminator '$1' with value '$2' " & + "appears in the object construction, but the field(s) $3 " & + "are in conflict with this value.") % + [discriminator.sym.name.s, discriminatorVal.renderTree, fields]) + + template valuesInConflictError(valsDiff) = + localError(c.config, discriminatorVal.info, ("possible values " & + "$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): + failedBranch = selectedBranch + else: + # With an else clause, check that all other branches don't match: + 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.status == initPartial: + collectOrAddMissingCaseFields(c, branchNode, constrCtx, result.defaults) + else: + result.status = initNone + let discriminatorVal = semConstrField(c, flags + {efPreferStatic}, + discriminator.sym, + constrCtx.initExpr) + if discriminatorVal == nil: + 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.status = initPartial + if discriminatorVal.kind == nkIntLit: + # When the discriminator is a compile-time value, we also know + # which branch will be selected: + let matchedBranch = n.pickCaseBranch discriminatorVal + if matchedBranch != nil: + let (_, defaults) = semConstructFields(c, matchedBranch[^1], constrCtx, flags) + result.defaults.add defaults + collectOrAddMissingCaseFields(c, matchedBranch, constrCtx, result.defaults) + else: + collectBranchFields(c, n, discriminatorVal, constrCtx, flags) + + of nkSym: + 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 semConstructTypeAux(c: PContext, + constrCtx: var ObjConstrContext, + flags: TExprFlags): tuple[status: InitStatus, defaults: seq[PNode]] = + result = (initUnknown, @[]) + var t = constrCtx.typ + while true: + let (status, defaults) = semConstructFields(c, t.n, constrCtx, flags) + result.status.mergeInitStatus status + result.defaults.add defaults + if status in {initPartial, initNone, initUnknown}: + 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; expectedType: PType = nil): PNode = + var t = semTypeNode(c, n[0], nil) + result = newNodeIT(nkObjConstr, n.info, t) + for i in 0..<n.len: + result.add n[i] + + if t == nil: + 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: + return localErrorNode(c, result, if t.kind != tyGenericBody: + "object constructor needs an object type".dup(addTypeNodeDeclaredLoc(c.config, t)) + else: "cannot instantiate: '" & + typeToString(t, preferDesc) & + "'; the object's generic parameters cannot be inferred and must be explicitly given" + ) + + # Check if the object is fully initialized by recursively testing each + # field (if this is a case object, initialized fields in two different + # branches will be reported as an error): + var constrCtx = initConstrContext(t, result) + let (initResult, defaults) = semConstructTypeAux(c, constrCtx, flags) + var hasError = false # needed to split error detect/report for better msgs + + # It's possible that the object was not fully initialized while + # specifying a .requiresInit. pragma: + if constrCtx.missingFields.len > 0: + hasError = true + localError(c.config, result.info, + "The $1 type requires the following fields to be initialized: $2." % + [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. + # We'll check for such fields here: + for i in 1..<result.len: + let field = result[i] + 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: + let prevId = considerQuotedIdent(c, result[j][0]) + if prevId.id == id.id: + localError(c.config, field.info, errFieldInitTwice % id.s) + hasError = true + break + # 2) No such field exists in the constructed type + 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 new file mode 100644 index 000000000..23a8e6362 --- /dev/null +++ b/compiler/semparallel.nim @@ -0,0 +1,504 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Semantic checking for 'parallel'. + +# - codegen needs to support mSlice (+) +# - lowerings must not perform unnecessary copies (+) +# - slices should become "nocopy" to openArray (+) +# - need to perform bound checks (+) +# +# - parallel needs to insert a barrier (+) +# - passed arguments need to be ensured to be "const" +# - what about 'f(a)'? --> f shouldn't have side effects anyway +# - passed arrays need to be ensured not to alias +# - passed slices need to be ensured to be disjoint (+) +# - output slices need special logic (+) + +import + ast, astalgo, idents, lowerings, magicsys, guards, msgs, + renderer, types, modulegraphs, options, spawn, lineinfos + +from trees import getMagic, getRoot +from std/strutils import `%` + +discard """ + +one major problem: + spawn f(a[i]) + inc i + spawn f(a[i]) +is valid, but + spawn f(a[i]) + spawn f(a[i]) + inc i +is not! However, + spawn f(a[i]) + if guard: inc i + spawn f(a[i]) +is not valid either! --> We need a flow dependent analysis here. + +However: + while foo: + spawn f(a[i]) + inc i + spawn f(a[i]) + +Is not valid either! --> We should really restrict 'inc' to loop endings? + +The heuristic that we implement here (that has no false positives) is: Usage +of 'i' in a slice *after* we determined the stride is invalid! +""" + +type + TDirection = enum + ascending, descending + MonotonicVar = object + v, alias: PSym # to support the ordinary 'countup' iterator + # we need to detect aliases + lower, upper, stride: PNode + dir: TDirection + blacklisted: bool # blacklisted variables that are not monotonic + AnalysisCtx = object + locals: seq[MonotonicVar] + slices: seq[tuple[x,a,b: PNode, spawnId: int, inLoop: bool]] + guards: TModel # nested guards + args: seq[PSym] # args must be deeply immutable + spawns: int # we can check that at last 1 spawn is used in + # the 'parallel' section + currentSpawnId: int + inLoop: int + graph: ModuleGraph + +proc initAnalysisCtx(g: ModuleGraph): AnalysisCtx = + result = AnalysisCtx(locals: @[], + slices: @[], + args: @[], + graph: g) + result.guards.s = @[] + result.guards.g = g + +proc lookupSlot(c: AnalysisCtx; s: PSym): int = + for i in 0..<c.locals.len: + if c.locals[i].v == s or c.locals[i].alias == s: return i + return -1 + +proc getSlot(c: var AnalysisCtx; v: PSym): ptr MonotonicVar = + let s = lookupSlot(c, v) + if s >= 0: return addr(c.locals[s]) + 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: + let root = getRoot n[i] + if root != nil: + block addRoot: + for r in items(c.args): + if r == root: break addRoot + c.args.add root + gatherArgs(c, n[i]) + +proc isSingleAssignable(n: PNode): bool = + n.kind == nkSym and (let s = n.sym; + s.kind in {skTemp, skForVar, skLet} and + {sfAddrTaken, sfGlobal} * s.flags == {}) + +proc isLocal(n: PNode): bool = + n.kind == nkSym and (let s = n.sym; + s.kind in {skResult, skTemp, skForVar, skVar, skLet} and + {sfAddrTaken, sfGlobal} * s.flags == {}) + +proc checkLocal(c: AnalysisCtx; n: PNode) = + if isLocal(n): + let s = c.lookupSlot(n.sym) + 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[i]) + +template `?`(x): untyped = x.renderTree + +proc checkLe(c: AnalysisCtx; a, b: PNode) = + case proveLe(c.guards, a, b) + of impUnknown: + message(c.graph.config, a.info, warnStaticIndexCheck, + "cannot prove: " & ?a & " <= " & ?b) + of impYes: discard + of impNo: + 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.graph.operators)) + +proc addLowerBoundAsFacts(c: var AnalysisCtx) = + for v in c.locals: + if not v.blacklisted: + c.guards.addFactLe(v.lower, newSymNode(v.v)) + +proc addSlice(c: var AnalysisCtx; n: PNode; x, le, ri: PNode) = + checkLocal(c, n) + 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) + c.checkBounds(x, le) + c.checkBounds(x, ri) + c.guards.s.setLen(oldState) + c.slices.add((x, le, ri, c.currentSpawnId, c.inLoop > 0)) + +proc overlap(m: TModel; conf: ConfigRef; x,y,c,d: PNode) = + # X..Y and C..D overlap iff (X <= D and C <= Y) + case proveLe(m, c, y) + of impUnknown: + case proveLe(m, x, d) + of impNo: discard + of impUnknown, impYes: + message(conf, x.info, warnStaticIndexCheck, + "cannot prove: $# > $#; required for ($#)..($#) disjoint from ($#)..($#)" % + [?c, ?y, ?x, ?y, ?c, ?d]) + of impYes: + case proveLe(m, x, d) + of impUnknown: + message(conf, x.info, warnStaticIndexCheck, + "cannot prove: $# > $#; required for ($#)..($#) disjoint from ($#)..($#)" % + [?x, ?d, ?x, ?y, ?c, ?d]) + of impYes: + message(conf, x.info, warnStaticIndexCheck, "($#)..($#) not disjoint from ($#)..($#)" % + [?c, ?y, ?x, ?y, ?c, ?d]) + of impNo: discard + of impNo: discard + +proc stride(c: AnalysisCtx; n: PNode): BiggestInt = + if isLocal(n): + let s = c.lookupSlot(n.sym) + if s >= 0 and c.locals[s].stride != nil: + result = c.locals[s].stride.intVal + else: + result = 0 + else: + result = 0 + for i in 0..<n.safeLen: result += stride(c, n[i]) + +proc subStride(c: AnalysisCtx; n: PNode): PNode = + # 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.graph.operators) + else: + result = n + elif n.safeLen > 0: + result = shallowCopy(n) + for i in 0..<n.len: result[i] = subStride(c, n[i]) + else: + result = n + +proc checkSlicesAreDisjoint(c: var AnalysisCtx) = + # this is the only thing that we need to perform after we have traversed + # the whole tree so that the strides are available. + # First we need to add all the computed lower bounds: + addLowerBoundAsFacts(c) + # Every slice used in a loop needs to be disjoint with itself: + for x,a,b,id,inLoop in items(c.slices): + if inLoop: overlap(c.guards, c.graph.config, a,b, c.subStride(a), c.subStride(b)) + # Another tricky example is: + # while true: + # spawn f(a[i]) + # spawn f(a[i+1]) + # inc i # inc i, 2 would be correct here + # + # Or even worse: + # while true: + # 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 + # i*k*2 != i*k'*2 + 1 + # which is true. + # 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): + 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]) + 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): + # ah I cannot resist the temptation and add another sweet heuristic: + # if both slices have the form (i+k)..(i+k) and (i+m)..(i+m) we + # check they are disjoint and k < stride and m < stride: + overlap(c.guards, c.graph.config, x.a, x.b, y.a, y.b) + let stride = min(c.stride(x.a), c.stride(y.a)) + if k < stride and m < stride: + discard + else: + localError(c.graph.config, x.x.info, "cannot prove ($#)..($#) disjoint from ($#)..($#)" % + [?x.a, ?x.b, ?y.a, ?y.b]) + else: + localError(c.graph.config, x.x.info, "cannot prove ($#)..($#) disjoint from ($#)..($#)" % + [?x.a, ?x.b, ?y.a, ?y.b]) + +proc analyse(c: var AnalysisCtx; n: PNode) + +proc analyseSons(c: var AnalysisCtx; n: PNode) = + 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 + +template pushSpawnId(c, body) {.dirty.} = + inc c.spawns + let oldSpawnId = c.currentSpawnId + c.currentSpawnId = c.spawns + body + c.currentSpawnId = oldSpawnId + +proc analyseCall(c: var AnalysisCtx; n: PNode; op: PSym) = + if op.magic == mSpawn: + pushSpawnId(c): + gatherArgs(c, n[1]) + analyseSons(c, n) + elif op.magic == mInc or (op.name.s == "+=" and op.fromSystem): + if n[1].isLocal: + let incr = n[2].skipConv + if incr.kind in {nkCharLit..nkUInt32Lit} and incr.intVal > 0: + let slot = c.getSlot(n[1].sym) + slot.stride = min(slot.stride, incr) + analyseSons(c, n) + elif op.name.s == "[]" and op.fromSystem: + let slice = n[2].skipStmtList + c.addSlice(n, n[1], slice[1], slice[2]) + analyseSons(c, n) + elif op.name.s == "[]=" and op.fromSystem: + let slice = n[2].skipStmtList + c.addSlice(n, n[1], slice[1], slice[2]) + analyseSons(c, n) + else: + analyseSons(c, n) + +proc analyseCase(c: var AnalysisCtx; n: PNode) = + analyse(c, n[0]) + let oldFacts = c.guards.s.len + for i in 1..<n.len: + let branch = n[i] + setLen(c.guards.s, oldFacts) + addCaseBranchFacts(c.guards, n, 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[0][0]) + let oldFacts = c.guards.s.len + addFact(c.guards, canon(n[0][0], c.graph.operators)) + + analyse(c, n[0][1]) + for i in 1..<n.len: + let branch = n[i] + setLen(c.guards.s, oldFacts) + for j in 0..i-1: + addFactNeg(c.guards, canon(n[j][0], c.graph.operators)) + if branch.len > 1: + 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, nkSinkAsgn: + let y = n[1].skipConv + if n[0].isSingleAssignable and y.isLocal: + let slot = c.getSlot(y.sym) + slot.alias = n[0].sym + elif n[0].isLocal: + # since we already ensure sfAddrTaken is not in s.flags, we only need to + # prevent direct assignments to the monotonic variable: + let slot = c.getSlot(n[0].sym) + slot.blacklisted = true + invalidateFacts(c.guards, n[0]) + let value = n[1] + if getMagic(value) == mSpawn: + pushSpawnId(c): + gatherArgs(c, value[1]) + analyseSons(c, value[1]) + analyse(c, n[0]) + else: + analyseSons(c, n) + addAsgnFact(c.guards, n[0], y) + of nkCallKinds: + # direct call: + if n[0].kind == nkSym: analyseCall(c, n, n[0].sym) + else: analyseSons(c, n) + of nkBracketExpr: + 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, 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 + of nkVarSection, nkLetSection: + for it in n: + let value = it.lastSon + let isSpawned = getMagic(value) == mSpawn + if isSpawned: + pushSpawnId(c): + gatherArgs(c, value[1]) + analyseSons(c, value[1]) + if value.kind != nkEmpty: + 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 + else: internalError(c.graph.config, it.info, "slot already has a lower bound") + if not isSpawned: analyse(c, value) + of nkCaseStmt: analyseCase(c, n) + of nkWhen, nkIfStmt, nkIfExpr: analyseIf(c, n) + of nkWhileStmt: + analyse(c, n[0]) + # 'while true' loop? + inc c.inLoop + 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[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[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, + nkMixinStmt, nkBindStmt, nkExportStmt: + discard + else: + analyseSons(c, n) + +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) + 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] + let slice = n[2].skipStmtList + result.add slice[1] + result.add slice[2] + return result + if n.safeLen > 0: + result = shallowCopy(n) + for i in 0..<n.len: + result[i] = transformSlices(g, idgen, n[i]) + else: + result = n + +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[i] = transformSpawn(g, idgen, owner, n[i], barrier) + +proc transformSpawn(g: ModuleGraph; idgen: IdGenerator; owner: PSym; n, barrier: PNode): PNode = + case n.kind + of nkVarSection, nkLetSection: + result = nil + for it in n: + 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, idgen, b) + if result.isNil: + result = newNodeI(nkStmtList, n.info) + result.add n + let t = b[1][0].typ.returnType + if spawnResult(t, true) == srByVar: + result.add wrapProcForSpawn(g, idgen, owner, m, b.typ, barrier, it[0]) + it[^1] = newNodeI(nkEmpty, it.info) + else: + it[^1] = wrapProcForSpawn(g, idgen, owner, m, b.typ, barrier, nil) + if result.isNil: result = n + of nkAsgn, nkFastAsgn, nkSinkAsgn: + let b = n[1] + if getMagic(b) == mSpawn and (let t = b[1][0].typ.returnType; + spawnResult(t, true) == srByVar): + let m = transformSlices(g, idgen, b) + return wrapProcForSpawn(g, idgen, owner, m, b.typ, barrier, n[0]) + result = transformSpawnSons(g, idgen, owner, n, barrier) + of nkCallKinds: + if getMagic(n) == mSpawn: + 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, idgen, owner, n, barrier) + else: + result = n + +proc checkArgs(a: var AnalysisCtx; n: PNode) = + discard "to implement" + +proc generateAliasChecks(a: AnalysisCtx; result: PNode) = + discard "to implement" + +proc liftParallel*(g: ModuleGraph; idgen: IdGenerator; owner: PSym; n: PNode): PNode = + # this needs to be called after the 'for' loop elimination + + # first pass: + # - detect monotonic local integer variables + # - detect used slices + # - detect used arguments + #echo "PAR ", renderTree(n) + + var a = initAnalysisCtx(g) + let body = n.lastSon + analyse(a, body) + if a.spawns == 0: + localError(g.config, n.info, "'parallel' section without 'spawn'") + checkSlicesAreDisjoint(a) + checkArgs(a, body) + + var varSection = newNodeI(nkVarSection, n.info) + var temp = newSym(skTemp, getIdent(g.cache, "barrier"), idgen, owner, n.info) + temp.typ = magicsys.getCompilerProc(g, "Barrier").typ + incl(temp.flags, sfFromGeneric) + let tempNode = newSymNode(temp) + varSection.addVar tempNode + + let barrier = genAddrOf(tempNode, idgen) + result = newNodeI(nkStmtList, n.info) + generateAliasChecks(a, result) + result.add varSection + 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 f2e4fb02e..0a160897f 100644 --- a/compiler/sempass2.nim +++ b/compiler/sempass2.nim @@ -1,169 +1,481 @@ # # -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # import - intsets, ast, astalgo, msgs, renderer, magicsys, types, idents, trees, - wordrecg, strutils, options, guards - -# Second semantic checking pass over the AST. Necessary because the old -# way had some inherent problems. Performs: -# -# * effect+exception tracking -# * "usage before definition" checking -# * checks for invalid usages of compiletime magics (not implemented) -# * checks for invalid usages of PNimNode (not implemented) -# * later: will do an escape analysis for closures at least - -# Predefined effects: -# io, time (time dependent), gc (performs GC'ed allocation), exceptions, -# side effect (accesses global), store (stores into *type*), -# store_unkown (performs some store) --> store(any)|store(x) -# load (loads from *type*), recursive (recursive call), unsafe, -# endless (has endless loops), --> user effects are defined over *patterns* -# --> a TR macro can annotate the proc with user defined annotations -# --> the effect system can access these - -# Load&Store analysis is performed on *paths*. A path is an access like -# obj.x.y[i].z; splitting paths up causes some problems: -# -# var x = obj.x -# var z = x.y[i].z -# -# Alias analysis is affected by this too! A good solution is *type splitting*: -# T becomes T1 and T2 if it's known that T1 and T2 can't alias. -# -# An aliasing problem and a race condition are effectively the same problem. -# Type based alias analysis is nice but not sufficient; especially splitting -# an array and filling it in parallel should be supported but is not easily -# done: It essentially requires a built-in 'indexSplit' operation and dependent -# typing. - + 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 + +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 ------------------------- discard """ exception tracking: - + a() # raises 'x', 'e' try: b() # raises 'e' except e: # must not undo 'e' here; hrm c() - + --> we need a stack of scopes for this analysis + + # XXX enhance the algorithm to care about 'dirty' expressions: + lock a[i].L: + inc i # mark 'i' dirty + lock a[j].L: + access a[i], a[j] # --> reject a[i] """ 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: 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 + isInnerProc: bool + inEnforcedNoSideEffects: bool + currOptions: TOptions + optionsStack: seq[(TOptions, TNoteKinds)] + config: ConfigRef + graph: ModuleGraph + c: PContext + escapingParams: IntSet PEffects = var TEffects -proc isLocalVar(a: PEffects, s: PSym): bool = - s.kind in {skVar, skResult} and sfGlobal notin s.flags and s.owner == a.owner +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) + + 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 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 + for x in pragma[1]: + a.locked.add x + +proc guardGlobal(a: PEffects; n: PNode; guard: PSym) = + # check whether the corresponding lock is held: + for L in a.locked: + if L.kind == nkSym and L.sym == guard: return + # we allow accesses nevertheless in top level statements for + # easier initialization: + #if a.isTopLevel: + # message(a.config, n.info, warnUnguardedAccess, renderTree(n)) + #else: + if not a.isTopLevel: + localError(a.config, n.info, "unguarded access: " & renderTree(n)) + +# 'guard*' are checks which are concerned with 'guard' annotations +# (var x{.guard: y.}: int) +proc guardDotAccess(a: PEffects; n: PNode) = + 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[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[0] + if ty == nil: break + ty = ty.skipTypes(skipPtrs) + if field == nil: + localError(a.config, n.info, "invalid guard field: " & g.name.s) + return + g = field + #ri.sym.guard = field + # XXX unfortunately this is not correct for generic instantiations! + if g.kind == skField: + let dot = newNodeI(nkDotExpr, n.info, 2) + dot[0] = n[0] + dot[1] = newSymNode(g) + dot.typ = g.typ + for L in a.locked: + #if a.guards.sameSubexprs(dot, L): return + if guards.sameTree(dot, L): return + localError(a.config, n.info, "unguarded access: " & renderTree(n)) + else: + guardGlobal(a, n, g) -proc initVar(a: PEffects, n: PNode) = +proc makeVolatile(a: PEffects; s: PSym) {.inline.} = + if a.inTryStmt > 0 and a.config.exc == excSetjmp: + incl(s.flags, sfVolatile) + +proc varDecl(a: PEffects; n: PNode) {.inline.} = + if n.kind == nkSym: + a.scopes[n.sym.id] = a.currentBlock + +proc skipHiddenDeref(n: PNode): PNode {.inline.} = + result = if n.kind == nkHiddenDeref: n[0] else: n + +proc initVar(a: PEffects, n: PNode; volatileCheck: bool) = + let n = skipHiddenDeref(n) if n.kind != nkSym: return let s = n.sym - if isLocalVar(a, s): + if isLocalSym(a, s): + if volatileCheck: makeVolatile(a, s) for x in a.init: - if x == s.id: return + if x == s.id: + if strictDefs in a.c.features and s.kind == skLet: + localError(a.config, n.info, errXCannotBeAssignedTo % + renderTree(n, {renderNoComments} + )) + return a.init.add s.id + if a.scopes.getOrDefault(s.id) == a.currentBlock: + #[ Consider this case: + + var x: T + while true: + if cond: + x = T() #1 + else: + x = T() #2 + use x + + Even though both #1 and #2 are first writes we must use the `=copy` + here so that the old value is destroyed because `x`'s destructor is + run outside of the while loop. This is why we need the check here that + the assignment is done in the same logical block as `x` was declared in. + ]# + n.flags.incl nfFirstWrite proc initVarViaNew(a: PEffects, n: PNode) = + let n = skipHiddenDeref(n) if n.kind != nkSym: return let s = n.sym - if {tfNeedsInit, tfNotNil} * s.typ.flags == {tfNotNil}: - # 'x' is not nil, but that doesn't mean it's not nil children + if {tfRequiresInit, tfNotNil} * s.typ.flags <= {tfNotNil}: + # 'x' is not nil, but that doesn't mean its "not nil" children # are initialized: - initVarViaNew(a, n) + initVar(a, n, volatileCheck=true) + elif isLocalSym(a, s): + makeVolatile(a, s) -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 != {}: - when true: - Message(n.info, warnProveInit, s.name.s) +proc warnAboutGcUnsafe(n: PNode; conf: ConfigRef) = + #assert false + message(conf, n.info, warnGcUnsafe, renderTree(n)) + +proc markGcUnsafe(a: PEffects; reason: PSym) = + if not a.inEnforcedGcSafe: + a.gcUnsafe = true + if a.owner.kind in routineKinds: a.owner.gcUnsafetyReason = reason + +proc markGcUnsafe(a: PEffects; reason: PNode) = + if not a.inEnforcedGcSafe: + a.gcUnsafe = true + if a.owner.kind in routineKinds: + if reason.kind == nkSym: + a.owner.gcUnsafetyReason = reason.sym + else: + a.owner.gcUnsafetyReason = newSym(skUnknown, a.owner.name, a.c.idgen, + a.owner, reason.info, {}) + +proc markSideEffect(a: PEffects; reason: PNode | PSym; useLoc: TLineInfo) = + if not a.inEnforcedNoSideEffects: + a.hasSideEffect = true + if a.owner.kind in routineKinds: + var sym: PSym + when reason is PNode: + if reason.kind == nkSym: + sym = reason.sym else: - Message(n.info, errGenerated, - "'$1' might not have been initialized" % s.name.s) + 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 + if u != nil and not cycleCheck.containsOrIncl(u.id): + let msgKind = if onlyWarning: warnGcUnsafe2 else: errGenerated + case u.kind + of skLet, skVar: + if u.typ.skipTypes(abstractInst).kind == tyProc: + message(conf, s.info, msgKind, + "'$#' is not GC-safe as it calls '$#'" % + [s.name.s, u.name.s]) else: - Message(n.info, warnUninit, s.name.s) + 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: + 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 '$#'" % + [s.name.s, u.name.s]) + else: + message(conf, u.info, msgKind, + "'$#' is not GC-safe as it performs an indirect call here" % s.name.s) + +proc listGcUnsafety(s: PSym; onlyWarning: bool; conf: ConfigRef) = + var cycleCheck = initIntSet() + listGcUnsafety(s, onlyWarning, cycleCheck, conf) + +proc listSideEffects(result: var string; s: PSym; cycleCheck: var IntSet; + conf: ConfigRef; context: PContext; indentLevel: int) = + template addHint(msg; lineInfo; sym; level = indentLevel) = + result.addf("$# $# Hint: '$#' $#\n", repeat(">", level), conf $ lineInfo, sym, msg) + if context.sideEffects.hasKey(s.id): + for (useLineInfo, u) in context.sideEffects[s.id]: + if u != nil and not cycleCheck.containsOrIncl(u.id): + case u.kind + of skLet, skVar: + addHint("accesses global state '$#'" % u.name.s, useLineInfo, s.name.s) + addHint("accessed by '$#'" % s.name.s, u.info, u.name.s, indentLevel + 1) + of routineKinds: + addHint("calls `.sideEffect` '$#'" % u.name.s, useLineInfo, s.name.s) + addHint("called by '$#'" % s.name.s, u.info, u.name.s, indentLevel + 1) + listSideEffects(result, u, cycleCheck, conf, context, indentLevel + 2) + of skParam, skForVar: + addHint("calls routine via hidden pointer indirection", useLineInfo, s.name.s) + else: + addHint("calls routine via pointer indirection", useLineInfo, s.name.s) + +proc listSideEffects(result: var string; s: PSym; conf: ConfigRef; context: PContext) = + var cycleCheck = initIntSet() + result.addf("'$#' can have side effects\n", s.name.s) + listSideEffects(result, s, cycleCheck, conf, context, 1) + +proc useVarNoInitCheck(a: PEffects; n: PNode; s: PSym) = + if {sfGlobal, sfThread} * s.flags != {} and s.kind in {skVar, skLet} and + s.magic != mNimvm: + 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 a.config.hasWarn(warnGcUnsafe): warnAboutGcUnsafe(n) + markGcUnsafe(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) = - for j in 0.. <inter.len: +proc addToIntersection(inter: var TIntersection, s: int, state: BreakState) = + for j in 0..<inter.len: if s == inter[j].id: - inc inter[j].count + if state == bsNone: + inc inter[j].count return - inter.add((id: s, count: 1)) + if state == bsNone: + inter.add((id: s, count: 1)) + else: + inter.add((id: s, count: 0)) -proc throws(tracked, n: PNode) = - if n.typ == nil or n.typ.kind != tyError: tracked.add n - -proc excType(n: PNode): PType = +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 = + result = g.sysTypeFromName(info, "Exception") + +proc excType(g: ModuleGraph; n: PNode): PType = # reraise is like raising E_Base: - let t = if n.kind == nkEmpty: sysTypeFromName"E_Base" else: n.typ + let t = if n.kind == nkEmpty or n.typ.isNil: getEbase(g, n.info) else: n.typ result = skipTypes(t, skipPtrs) -proc createRaise(n: PNode): PNode = +proc createRaise(g: ModuleGraph; n: PNode): PNode = result = newNode(nkType) - result.typ = sysTypeFromName"E_Base" + result.typ = getEbase(g, n.info) if not n.isNil: result.info = n.info -proc createTag(n: PNode): PNode = +proc createTag(g: ModuleGraph; n: PNode): PNode = result = newNode(nkType) - result.typ = sysTypeFromName"TEffect" + 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(aa[i].excType, e.excType): - if not useLineInfo or gCmd == 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 + + if e.typ != nil: + if not isDefectException(e.typ): + throws(a.exc, e, comesFrom) -proc addTag(a: PEffects, e: PNode, useLineInfo=true) = +proc addTag(a: PEffects, e, comesFrom: PNode) = 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 gCmd == cmdDoc: return - elif aa[i].info == e.info: return - throws(a.tags, e) + 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 mergeEffects(a: PEffects, b, comesFrom: PNode) = +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(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(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(e.info, hintUser, typeToString(e.typ)) - for e in items(a.tags): Message(e.info, hintUser, typeToString(e.typ)) + 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)) + 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) @@ -171,20 +483,32 @@ proc catches(tracked: PEffects, e: PType) = var i = tracked.bottom while i < L: # r supertype of e? - if safeInheritanceDiff(tracked.exc[i].excType, e) <= 0: - tracked.exc.sons[i] = tracked.exc.sons[L-1] + if safeInheritanceDiff(tracked.graph.excType(tracked.exc[i]), e) <= 0: + 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 @@ -193,426 +517,1238 @@ proc trackTryStmt(tracked: PEffects, n: PNode) = let oldState = tracked.init.len var inter: TIntersection = @[] - track(tracked, n.sons[0]) - for i in oldState.. <tracked.init.len: - addToIntersection(inter, tracked.init[i]) - + when defined(nimsuggest): + tracked.caughtExceptions.push + for i in 1..<n.len: + let b = n[i] + if b.kind == nkExceptBranch: + if b.len == 1: + tracked.caughtExceptions.addCatchAll + else: + for j in 0..<b.len - 1: + if b[j].isInfixAs(): + assert(b[j][1].kind == nkType) + tracked.caughtExceptions.addCatch(b[j][1].typ) + else: + assert(b[j].kind == nkType) + tracked.caughtExceptions.addCatch(b[j].typ) + else: + assert b.kind == nkFinally + + inc tracked.inTryStmt + track(tracked, n[0]) + dec tracked.inTryStmt + for i in oldState..<tracked.init.len: + addToIntersection(inter, tracked.init[i], 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): - assert(b.sons[j].kind == nkType) - catches(tracked, b.sons[j].typ) - - setLen(tracked.init, oldState) - track(tracked, b.sons[blen-1]) - for i in oldState.. <tracked.init.len: - addToIntersection(inter, tracked.init[i]) + 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[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], bsNone) + else: + setLen(tracked.init, oldState) + 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: + 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: +proc trackPragmaStmt(tracked: PEffects, n: PNode) = + 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 = wRaises): 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 + 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 == {} -proc documentEffect(n, x: PNode, effectType: TSpecialWord, idx: int) = - var x = x - 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(t), n.info) - # set the type so that the following analysis doesn't screw up: - effects.sons[i].typ = real[i].typ - - var pair = newNode(nkExprColonExpr, n.info, @[ - newIdentNode(getIdent(specialWords[effectType]), n.info), effects]) - - if x.kind == nkEmpty: - x = newNodeI(nkPragma, n.info) - n.sons[pragmasPos] = x - x.add(pair) - -proc documentRaises*(n: PNode) = - if n.sons[namePos].kind != nkSym: return - documentEffect(n, n.sons[pragmasPos], wRaises, exceptionEffects) - documentEffect(n, n.sons[pragmasPos], wTags, tagEffects) +proc importedFromC(n: PNode): bool = + # when imported from C, we assume GC-safety. + result = n.kind == nkSym and sfImportc in n.sym.flags 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 tracked.config.hasWarn(warnGcUnsafe): warnAboutGcUnsafe(n, tracked.config) + markGcUnsafe(tracked, s) + if tfNoSideEffect notin s.typ.flags: + markSideEffect(tracked, s, n.info) + +proc procVarCheck(n: PNode; conf: ConfigRef) = + if n.kind in nkSymChoices: + for x in n: procVarCheck(x, conf) + elif n.kind == nkSym and n.sym.magic != mNone and n.sym.kind in routineKinds: + localError(conf, n.info, ("'$1' 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 != 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: - # 'p' is not nil obviously: - return - case impliesNotNil(tracked.guards, n) - of impUnknown: - Message(n.info, errGenerated, - "cannot prove '$1' is not nil" % n.renderTree) - of impNo: - Message(n.info, errGenerated, "'$1' is provably nil" % n.renderTree) - of impYes: discard - -proc trackOperand(tracked: PEffects, n: PNode, paramType: PType) = - let op = n.typ - if op != nil and op.kind == tyProc and n.kind != nkNilLit: - InternalAssert 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: + if paramType.isNil or paramType.kind != tyTypeDesc: + 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: + 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) = + addRaiseEffect(tracked, createRaise(tracked.graph, n), nil) + addTag(tracked, createTag(tracked.graph, n), nil) + +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 + 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) - else: - addEffect(tracked, createRaise(n)) - addTag(tracked, createTag(n)) + 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(tracked, a): + if tracked.config.hasWarn(warnGcUnsafe): warnAboutGcUnsafe(n, tracked.config) + markGcUnsafe(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 tracked.config.hasWarn(warnGcUnsafe): warnAboutGcUnsafe(n, tracked.config) + markGcUnsafe(tracked, a) + elif tfNoSideEffect notin op.flags: + markSideEffect(tracked, a, n.info) + let paramType = if formals != nil and argIndex < formals.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) + # XXX figure out why this can be a non tyProc here. See httpclient.nim for an + # example that triggers it. + if argtype.kind == tyProc and notGcSafe(argtype) and not tracked.inEnforcedGcSafe: + localError(tracked.config, n.info, $n & " is not GC safe") notNilCheck(tracked, n, paramType) -proc breaksBlock(n: PNode): bool = - case n.kind - of nkStmtList, nkStmtListExpr: - for c in n: - if breaksBlock(c): return true - of nkBreakStmt, nkReturnStmt, nkRaiseStmt: - return true + +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 + + case it.kind + of nkBreakStmt, nkReturnStmt: + result = bsBreakOrReturn + of nkRaiseStmt: + result = bsNoReturn of nkCallKinds: - if n.sons[0].kind == nkSym and sfNoReturn in n.sons[0].sym.flags: - return true + if it[0].kind == nkSym and sfNoReturn in it[0].sym.flags: + result = bsNoReturn + else: + result = bsNone else: - discard + 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.len - let interesting = interestingCaseExpr(n.sons[0]) and warnProveField in gNotes + let oldFacts = tracked.guards.s.len + 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 - for i in 1.. <n.len: - let branch = n.sons[i] + let hasResult = hasResultSym(tracked.owner) + let resSym = if hasResult: tracked.owner.ast[resultPos].sym else: nil + var resCounter = 0 + + for i in 1..<n.len: + let branch = n[i] setLen(tracked.init, oldState) if interesting: - setLen(tracked.guards, oldFacts) + 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]) - - let exh = case skipTypes(n.sons[0].Typ, abstractVarRange-{tyTypeDesc}).Kind - of tyFloat..tyFloat128, tyString: - lastSon(n).kind == nkElse - else: - true + 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 exh: + 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, oldFacts) + setLen(tracked.guards.s, oldFacts) + dec tracked.inIfStmt proc trackIf(tracked: PEffects, n: PNode) = - track(tracked, n.sons[0].sons[0]) - let oldFacts = tracked.guards.len - addFact(tracked.guards, n.sons[0].sons[0]) + track(tracked, n[0][0]) + inc tracked.inIfStmt + let oldFacts = tracked.guards.s.len + addFact(tracked.guards, n[0][0]) let oldState = tracked.init.len + let hasResult = hasResultSym(tracked.owner) + let resSym = if hasResult: tracked.owner.ast[resultPos].sym else: nil + var resCounter = 0 + var inter: TIntersection = @[] var toCover = 0 - track(tracked, n.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]) - - for i in 1.. <n.len: - let branch = n.sons[i] - setLen(tracked.guards, oldFacts) + 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[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, oldFacts) - + 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): + for i in 0..<n.len: + 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 cstringCheck(tracked: PEffects; n: PNode) = + 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 paramType(op: PType, i: int): PType = - if op != nil and i < op.len: result = op.sons[i] +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 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]) - 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 - if op != nil and op.kind == tyProc: - InternalAssert op.n.sons[0].kind == nkEffectList - var effectList = op.n.sons[0] +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[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 (!): + if sfSideEffect in a.sym.flags: markSideEffect(tracked, a, n.info) + else: + 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): - addEffect(tracked, createRaise(n)) - addTag(tracked, createTag(n)) + 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) - for i in 1 .. <len(n): trackOperand(tracked, n.sons[i], paramType(op, i)) - if a.kind == nkSym and a.sym.magic in {mNew, mNewFinalize, - mNewSeq, mShallowCopy}: + 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: - initVarViaNew(tracked, n.sons[1]) - for i in 0 .. <safeLen(n): - track(tracked, n.sons[i]) + let arg = n[1] + initVarViaNew(tracked, arg) + 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) + + # 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) + 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 gNotes: checkFieldAccess(tracked.guards, n) + 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 nkMacroDef, nkTemplateDef: discard - of nkAsgn, nkFastAsgn: - track(tracked, n.sons[1]) - initVar(tracked, n.sons[0]) - 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 nkVarSection: + 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 child.kind == nkIdentDefs and last.kind != nkEmpty: - track(tracked, last) - for i in 0 .. child.len-3: - initVar(tracked, child.sons[i]) - addAsgnFact(tracked.guards, child.sons[i], last) - notNilCheck(tracked, last, child.sons[i].typ) + if last.kind != nkEmpty: track(tracked, last) + 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: + for child in n: + let last = lastSon(child) + track(tracked, last) of nkCaseStmt: trackCase(tracked, n) - of nkIfStmt, nkIfExpr: trackIf(tracked, n) - of nkBlockStmt, nkBlockExpr: trackBlock(tracked, n.sons[1]) + of nkWhen, nkIfStmt, nkIfExpr: trackIf(tracked, n) + 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.len - addFact(tracked.guards, n.sons[0]) - track(tracked, n.sons[1]) + let oldFacts = tracked.guards.s.len + addFact(tracked.guards, n[0]) + track(tracked, n[0]) + track(tracked, n[1]) setLen(tracked.init, oldState) - setLen(tracked.guards, oldFacts) + 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: - track(tracked, n.sons[0]) - let oldFacts = tracked.guards.len - for i in 1 .. <len(n): - let x = n.sons[i] + when false: track(tracked, n[0]) + let oldFacts = tracked.guards.s.len + for i in 1..<n.len: + let x = n[i] track(tracked, x) - if sfDiscriminant in x.sons[0].sym.flags: + if x[0].kind == nkSym and sfDiscriminant in x[0].sym.flags: addDiscriminantFact(tracked.guards, x) - setLen(tracked.guards, oldFacts) - of nkTypeSection: discard + 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[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) + 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 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[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 checkRaisesSpec(spec, real: PNode, msg: string, hints: bool) = +proc subtypeRelation(g: ModuleGraph; spec, real: PNode): bool = + 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; 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: - if safeInheritanceDiff(r.excType, spec[s].typ) <= 0: + 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(spec.info) - localError(r.info, errGenerated, msg & typeToString(r.typ)) - popInfoContext() + pushInfoContext(g.config, spec.info) + 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(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*(disp, branch: PSym) = +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(raisesSpec, actual.sons[exceptionEffects], - "can raise an unlisted exception: ", hints=off) + checkRaisesSpec(g, false, raisesSpec, actual[exceptionEffects], + "can raise an unlisted exception: ", hints=off, subtypeRelation) let tagsSpec = effectSpec(p, wTags) if not isNil(tagsSpec): - checkRaisesSpec(tagsSpec, actual.sons[tagEffects], - "can have an unlisted effect: ", hints=off) - -proc setEffectsForProcType*(t: PType, n: PNode) = - var effects = t.n.sons[0] - InternalAssert t.kind == tyProc and effects.kind == nkEffectList - - let - raisesSpec = effectSpec(n, wRaises) - tagsSpec = effectSpec(n, wTags) - if not isNil(raisesSpec) or not isNil(tagsSpec): - InternalAssert effects.len == 0 + 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) + 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; s: PSym = nil) = + var effects = t.n[0] + if t.kind != tyProc or effects.kind != nkEffectList: return + if n.kind != nkEmpty: + internalAssert g.config, effects.len == 0 newSeq(effects.sons, effectListLen) + let raisesSpec = effectSpec(n, wRaises) if not isNil(raisesSpec): - effects.sons[exceptionEffects] = raisesSpec + effects[exceptionEffects] = raisesSpec + elif s != nil and (s.magic != mNone or {sfImportc, sfExportc} * s.flags == {sfImportc}): + effects[exceptionEffects] = newNodeI(nkArgList, effects.info) + + let tagsSpec = effectSpec(n, wTags) if not isNil(tagsSpec): - effects.sons[tagEffects] = tagsSpec + effects[tagEffects] = tagsSpec + elif s != nil and (s.magic != mNone or {sfImportc, sfExportc} * s.flags == {sfImportc}): + effects[tagEffects] = newNodeI(nkArgList, effects.info) -proc trackProc*(s: PSym, body: PNode) = - var effects = s.typ.n.sons[0] - InternalAssert effects.kind == nkEffectList - # effects already computed? - if sfForward in s.flags: return - if effects.len == effectListLen: return + 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, body.info) - effects.sons[tagEffects] = newNodeI(nkArgList, body.info) - - var t: TEffects - t.exc = effects.sons[exceptionEffects] - t.tags = effects.sons[tagEffects] - t.owner = s - t.init = @[] - t.guards = @[] + 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 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 + track(t, body) - - if not isEmptyType(s.typ.sons[0]) and tfNeedsInit in s.typ.sons[0].flags and - s.kind in {skProc, skConverter, skMethod}: - var res = s.ast.sons[resultPos].sym # get result symbol - if res.id notin t.init: - Message(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(raisesSpec, t.exc, "can raise an unlisted exception: ", - hints=on) + 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(tagsSpec, t.tags, "can have an unlisted effect: ", - hints=off) + checkRaisesSpec(g, false, tagsSpec, t.tags, "can have an unlisted effect: ", + hints=off, subtypeRelation) + # after the check, use the formal spec: + effects[tagEffects] = tagsSpec + else: + effects[tagEffects] = t.tags + + let forbidsSpec = effectSpec(p, wForbids) + if not isNil(forbidsSpec): + checkRaisesSpec(g, false, forbidsSpec, t.tags, "has an illegal effect: ", + hints=off, subtypeRelation, isForbids=true) # after the check, use the formal spec: - effects.sons[tagEffects] = tagsSpec - \ No newline at end of file + 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: + #localError(s.info, "'$1' is not GC-safe" % s.name.s) + listGcUnsafety(s, onlyWarning=false, g.config) + else: + listGcUnsafety(s, onlyWarning=true, g.config) + #localError(s.info, warnGcUnsafe2, s.name.s) + if sfNoSideEffect in s.flags and t.hasSideEffect: + when false: + listGcUnsafety(s, onlyWarning=false, g.config) + else: + 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 + when defined(drnim): + if c.graph.strongSemCheck != nil: c.graph.strongSemCheck(c.graph, s, body) + when defined(useDfa): + 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 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 dc5c9341e..f5f8fea0c 100644 --- a/compiler/semstmts.nim +++ b/compiler/semstmts.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2013 Andreas Rumpf # # See the file "copying.txt", included in this @@ -10,881 +10,2004 @@ ## this module does the semantic checking of statements # included from sem.nim -var EnforceVoidContext = PType(kind: tyStmt) +const + errNoSymbolToBorrowFromFound = "no symbol to borrow from found" + errDiscardValueX = "value of type '$1' has to be used (or discarded)" + errInvalidDiscard = "statement returns no value that can be discarded" + errInvalidControlFlowX = "invalid control flow: $1" + errSelectorMustBeOfCertainTypes = "selector must be of an ordinal type, float or string" + errExprCannotBeRaised = "only a 'ref object' can be raised" + errBreakOnlyInLoop = "'break' only allowed in loop construct" + errExceptionAlreadyHandled = "exception already handled" + errYieldNotAllowedHere = "'yield' only allowed in an iterator" + errYieldNotAllowedInTryStmt = "'yield' cannot be used within 'try' in a non-inlined iterator" + errInvalidNumberOfYieldExpr = "invalid number of 'yield' expressions" + errCannotReturnExpr = "current routine cannot return an expression" + errGenericLambdaNotAllowed = "A nested proc can have generic parameters only when " & + "it is used as an operand to another routine and the types " & + "of the generic paramers can be inferred from the expected signature." + errCannotInferTypeOfTheLiteral = "cannot infer the type of the $1" + errCannotInferReturnType = "cannot infer the return type of '$1'" + errCannotInferStaticParam = "cannot infer the value of the static param '$1'" + errProcHasNoConcreteType = "'$1' doesn't have a concrete type, due to unspecified generic parameters." + errLetNeedsInit = "'let' symbol requires an initialization" + errThreadvarCannotInit = "a thread var cannot be initialized explicitly; this would only run for the main thread" + errImplOfXexpected = "implementation of '$1' expected" + errRecursiveDependencyX = "recursive dependency: '$1'" + errRecursiveDependencyIteratorX = "recursion is not supported in iterators: '$1'" + errPragmaOnlyInHeaderOfProcX = "pragmas are only allowed in the header of a proc; redefinition of $1" + 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 semCommand(c: PContext, n: PNode): PNode = - result = semExprNoType(c, n) - -proc semDiscard(c: PContext, n: PNode): PNode = +proc semDiscard(c: PContext, n: PNode): PNode = result = n - checkSonsLen(n, 1) - if n.sons[0].kind != nkEmpty: - n.sons[0] = semExprWithType(c, n.sons[0]) - if isEmptyType(n.sons[0].typ): localError(n.info, errInvalidDiscard) - + checkSonsLen(n, 1, c.config) + 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) - if n.sons[0].kind != nkEmpty: - var s: PSym - case n.sons[0].kind - of nkIdent: s = lookUp(c, n.sons[0]) - of nkSym: s = n.sons[0].sym - else: illFormedAst(n) - 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(x, s) + checkSonsLen(n, 1, c.config) + if n[0].kind != nkEmpty: + if n.kind != nkContinueStmt: + 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[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(n.info, errInvalidControlFlowX, s.name.s) - elif (c.p.nestedLoopCounter <= 0) and (c.p.nestedBlockCounter <= 0): - localError(n.info, errInvalidControlFlowX, + localError(c.config, n.info, errGenerated, "'continue' cannot have a label") + elif c.p.nestedBlockCounter > 0 and n.kind == nkBreakStmt and not c.p.breakInLoop: + localError(c.config, n.info, warnUnnamedBreak) + elif (c.p.nestedLoopCounter <= 0) and ((c.p.nestedBlockCounter <= 0) or n.kind == nkContinueStmt): + localError(c.config, n.info, errInvalidControlFlowX % renderTree(n, {renderNoComments})) -proc semAsm(con: PContext, n: PNode): PNode = - checkSonsLen(n, 2) - var marker = pragmaAsm(con, n.sons[0]) +proc semAsm(c: PContext, n: PNode): PNode = + checkSonsLen(n, 2, c.config) + var marker = pragmaAsm(c, n[0]) if marker == '\0': marker = '`' # default marker - result = semAsmOrEmit(con, n, marker) - -proc semWhile(c: PContext, n: PNode): PNode = + result = semAsmOrEmit(c, n, marker) + +proc semWhile(c: PContext, n: PNode; flags: TExprFlags): PNode = result = n - checkSonsLen(n, 2) + 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 == EnforceVoidContext: - result.typ = EnforceVoidContext - -proc toCover(t: PType): biggestInt = - var t2 = skipTypes(t, abstractVarRange-{tyTypeDesc}) - if t2.kind == tyEnum and enumHasHoles(t2): - result = sonsLen(t2.n) - else: - result = lengthOrd(skipTypes(t, abstractVar-{tyTypeDesc})) - -proc performProcvarCheck(c: PContext, n: PNode, s: PSym) = - var smoduleId = getModule(s).id - if sfProcVar notin s.flags and s.typ.callConv == ccDefault and - smoduleId != c.module.id and smoduleId != c.friendModule.id: - LocalError(n.info, errXCannotBePassedToProcVar, s.name.s) - -proc semProcvarCheck(c: PContext, n: PNode) = - let n = n.skipConv - if n.kind == nkSym and n.sym.kind in {skProc, skMethod, skIterator, - skConverter}: - performProcvarCheck(c, n, n.sym) + if n[1].typ == c.enforceVoidContext: + result.typ = c.enforceVoidContext + elif efInTypeof in flags: + result.typ = n[1].typ + elif implicitlyDiscardable(n[1]): + result[1].typ = c.enforceVoidContext proc semProc(c: PContext, n: PNode): PNode -include semdestruct - -proc semDestructorCheck(c: PContext, n: PNode, flags: TExprFlags) {.inline.} = - if efAllowDestructor notin flags and n.kind in nkCallKinds+{nkObjConstr}: - if instantiateDestructor(c, n.typ): - LocalError(n.info, errGenerated, - "usage of a type with a destructor in a non destructible context") - # This still breaks too many things: - when false: - if efDetermineType notin flags and n.typ.kind == tyTypeDesc and - c.p.owner.kind notin {skTemplate, skMacro}: - localError(n.info, errGenerated, "value expected, but got a type") - -proc newDeref(n: PNode): PNode {.inline.} = - result = newNodeIT(nkHiddenDeref, n.info, n.typ.sons[0]) - addSon(result, n) - -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? - semProcvarCheck(c, result) - if result.typ.kind == tyVar: result = newDeref(result) - semDestructorCheck(c, result, {}) + 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 = + # 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 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 +proc endsInNoReturn(n: PNode): bool = + var dummy: PNode = nil + result = endsInNoReturn(n, dummy) -proc fixNilType(n: PNode) = +proc fixNilType(c: PContext; n: PNode) = if isAtom(n): if n.kind != nkNilLit and n.typ != nil: - localError(n.info, errDiscardValue) + localError(c.config, n.info, errDiscardValueX % n.typ.typeToString) elif n.kind in {nkStmtList, nkStmtListExpr}: - n.kind = nkStmtList - for it in n: fixNilType(it) + n.transitionSonsKind(nkStmtList) + for it in n: fixNilType(c, it) n.typ = nil -proc discardCheck(result: PNode) = - if result.typ != nil and result.typ.kind notin {tyStmt, tyEmpty}: - if result.kind == nkNilLit: - result.typ = nil - elif ImplicitlyDiscardable(result): - var n = result - result.typ = nil - while n.kind in skipForDiscardable: - n = n.lastSon - n.typ = nil - elif result.typ.kind != tyError and gCmd != cmdInteractive: - if result.typ.kind == tyNil: - fixNilType(result) +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 = 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: + 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 - while n.kind in skipForDiscardable: n = n.lastSon - localError(n.info, errDiscardValue) + 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): PNode = +proc semIf(c: PContext, n: PNode; flags: TExprFlags; expectedType: PType = nil): PNode = result = n - var typ = CommonTypeBegin + 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].typ) + 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].typ) - else: illFormedAst(it) - if isEmptyType(typ) or typ.kind == tyNil or not hasElse: - for it in n: discardCheck(it.lastSon) - result.kind = nkIfStmt + it[0] = semExprBranchScope(c, it[0], expectedType) + typ = commonType(c, typ, it[0]) + if not endsInNoReturn(it[0]): + expectedType = typ + else: illFormedAst(it, c.config) + if isEmptyType(typ) or typ.kind in {tyNil, tyUntyped} or + (not hasElse and efInTypeof notin flags): + for it in n: discardCheck(c, it.lastSon, flags) + result.transitionSonsKind(nkIfStmt) # propagate any enforced VoidContext: - if typ == EnforceVoidContext: result.typ = EnforceVoidContext + if typ == c.enforceVoidContext: result.typ = c.enforceVoidContext else: for it in n: let j = it.len-1 - it.sons[j] = fitNode(c, typ, it.sons[j]) - result.kind = nkIfExpr + if not endsInNoReturn(it[j]): + it[j] = fitNode(c, typ, it[j], it[j].info) + result.transitionSonsKind(nkIfExpr) result.typ = typ -proc semCase(c: PContext, n: PNode): PNode = - result = n - checkMinSonsLen(n, 2) - openScope(c) - n.sons[0] = semExprWithType(c, n.sons[0]) - var chckCovered = false - var covered: biggestint = 0 - var typ = CommonTypeBegin - var hasElse = false - case skipTypes(n.sons[0].Typ, abstractVarRange-{tyTypeDesc}).Kind - of tyInt..tyInt64, tyChar, tyEnum, tyUInt..tyUInt32: - chckCovered = true - of tyFloat..tyFloat128, tyString, tyError: - nil - else: - LocalError(n.info, errSelectorMustBeOfCertainTypes) - return - for i in countup(1, sonsLen(n) - 1): - var x = n.sons[i] - case x.kind - of nkOfBranch: - checkMinSonsLen(x, 2) - 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].typ) - of nkElifBranch: - chckCovered = false - checkSonsLen(x, 2) - 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].typ) - closeScope(c) - of nkElse: - chckCovered = false - checkSonsLen(x, 1) - x.sons[0] = semExprBranchScope(c, x.sons[0]) - typ = commonType(typ, x.sons[0].typ) - hasElse = true - else: - illFormedAst(x) - if chckCovered: - if covered == toCover(n.sons[0].typ): - hasElse = true - else: - localError(n.info, errNotAllCasesCovered) - closeScope(c) - if isEmptyType(typ) or typ.kind == tyNil or not hasElse: - for i in 1..n.len-1: discardCheck(n.sons[i].lastSon) - # propagate any enforced VoidContext: - if typ == EnforceVoidContext: - result.typ = EnforceVoidContext - else: - for i in 1..n.len-1: - var it = n.sons[i] - let j = it.len-1 - it.sons[j] = fitNode(c, typ, it.sons[j]) - result.typ = typ +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 isImported = false + if isImportedException(typ, c.config): + 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) + isImported -proc semTry(c: PContext, n: PNode): PNode = result = n - inc c.p.inTryStmt - checkMinSonsLen(n, 2) - var typ = CommonTypeBegin - n.sons[0] = semExprBranchScope(c, n.sons[0]) - typ = commonType(typ, n.sons[0].typ) - var check = initIntSet() - for i in countup(1, sonsLen(n) - 1): - var a = n.sons[i] - checkMinSonsLen(a, 1) - var length = sonsLen(a) + checkMinSonsLen(n, 2, c.config) + + var typ = commonTypeBegin + var expectedType = expectedType + n[0] = semExprBranchScope(c, n[0], expectedType) + if not endsInNoReturn(n[0]): + typ = commonType(c, typ, n[0].typ) + expectedType = typ + + var last = n.len - 1 + var catchAllExcepts = 0 + + for i in 1..last: + let a = n[i] + checkMinSonsLen(a, 1, c.config) + openScope(c) if a.kind == nkExceptBranch: - # XXX what does this do? so that ``except [a, b, c]`` is supported? - if length == 2 and a.sons[0].kind == nkBracket: - a.sons[0..0] = a.sons[0].sons - length = a.sonsLen - - for j in countup(0, length-2): - var typ = semTypeNode(c, a.sons[j], nil) - if typ.kind == tyRef: typ = typ.sons[0] - if typ.kind != tyObject: - LocalError(a.sons[j].info, errExprCannotBeRaised) - a.sons[j] = newNodeI(nkType, a.sons[j].info) - a.sons[j].typ = typ - if ContainsOrIncl(check, typ.id): - localError(a.sons[j].info, errExceptionAlreadyHandled) - elif a.kind != nkFinally: - illFormedAst(n) + + if a.len == 2 and a[0].kind == nkBracket: + # rewrite ``except [a, b, c]: body`` -> ```except a, b, c: body``` + a.sons[0..0] = move a[0].sons + + if a.len == 2 and a[0].isInfixAs(): + # support ``except Exception as ex: body`` + let isImported = semExceptBranchType(a[0][1]) + let symbol = newSymG(skLet, a[0][2], c) + 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`` + 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: isImported = true + else: isNative = true + + 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: + 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.sons[length-1] = semExprBranchScope(c, a.sons[length-1]) - typ = commonType(typ, a.sons[length-1].typ) - dec c.p.inTryStmt - if isEmptyType(typ) or typ.kind == tyNil: - discardCheck(n.sons[0]) - for i in 1..n.len-1: discardCheck(n.sons[i].lastSon) - if typ == EnforceVoidContext: - result.typ = EnforceVoidContext + 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) + + 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: - n.sons[0] = fitNode(c, typ, n.sons[0]) - for i in 1..n.len-1: - var it = n.sons[i] + 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[i] let j = it.len-1 - it.sons[j] = fitNode(c, typ, it.sons[j]) + 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) - if result.kind in {nkHiddenStdConv, nkHiddenSubConv}: - changeType(result.sons[1], typ, check=true) - result = result.sons[1] + +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[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 elif not sameType(result.typ, typ): - changeType(result, typ, check=false) + 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 - let shadowed = StrTableGet(scope.symbols, v.name) + 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 = - if isTopLevel(c): - result = semIdentWithPragma(c, kind, n, {sfExported}) +proc semIdentDef(c: PContext, n: PNode, kind: TSymKind, reportToNimsuggest = true): PSym = + if isTopLevel(c): + 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 else: result = semIdentWithPragma(c, kind, n, {}) - suggestSym(n, result) + if result.owner.kind == skModule: + incl(result.flags, sfGlobal) + result.options = c.config.options -proc checkNilable(v: PSym) = - if sfGlobal in v.flags and {tfNotNil, tfNeedsInit} * v.typ.flags != {}: - if v.ast.isNil: - Message(v.info, warnProveInit, v.name.s) - elif tfNotNil in v.typ.flags and tfNotNil notin v.ast.typ.flags: - Message(v.info, warnProveInit, v.name.s) + 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 v.typ.requiresInit: + if v.astdef.isNil: + message(c.config, v.info, warnProveInit, v.name.s) + 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 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: var PNode; orig, identDefs: PNode) = + if result.kind == nkStmtList: + let o = copyNode(orig) + o.add identDefs + result.add o + else: + result.add identDefs -proc semVarOrLet(c: PContext, n: PNode, symkind: TSymKind): PNode = - var b: PNode - result = copyNode(n) - for i in countup(0, sonsLen(n)-1): - var a = n.sons[i] - if gCmd == cmdIdeTools: suggestStmt(c, a) - if a.kind == nkCommentStmt: continue - if a.kind notin {nkIdentDefs, nkVarTuple, nkConstDef}: IllFormedAst(a) - checkMinSonsLen(a, 3) - var length = sonsLen(a) - var typ: PType - if a.sons[length-2].kind != nkEmpty: - typ = semTypeNode(c, a.sons[length-2], nil) +proc isDiscardUnderscore(v: PSym): bool = + 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 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) + 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: - typ = nil + localError(c.config, a.info, "'using' section must have a type") var def: PNode - if a.sons[length-1].kind != nkEmpty: - def = semExprWithType(c, a.sons[length-1], {efAllowDestructor}) - # BUGFIX: ``fitNode`` is needed here! - # check type compability between def.typ and typ: - if typ != nil: def = fitNode(c, typ, def) - else: typ = skipIntLit(def.typ) + if a[^1].kind != nkEmpty: + localError(c.config, a.info, "'using' sections cannot contain assignments") + +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.last + t = skipTypes(t, {tyGenericInst, tyAlias, tySink, tyOwned}) + result = n + if t.kind in {tyVar, tyLent}: + 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.elementType + result = newNodeIT(nkHiddenDeref, n.info, baseTyp) + result.add a + t = skipTypes(baseTyp, {tyGenericInst, tyAlias, tySink, tyOwned}) + +proc fillPartialObject(c: PContext; n: PNode; typ: PType) = + if n.len == 2: + let x = semExprWithType(c, n[0]) + 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), 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 " & + "requires a .partial object, but got " & typeToString(obj)) + else: + localError(c.config, n.info, "nkDotNode requires 2 children") + +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, 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: - def = ast.emptyNode - if symkind == skLet: LocalError(a.info, errLetNeedsInit) - + 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) + + # 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}: illFormedAst(a, c.config) + checkMinSonsLen(a, 3, c.config) + + b = semVarMacroPragma(c, a, n) + if b != nil: + addToVarSection(c, result, b) + continue + + var hasUserSpecifiedType = false + var typ: PType = nil + if a[^2].kind != nkEmpty: + typ = semTypeNode(c, a[^2], nil) + hasUserSpecifiedType = true + + var typFlags: TTypeAllowedFlags = {} + + var def: PNode = c.graph.emptyNode + if typ != nil and typ.kind == tyRange and + c.graph.config.isDefined("nimPreviewRangeDefault") and + a[^1].kind == nkEmpty: + a[^1] = firstRange(c.config, typ) + + if a[^1].kind != nkEmpty: + def = semExprWithType(c, a[^1], {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) + typ = def.typ + else: + # BUGFIX: ``fitNode`` is needed here! + # check type compatibility between def.typ and typ + def = fitNodeConsiderViewType(c, typ, def, def.info) + #changeType(def.skipConv, typ, check=true) + else: + typ = def.typ.skipTypes({tyStatic, tySink}).skipIntLit(c.idgen) + if typ.kind in tyUserTypeClasses and typ.isResolvedUserTypeClass: + typ = typ.last + if hasEmpty(typ): + 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 - if not typeAllowed(typ, symkind): - LocalError(a.info, errXisNoType, typeToString(typ)) - var tup = skipTypes(typ, {tyGenericInst}) - if a.kind == nkVarTuple: - if tup.kind != tyTuple: - localError(a.info, errXExpected, "tuple") - elif length-2 != sonsLen(tup): - localError(a.info, errWrongNumberOfVariables) - else: - 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 - addSon(result, b) - elif tup.kind == tyTuple and def.kind == nkPar and - a.kind == nkIdentDefs and a.len > 3: - Message(a.info, warnEachIdentIsTuple) - for j in countup(0, length-3): - var v = semIdentDef(c, a.sons[j], symkind) - if sfGenSym notin v.flags: addInterfaceDecl(c, v) - when oKeepVariableNames: - if c.InUnrolledContext > 0: v.flags.incl(sfShadowed) + + 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: + # 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) - # a shadowed variable is an error unless it appears on the right - # side of the '=': - if warnShadowIdent in gNotes and not identWithin(def, v.name): - Message(a.info, warnShadowIdent, v.name.s) - if a.kind != nkVarTuple: - if def != nil and def.kind != nkEmpty: - # this is needed for the evaluation pass and for the guard checking: - v.ast = def - if sfThread in v.flags: LocalError(def.info, errThreadvarCannotInit) - v.typ = typ + if v.owner == nil: v.owner = c.p.owner + when oKeepVariableNames: + if c.inUnrolledContext > 0: v.flags.incl(sfShadowed) + else: + let shadowed = findShadowedVar(c, v) + if shadowed != nil: + shadowed.flags.incl(sfShadowed) + if shadowed.kind == skResult and sfGenSym notin v.flags: + message(c.config, a.info, warnResultShadowed) + if def.kind != nkEmpty: + if sfThread in v.flags: localError(c.config, def.info, errThreadvarCannotInit) + setVarType(c, v, typ) + # this is needed for the evaluation pass, guard checking + # and custom pragmas: b = newNodeI(nkIdentDefs, a.info) - if importantComments(): + 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)) - addSon(result, b) - else: - if def.kind == nkPar: v.ast = def[j] - v.typ = tup.sons[j] - b.sons[j] = newSymNode(v) - checkNilable(v) - -proc semConst(c: PContext, n: PNode): PNode = + # 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) + 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] - if gCmd == cmdIdeTools: suggestStmt(c, a) - if a.kind == nkCommentStmt: continue - if (a.kind != nkConstDef): IllFormedAst(a) - checkSonsLen(a, 3) - var v = semIdentDef(c, a.sons[0], skConst) + 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 notin {nkConstDef, nkVarTuple}: illFormedAst(a, c.config) + checkMinSonsLen(a, 3, c.config) + + b = semVarMacroPragma(c, a, n) + if b != nil: + addToVarSection(c, result, b) + continue + + var hasUserSpecifiedType = false var typ: PType = nil - if a.sons[1].kind != nkEmpty: typ = semTypeNode(c, a.sons[1], 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 - var def = semConstExpr(c, a.sons[2]) - if def == nil: - LocalError(a.sons[2].info, errConstExprExpected) - continue # 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: continue - if not typeAllowed(typ, skConst): - LocalError(a.info, errXisNoType, typeToString(typ)) + + # evaluate the node + def = semConstExpr(c, def) + if def == nil: + localError(c.config, a[^1].info, errConstExprExpected) continue - v.typ = typ - v.ast = def # no need to copy - if sfGenSym notin v.flags: addInterfaceDecl(c, v) - var b = newNodeI(nkConstDef, a.info) - if importantComments(): b.comment = a.comment - addSon(b, newSymNode(v)) - addSon(b, ast.emptyNode) # no type description - addSon(b, copyTree(def)) - addSon(result, b) - -type - TFieldInstCtx = object # either 'tup[i]' or 'field' is valid - tupleType: PType # if != nil we're traversing a tuple - tupleIndex: int - field: PSym - replaceByFieldName: bool - -proc instFieldLoopBody(c: TFieldInstCtx, n: PNode, forLoop: PNode): PNode = - case n.kind - of nkEmpty..pred(nkIdent), succ(nkIdent)..nkNilLit: result = n - of nkIdent: - result = n - var L = sonsLen(forLoop) - if c.replaceByFieldName: - if n.ident.id == forLoop[0].ident.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 - result = newStrNode(nkStrLit, fieldName) - return - # other fields: - for i in ord(c.replaceByFieldName)..L-3: - if n.ident.id == forLoop[i].ident.id: - var call = forLoop.sons[L-2] - var tupl = call.sons[i+1-ord(c.replaceByFieldName)] - if c.field.isNil: - result = newNodeI(nkBracketExpr, n.info) - result.add(tupl) - result.add(newIntNode(nkIntLit, c.tupleIndex)) + 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: - result = newNodeI(nkDotExpr, n.info) - result.add(tupl) - result.add(newSymNode(c.field, n.info)) - break - else: - if n.kind == nkContinueStmt: - localError(n.info, errGenerated, - "'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) - -type - TFieldsCtx = object - c: PContext - m: TMagic - -proc semForObjectFields(c: TFieldsCtx, typ, forLoop, father: PNode) = - case typ.kind - of nkSym: - var fc: TFieldInstCtx # either 'tup[i]' or 'field' is valid - fc.field = typ.sym - fc.replaceByFieldName = c.m == mFieldPairs - openScope(c.c) - inc c.c.InUnrolledContext - let body = instFieldLoopBody(fc, lastSon(forLoop), forLoop) - father.add(SemStmt(c.c, body)) - dec c.c.InUnrolledContext - closeScope(c.c) - of nkNilLit: nil - of nkRecCase: - let L = forLoop.len - let call = forLoop.sons[L-2] - if call.len > 2: - LocalError(forLoop.info, errGenerated, - "parallel 'fields' iterator does not work for 'case' objects") - return - # iterate over the selector: - semForObjectFields(c, typ[0], forLoop, father) - # we need to generate a case statement: - 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) - 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: - 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]) - caseStmt.add(branch) - father.add(caseStmt) - of nkRecList: - for t in items(typ): semForObjectFields(c, t, forLoop, father) - else: - illFormedAst(typ) - -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(magicsys.systemModule.Tab, getIdent"true") - if trueSymbol == nil: - LocalError(n.info, errSystemNeeds, "true") - trueSymbol = newSym(skUnknown, getIdent"true", getCurrOwner(), n.info) - trueSymbol.typ = getSysType(tyBool) - - result.sons[0] = newSymNode(trueSymbol, n.info) - var stmts = newNodeI(nkStmtList, n.info) - result.sons[1] = stmts - - var length = sonsLen(n) - var call = n.sons[length-2] - if length-2 != sonsLen(call)-1 + ord(m==mFieldPairs): - LocalError(n.info, errWrongNumberOfVariables) - return result - - var tupleTypeA = skipTypes(call.sons[1].typ, abstractVar-{tyTypeDesc}) - if tupleTypeA.kind notin {tyTuple, tyObject}: - localError(n.info, errGenerated, "no object or tuple type") - return result - for i in 1..call.len-1: - var tupleTypeB = skipTypes(call.sons[i].typ, abstractVar-{tyTypeDesc}) - if not SameType(tupleTypeA, tupleTypeB): - typeMismatch(call.sons[i], tupleTypeA, tupleTypeB) - - Inc(c.p.nestedLoopCounter) - if tupleTypeA.kind == tyTuple: - var loopBody = n.sons[length-1] - for i in 0..sonsLen(tupleTypeA)-1: - openScope(c) - var fc: TFieldInstCtx - fc.tupleType = tupleTypeA - fc.tupleIndex = i - fc.replaceByFieldName = m == mFieldPairs - var body = instFieldLoopBody(fc, loopBody, n) - inc c.InUnrolledContext - stmts.add(SemStmt(c, body)) - dec c.InUnrolledContext - closeScope(c) - else: - var fc: TFieldsCtx - fc.m = m - fc.c = c - semForObjectFields(fc, tupleTypeA.n, n, stmts) - Dec(c.p.nestedLoopCounter) - var b = newNodeI(nkBreakStmt, n.info) - b.add(ast.emptyNode) - stmts.add(b) - -proc addForVarDecl(c: PContext, v: PSym) = - if warnShadowIdent in gNotes: - let shadowed = findShadowedVar(c, v) - if shadowed != nil: - # XXX should we do this here? - #shadowed.flags.incl(sfShadowed) - Message(v.info, warnShadowIdent, v.name.s) - addDecl(c, v) + 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 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, 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) - var iter = skipTypes(n.sons[length-2].typ, {tyGenericInst}) - # 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().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 = n.sons[length-2].typ - 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(n.info, errWrongNumberOfVariables) - elif length-2 != sonsLen(iter): - LocalError(n.info, errWrongNumberOfVariables) + localError(c.config, n.info, errWrongNumberOfVariables) + 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().kind == skModule: incl(v.flags, sfGlobal) - v.typ = iter.sons[i] - n.sons[i] = newSymNode(v) - if sfGenSym notin v.flags: addForVarDecl(c, v) - Inc(c.p.nestedLoopCounter) - n.sons[length-1] = SemStmt(c, n.sons[length-1]) - Dec(c.p.nestedLoopCounter) + 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[^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 = result = newNodeI(nkCall, arg.info) - result.add(newIdentNode(it.getIdent, arg.info)) - if arg.typ != nil and arg.typ.kind == tyVar: + result.add(newIdentNode(getIdent(c.cache, it), arg.info)) + if arg.typ != nil and arg.typ.kind in {tyVar, tyLent}: result.add newDeref(arg) else: result.add arg result = semExprNoDeref(c, result, {efWantIterator}) -proc semFor(c: PContext, n: PNode): PNode = - result = n - checkMinSonsLen(n, 3) - var length = sonsLen(n) +proc isTrivalStmtExpr(n: PNode): bool = + for i in 0..<n.len-1: + if n[i].kind notin {nkEmpty, nkCommentStmt}: + return false + result = true + +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 maType = magicsys.getCompilerProc(c.graph, magicType) + if maType == nil: return + + 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.firstParamType == maType.typ: + if match == nil: + match = symx + else: + localError(c.config, n.info, errAmbiguousCallXYZ % [ + getProcHeader(c.config, match), + getProcHeader(c.config, symx), $selector]) + symx = nextOverloadIter(o, c, headSymbol) + + if match == nil: return + var callExpr = newNodeI(nkCall, n.info) + callExpr.add newSymNode(match) + callExpr.add n + case match.kind + 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; flags: TExprFlags): PNode = + checkMinSonsLen(n, 3, c.config) + result = handleForLoopMacro(c, n, flags) + if result != nil: return result openScope(c) - n.sons[length-2] = semExprNoDeref(c, n.sons[length-2], {efWantIterator}) - var call = n.sons[length-2] - if call.kind in nkCallKinds and call.sons[0].typ.callConv == ccClosure: - # first class iterator: - result = semForVars(c, n) - elif call.kind notin nkCallKinds 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 = n + 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[^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[0].sym.magic == mOmpParFor: + result = semForVars(c, n, flags) + result.transitionSonsKind(nkParForStmt) else: - LocalError(n.sons[length-2].info, errIteratorExpected) - result = semForVars(c, n) - elif call.sons[0].sym.magic != mNone: - if call.sons[0].sym.magic == mOmpParFor: - result = semForVars(c, n) - result.kind = nkParForStmt + result = semForFields(c, n, call[0].sym.magic) + elif isCallExpr and isClosureIterator(call[0].typ.skipTypes(abstractInst)): + # first class iterator: + 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: - result = semForFields(c, n, call.sons[0].sym.magic) + 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 == EnforceVoidContext: - result.typ = 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 = +proc semRaise(c: PContext, n: PNode): PNode = result = n - checkSonsLen(n, 1) - if n.sons[0].kind != nkEmpty: - n.sons[0] = semExprWithType(c, n.sons[0]) - var typ = n.sons[0].typ - if typ.kind != tyRef or typ.sons[0].kind != tyObject: - localError(n.info, errExprCannotBeRaised) + checkSonsLen(n, 1, c.config) + if n[0].kind != nkEmpty: + n[0] = semExprWithType(c, n[0]) + var typ = n[0].typ + if not isImportedException(typ, c.config): + typ = typ.skipTypes({tyAlias, tyGenericInst, tyOwned}) + if typ.kind != tyRef: + localError(c.config, n.info, errExprCannotBeRaised) + 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) - for i in countup(0, sonsLen(n)-1): - var a = n.sons[i] + if n.kind != nkGenericParams: illFormedAst(n, c.config) + for i in 0..<n.len: + var a = n[i] if a.kind == nkSym: addDecl(c, a.sym) - else: illFormedAst(a) + else: illFormedAst(a, c.config) -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] - if gCmd == cmdIdeTools: suggestStmt(c, a) - if a.kind == nkCommentStmt: continue - if a.kind != nkTypeDef: IllFormedAst(a) - checkSonsLen(a, 3) - var s = semIdentDef(c, a.sons[0], skType) +proc typeSectionTypeName(c: PContext; n: PNode): PNode = + if n.kind == nkPragmaExpr: + if n.len == 0: illFormedAst(n, c.config) + 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 a.sons[0].kind == nkPragmaExpr: - pragma(c, s, a.sons[0].sons[1], typePragmas) + 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) - a.sons[0] = newSymNode(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 + 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 + 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.typeBodyImpl + + proc traverseSubTypes(c: PContext; t: PType): bool = + template error(msg) = localError(c.config, genericType.sym.info, msg) + result = false + template subresult(r) = + let sub = r + result = result or sub + + case t.kind + of tyGenericParam: + t.flags.incl tfWeakCovariant + return true + of tyObject: + for field in t.n: + subresult traverseSubTypes(c, field.typ) + of tyArray: + return traverseSubTypes(c, t.elementType) + of tyProc: + 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.elementType) + of tyGenericInvocation: + let targetBody = t.genericHead + for i in 1..<t.len: + let param = t[i] + if param.kind == tyGenericParam: + if tfCovariant in param.flags: + let formalFlags = targetBody[i-1].flags + if tfCovariant notin formalFlags: + error("covariant param '" & param.sym.name.s & + "' used in a non-covariant position") + elif tfWeakCovariant in formalFlags: + param.flags.incl tfWeakCovariant + result = true + elif tfContravariant in param.flags: + let formalParam = targetBody[i-1].sym + if tfContravariant notin formalParam.typ.flags: + error("contravariant param '" & param.sym.name.s & + "' used in a non-contravariant position") + result = true + else: + subresult traverseSubTypes(c, param) + of tyAnd, tyOr, tyNot, tyStatic, tyBuiltInTypeClass, tyCompositeTypeClass: + error("non-invariant type parameters cannot be used with types such '" & $t & "'") + of tyUserTypeClass, tyUserTypeClassInst: + error("non-invariant type parameters are not supported in concepts") + of tyTuple: + for fieldType in t.kids: + subresult traverseSubTypes(c, fieldType) + of tyPtr, tyRef, tyVar, tyLent: + 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: + discard + discard traverseSubTypes(c, body) proc typeSectionRightSidePass(c: PContext, n: PNode) = - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if (a.kind != nkTypeDef): IllFormedAst(a) - checkSonsLen(a, 3) - if (a.sons[0].kind != nkSym): IllFormedAst(a) - var s = a.sons[0].sym - if s.magic == mNone and a.sons[2].kind == nkEmpty: - LocalError(a.info, errImplOfXexpected, s.name.s) + 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[0]) + var s = name.sym + 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) - pushOwner(s) + pushOwner(c, s) if s.magic == mNone: s.typ.kind = tyGenericBody # XXX for generic type aliases this is not correct! We need the - # underlying Id really: + # underlying Id really: # # type # TGObj[T] = object # TAlias[T] = TGObj[T] - # - a.sons[1] = semGenericParamList(c, a.sons[1], s.typ) + # + 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 tyEmpty instead of nil to not crash for strange conversions + # so we use tyNone instead of nil to not crash for strange conversions # like: mydata.seq - rawAddSon(s.typ, newTypeS(tyEmpty, 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) - dec c.InGenericContext + inc c.inGenericContext + 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 - popOwner() + 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: + # The codegen currently produces various failures with + # generic imported types that have fields, but we need + # the fields specified in order to detect weak covariance. + # The proper solution is to teach the codegen how to handle + # such types, because this would offer various interesting + # possibilities such as instantiating C++ generic types with + # garbage collected Nim types. + if sfImportc in s.flags: + var body = s.typ.last + if body.kind == tyObject: + # erases all declared fields + body.n.sons = @[] + + popOwner(c) closeScope(c) - elif a.sons[2].kind != nkEmpty: + elif a[2].kind != nkEmpty: # process the type's body: - pushOwner(s) - var t = semTypeNode(c, a.sons[2], s.typ) - if s.typ == nil: + pushOwner(c, s) + var t = semTypeNode(c, a[2], s.typ) + if s.typ == nil: s.typ = t - elif t != s.typ: + elif t != s.typ and (s.typ == nil or s.typ.kind != tyAlias): # this can happen for e.g. tcan_alias_specialised_generic: assignType(s.typ, t) #debug s.typ s.ast = a - popOwner() - -proc typeSectionFinalPass(c: PContext, n: PNode) = - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if a.sons[0].kind != nkSym: IllFormedAst(a) - var s = a.sons[0].sym - # compute the type's size and check for illegal recursions: - if a.sons[1].kind == nkEmpty: - if a.sons[2].kind in {nkSym, nkIdent, nkAccQuoted}: - # type aliases are hard: - #MessageOut('for type ' + typeToString(s.typ)); - var t = semTypeNode(c, a.sons[2], nil) - if t.kind in {tyObject, tyEnum}: - assignType(s.typ, t) - s.typ.id = t.id # same id - checkConstructedType(s.info, s.typ) - let aa = a.sons[2] + popOwner(c) + # 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: - assert s.typ.sons[0].sym == nil - s.typ.sons[0].sym = newSym(skType, getIdent(s.name.s & ":ObjectType"), - getCurrOwner(), s.info) - -proc SemTypeSection(c: PContext, n: PNode): PNode = - typeSectionLeftSidePass(c, n) - typeSectionRightSidePass(c, n) - typeSectionFinalPass(c, n) + var st = s.typ + if st.kind == tyGenericBody: st = st.typeBodyImpl + internalAssert c.config, st.kind in {tyPtr, tyRef} + 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"), + 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, hasError) + of nkOfBranch, nkElse: + 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, tyOwned: + let start = ord(t.kind in {tyGenericInvocation, tyGenericInst}) + for i in start..<t.len: + checkMeta(c, n, t[i], hasError, t) + else: + checkMeta(c, n, t, hasError, nil) + else: + internalAssert c.config, false + +proc typeSectionFinalPass(c: PContext, n: PNode) = + for i in 0..<n.len: + var a = n[i] + if a.kind == nkCommentStmt: continue + 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[1].kind == nkEmpty: + var x = a[2] + 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 = + proc gatherStmts(c: PContext; n: PNode; result: PNode) {.nimcall.} = + case n.kind + of nkIncludeStmt: + for i in 0..<n.len: + var f = checkModuleName(c.config, n[i]) + if f != InvalidFileIdx: + if containsOrIncl(c.includedFiles, f.int): + 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[i], result) + of nkTypeSection: + incl n.flags, nfSem + typeSectionLeftSidePass(c, n) + result.add n + else: + result.add n + + result = newNodeI(nkStmtList, n.info) + gatherStmts(c, n, result) + + template rec(name) = + for i in 0..<result.len: + if result[i].kind == nkTypeSection: + name(c, result[i]) + + rec typeSectionRightSidePass + rec typeSectionFinalPass + when false: + # too beautiful to delete: + template rec(name; setbit=false) = + proc `name rec`(c: PContext; n: PNode) {.nimcall.} = + if n.kind == nkTypeSection: + when setbit: incl n.flags, nfSem + name(c, n) + elif n.kind == nkStmtList: + for i in 0..<n.len: + `name rec`(c, n[i]) + `name rec`(c, n) + rec typeSectionLeftSidePass, true + rec typeSectionRightSidePass + rec typeSectionFinalPass + +proc semTypeSection(c: PContext, n: PNode): PNode = + ## Processes a type section. This must be done in separate passes, in order + ## to allow the type definitions in the section to reference each other + ## without regard for the order of their definitions. + if sfNoForward notin c.module.flags or nfSem notin n.flags: + inc c.inTypeContext + typeSectionLeftSidePass(c, n) + typeSectionRightSidePass(c, n) + typeSectionFinalPass(c, n) + dec c.inTypeContext result = n 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(n.info, errGenerated, "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) - else: illFormedAst(n) +proc addParams(c: PContext, n: PNode, kind: TSymKind) = + 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) = +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(n.info, errNoSymbolToBorrowFromFound) - -proc addResult(c: PContext, t: PType, info: TLineInfo, owner: TSymKind) = - if t != nil: - var s = newSym(skResult, getIdent"result", getCurrOwner(), info) + localError(c.config, n.info, errNoSymbolToBorrowFromFound) + +proc swapResult(n: PNode, sRes: PSym, dNode: PNode) = + ## Swap nodes that are (skResult) symbols to d(estination)Node. + for i in 0..<n.safeLen: + if n[i].kind == nkSym and n[i].sym == sRes: + n[i] = dNode + swapResult(n[i], sRes, dNode) + +proc addResult(c: PContext, n: PNode, t: PType, owner: TSymKind) = + template genResSym(s) = + var s = newSym(skResult, getIdent(c.cache, "result"), c.idgen, + getCurrOwner(c), n.info) s.typ = t incl(s.flags, sfUsed) - 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)) + 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 = + # Mirrored with semVarMacroPragma + result = nil + var n = prc[pragmasPos] + if n == nil or n.kind == nkEmpty: return + for i in 0..<n.len: + let it = n[i] + let key = if it.kind in nkPragmaCallKinds and it.len >= 1: it[0] else: it + + trySuggestPragmas(c, key) + + if isPossibleMacroPragma(c, it, key): + # we transform ``proc p {.m, rest.}`` into ``m(do: proc p {.rest.})`` and + # let the semantic checker deal with it: + var x = newNodeI(nkCall, key.info) + x.add(key) + + if it.kind in nkPragmaCallKinds and it.len > 1: + # pass pragma arguments to the macro too: + for i in 1..<it.len: + x.add(it[i]) + + # Drop the pragma from the list, this prevents getting caught in endless + # recursion when the nkCall is semanticized + prc[pragmasPos] = copyExcept(n, i) + if prc[pragmasPos].kind != nkEmpty and prc[pragmasPos].len == 0: + prc[pragmasPos] = c.graph.emptyNode + + x.add(prc) + + # recursion assures that this works for multiple macro annotations too: + var r = semOverloadedCall(c, x, x, {skMacro, skTemplate}, {efNoUndeclared}) + if r == nil: + # Restore the old list of pragmas since we couldn't process this + prc[pragmasPos] = n + # No matching macro was found but there's always the possibility this may + # be a .pragma. template instead + continue + + doAssert 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 copyExcept(n: PNode, i: int): PNode = - result = copyNode(n) - for j in 0.. <n.len: - if j != i: result.add(n.sons[j]) + doAssert result != nil -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, considerAcc(n), {skMacro, skTemplate}) + return result -proc semProcAnnotation(c: PContext, prc: PNode): PNode = - var n = prc.sons[pragmasPos] - if n == nil or n.kind == nkEmpty: return - for i in countup(0, <n.len): - var it = n.sons[i] - var key = if it.kind == nkExprColonExpr: it.sons[0] else: it - let m = lookupMacro(c, key) - if m == nil: continue - # 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 it.kind == nkExprColonExpr: - # pass pragma argument to the macro too: - x.add(it.sons[1]) - x.add(newProcNode(nkDo, prc.info, prc)) - # recursion assures that this works for multiple macro annotations too: - return semStmt(c, x) - -proc semLambda(c: PContext, n: PNode, flags: TExprFlags): PNode = - result = semProcAnnotation(c, n) - if result != nil: 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 + + n = replaceTypesInBody(c, pt, n, original) result = n - checkSonsLen(n, bodyPos + 1) - var s: PSym - if n[namePos].kind != nkSym: - s = newSym(skProc, idAnon, getCurrOwner(), n.info) - s.ast = n - n.sons[namePos] = newSymNode(s) - else: - s = n[namePos].sym - pushOwner(s) + s.ast = result + n[namePos].sym = s + n[genericParamsPos] = c.graph.emptyNode + # for LL we need to avoid wrong aliasing + let params = copyTree n.typ.n + s.typ = n.typ + for i in 1..<params.len: + if params[i].typ.kind in {tyTypeDesc, tyGenericParam, + tyFromExpr}+tyTypeClasses: + localError(c.config, params[i].info, "cannot infer type of parameter: " & + params[i].sym.name.s) + #params[i].sym.owner = s openScope(c) - if n.sons[genericParamsPos].kind != nkEmpty: - illFormedAst(n) # process parameters: - if n.sons[paramsPos].kind != nkEmpty: - semParamList(c, n.sons[ParamsPos], nil, s) - ParamsTypeCheck(c, s.typ) - else: - s.typ = newTypeS(tyProc, c) - rawAddSon(s.typ, nil) - if n.sons[pragmasPos].kind != nkEmpty: - pragma(c, s, n.sons[pragmasPos], lambdaPragmas) - s.options = gOptions - if n.sons[bodyPos].kind != nkEmpty: - if sfImportc in s.flags: - LocalError(n.sons[bodyPos].info, errImplOfXNotAllowed, s.name.s) - #if efDetermineType notin flags: - # XXX not good enough; see tnamedparamanonproc.nim - pushProcCon(c, s) - addResult(c, s.typ.sons[0], n.info, skProc) - let semBody = hloBody(c, semProcBody(c, n.sons[bodyPos])) - n.sons[bodyPos] = transformBody(c.module, semBody, s) - addResultNode(c, n) - popProcCon(c) - sideEffectsCheck(c, s) - else: - LocalError(n.info, errImplOfXexpected, s.name.s) - closeScope(c) # close scope for parameters - popOwner() - result.typ = s.typ + pushOwner(c, s) + addParams(c, params, skProc) + pushProcCon(c, 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) + # result = inferred.ast + # result.kind = arg.kind proc activate(c: PContext, n: PNode) = # XXX: This proc is part of my plan for getting rid of @@ -895,349 +2018,884 @@ 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: - nil + discard proc maybeAddResult(c: PContext, s: PSym, n: PNode) = - if s.typ.sons[0] != nil and - (s.kind != skIterator or 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 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, 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.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.firstParamType.skipTypes(abstractInst).elementType.skipTypes(abstractInst) + while true: + if t.kind == tyGenericBody: t = t.typeBodyImpl + elif t.kind == tyGenericInvocation: t = t.genericHead + else: break + if t.kind in {tyObject, tyDistinct, tyEnum, tySequence, tyString}: + if getAttachedOp(c.graph, t, attachedDeepCopy).isNil: + 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)) -type - TProcCompilationSteps = enum - stepRegisterSymbol, - stepDetermineType, - stepCompileBody + 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) + 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.returnType == nil and t.firstParamType.kind == tyVar: + var obj = t.firstParamType.elementType + while true: + incl(obj.flags, tfHasAsgn) + if obj.kind == tyGenericBody: obj = obj.skipModifier + elif obj.kind == tyGenericInvocation: obj = obj.genericHead + else: break + var objB = t[2] + while true: + if objB.kind == tyGenericBody: objB = objB.skipModifier + elif objB.kind in {tyGenericInvocation, tyGenericInst}: + objB = objB.genericHead + else: break + 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, + "type bound operation `" & name & "` can be defined only in the same module with its type (" & obj.typeToString() & ")") -proc isForwardDecl(s: PSym): bool = - InternalAssert s.kind == skProc - result = s.ast[bodyPos].kind != nkEmpty + 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 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 + +proc cursorInProc(conf: ConfigRef; n: PNode): bool = + if n.info.fileIndex == conf.m.trackPos.fileIndex: + result = cursorInProcAux(conf, n) + else: + result = false + +proc hasObjParam(s: PSym): bool = + result = false + var t = s.typ + for col in 1..<t.len: + if skipTypes(t[col], skipPtrs).kind == tyObject: + return true + +proc finishMethod(c: PContext, s: PSym) = + if hasObjParam(s): + methodDef(c.graph, c.idgen, s) + +proc semCppMember(c: PContext; s: PSym; n: PNode) = + if sfImportc notin s.flags: + let isVirtual = sfVirtual in s.flags + let isCtor = sfConstructor in s.flags + let pragmaName = if isVirtual: "virtual" elif isCtor: "constructor" else: "member" + if c.config.backend == backendCpp: + if s.typ.len < 2 and not isCtor: + localError(c.config, n.info, pragmaName & " must have at least one parameter") + for son in s.typ.signature: + if son!=nil and son.isMetaType: + localError(c.config, n.info, pragmaName & " unsupported for generic routine") + var typ: PType + if isCtor: + typ = s.typ.returnType + if typ == nil or typ.kind != tyObject: + localError(c.config, n.info, "constructor must return an object") + if sfImportc in typ.sym.flags: + localError(c.config, n.info, "constructor in an imported type needs importcpp pragma") + else: + typ = s.typ.firstParamType + if typ.kind == tyPtr and not isCtor: + typ = typ.elementType + if typ.kind != tyObject: + localError(c.config, n.info, pragmaName & " must be either ptr to object or object type.") + if typ.owner.id == s.owner.id and c.module.id == s.owner.id: + c.graph.memberProcsPerType.mgetOrPut(typ.itemId, @[]).add s + else: + localError(c.config, n.info, + pragmaName & " procs must be defined in the same scope as the type they are virtual for and it must be a top level scope") + else: + localError(c.config, n.info, pragmaName & " procs are only supported in C++") + else: + var typ = s.typ.returnType + if typ != nil and typ.kind == tyObject and typ.itemId notin c.graph.initializersPerType: + var initializerCall = newTree(nkCall, newSymNode(s)) + var isInitializer = n[paramsPos].len > 1 + for i in 1..<n[paramsPos].len: + let p = n[paramsPos][i] + let val = p[^1] + if val.kind == nkEmpty: + isInitializer = false + break + var j = 0 + while p[j].sym.kind == skParam: + initializerCall.add val + inc j + if isInitializer: + c.graph.initializersPerType[typ.itemId] = initializerCall + +proc semMethodPrototype(c: PContext; s: PSym; n: PNode) = + if s.isGenericRoutine: + let tt = s.typ + var foundObj = false + # we start at 1 for now so that tparsecombnum continues to compile. + # XXX Revisit this problem later. + for col in 1..<tt.len: + let t = tt[col] + if t != nil and t.kind == tyGenericInvocation: + 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 + 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[bodyPos].kind != nkEmpty: + if hasObjParam(s): + 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 = - result = semProcAnnotation(c, n) + validPragmas: TSpecialWords, flags: TExprFlags = {}): PNode = + result = semProcAnnotation(c, n, validPragmas) if result != nil: return result result = n - checkSonsLen(n, bodyPos + 1) + checkMinSonsLen(n, bodyPos + 1, c.config) + + let + isAnon = n[namePos].kind == nkEmpty + isHighlight = c.config.ideCmd == ideHighlight + var s: PSym - var typeIsDetermined = false - if n[namePos].kind != nkSym: - assert phase == stepRegisterSymbol - s = semIdentDef(c, n.sons[0], kind) - n.sons[namePos] = newSymNode(s) - s.ast = n - s.scope = c.currentScope - - if sfNoForward in c.module.flags and - sfSystemModule notin c.module.flags: - addInterfaceOverloadableSymAt(c, c.currentScope, s) - s.flags.incl sfForward - return - else: + + 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 - typeIsDetermined = s.typ == nil - # if typeIsDetermined: assert phase == stepCompileBody - # else: assert phase == stepDetermineType - # before compiling the proc body, set as current the scope + 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 + sfSystemModule notin c.module.flags: + addInterfaceOverloadableSymAt(c, c.currentScope, s) + s.flags.incl sfForward + return + + 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 params & body, set as current the scope # where the proc was declared - let oldScope = c.currentScope - c.currentScope = s.scope - pushOwner(s) + let declarationScope = c.currentScope + pushOwner(c, s) openScope(c) - 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) + # 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 = newTypeS(tyProc, c) - rawAddSon(s.typ, nil) - if n.sons[patternPos].kind != nkEmpty: - n.sons[patternPos] = semPattern(c, n.sons[patternPos]) - if s.kind == skIterator: s.typ.flags.incl(tfIterator) - - var proto = SearchForProc(c, s.scope, s) - if proto == nil: - s.typ.callConv = lastOptionEntry(c).defaultCC - # add it here, so that recursive procs are possible: - if sfGenSym in s.flags: nil - elif kind in OverloadableSyms: - if not typeIsDetermined: - addInterfaceOverloadableSymAt(c, s.scope, s) - else: - if not typeIsDetermined: - addInterfaceDeclAt(c, s.scope, s) - if n.sons[pragmasPos].kind != nkEmpty: - pragma(c, s, n.sons[pragmasPos], validPragmas) + 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[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, 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 + + if not hasProto and sfGenSym notin s.flags: #and not isAnon: + if s.kind in OverloadableSyms: + addInterfaceOverloadableSymAt(c, declarationScope, s) else: - implictPragmas(c, s, n, validPragmas) - else: - if n.sons[pragmasPos].kind != nkEmpty: - LocalError(n.sons[pragmasPos].info, errPragmaOnlyInHeaderOfProc) - if sfForward notin proto.flags: - WrongRedefinition(n.info, proto.name.s) - excl(proto.flags, sfForward) + 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: + 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(n.info, "semProcAux") - n.sons[namePos].sym = proto - if importantComments() 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() - pushOwner(s) - s.options = gOptions - if sfDestructor in s.flags: doDestructorStuff(c, s, n) - if n.sons[bodyPos].kind != nkEmpty: - # for DLL generation it is annoying to check for sfImportc! - if sfBorrow in s.flags: - LocalError(n.sons[bodyPos].info, errImplOfXNotAllowed, s.name.s) - if n.sons[genericParamsPos].kind == nkEmpty: - ParamsTypeCheck(c, s.typ) + popOwner(c) + pushOwner(c, s) + + 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) - maybeAddResult(c, s, n) - if sfImportc notin s.flags: - # no semantic checking for importc: - let semBody = hloBody(c, semProcBody(c, n.sons[bodyPos])) + 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) + 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': - n.sons[bodyPos] = transformBody(c.module, semBody, s) + trackProc(c, s, s.ast[bodyPos]) + else: + if (s.typ.returnType != nil and s.kind != skIterator): + addDecl(c, newSym(skUnknown, getIdent(c.cache, "result"), c.idgen, s, n.info)) + + openScope(c) + n[bodyPos] = semGenericStmt(c, n[bodyPos]) + closeScope(c) + if s.magic == mNone: + fixupInstantiatedSymbols(c, s) + if s.kind == skMethod: semMethodPrototype(c, s, n) popProcCon(c) - else: - if s.typ.sons[0] != nil and kind != skIterator: - addDecl(c, newSym(skUnknown, getIdent"result", nil, n.info)) - var toBind = initIntSet() - n.sons[bodyPos] = semGenericStmtScope(c, n.sons[bodyPos], {}, toBind) - fixupInstantiatedSymbols(c, s) - if sfImportc in s.flags: - # so we just ignore the body after semantic checking for importc: - n.sons[bodyPos] = ast.emptyNode else: - if proto != nil: LocalError(n.info, errImplOfXexpected, proto.name.s) - if {sfImportc, sfBorrow} * s.flags == {} and s.magic == mNone: + if s.kind == skMethod: semMethodPrototype(c, s, n) + 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() - if n.sons[patternPos].kind != nkEmpty: + # c.currentScope = oldScope + popOwner(c) + if n[patternPos].kind != nkEmpty: c.patterns.add(s) + if isAnon: + n.transitionSonsKind(nkLambda) + result.typ = s.typ + 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 - discard semProcAux(c, s.ast, s.kind, {}, stepDetermineType) + #if s.ast.isNil: return + discard semProcAux(c, s.ast, s.kind, {}) proc semIterator(c: PContext, n: PNode): PNode = + # gensym'ed iterator? + if n[namePos].kind == nkSym: + # gensym'ed iterators might need to become closure iterators: + n[namePos].sym.owner = getCurrOwner(c) + n[namePos].sym.transitionRoutineSymKind(skIterator) result = semProcAux(c, n, skIterator, iteratorPragmas) - var s = result.sons[namePos].sym + # 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[namePos].sym var t = s.typ - if t.sons[0] == nil and s.typ.callConv != ccClosure: - LocalError(n.info, errXNeedsReturnType, "iterator") + if t.returnType == nil and s.typ.callConv != ccClosure: + localError(c.config, n.info, "iterator needs a return type") # iterators are either 'inline' or 'closure'; for backwards compatibility, # we require first class iterators to be marked with 'closure' explicitly # -- at least for 0.9.2. if s.typ.callConv == ccClosure: incl(s.typ.flags, tfCapturesEnv) - when false: - if s.typ.callConv != ccInline: - s.typ.callConv = ccClosure - # and they always at least use the 'env' for the state field: - incl(s.typ.flags, tfCapturesEnv) - if n.sons[bodyPos].kind == nkEmpty and s.magic == mNone: - LocalError(n.info, errImplOfXexpected, s.name.s) - -proc semProc(c: PContext, n: PNode): PNode = + else: + s.typ.callConv = ccInline + if n[bodyPos].kind == nkEmpty and s.magic == mNone and c.inConceptDecl == 0: + localError(c.config, n.info, errImplOfXexpected % s.name.s) + 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 hasObjParam(s: PSym): bool = - var t = s.typ - for col in countup(1, sonsLen(t)-1): - if skipTypes(t.sons[col], skipPtrs).kind == tyObject: - return true - -proc finishMethod(c: PContext, s: PSym) = - if hasObjParam(s): - methodDef(s, false) +proc semFunc(c: PContext, n: PNode): PNode = + 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(n.info, errXOnlyAtModuleScope, "method") +proc semMethod(c: PContext, n: PNode): PNode = + if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "method") result = semProcAux(c, n, skMethod, methodPragmas) - - var s = result.sons[namePos].sym - if not isGenericRoutine(s): - if hasObjParam(s): - methodDef(s, false) - else: - LocalError(n.info, errXNeedsParamObjectType, "method") - -proc semConverterDef(c: PContext, n: PNode): PNode = - if not isTopLevel(c): LocalError(n.info, errXOnlyAtModuleScope, "converter") - checkSonsLen(n, bodyPos + 1) + # macros can transform converters to nothing: + if namePos >= result.safeLen: return result + # 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 != nkMethodDef: return + 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.returnType != nil and disp.typ.returnType.kind == tyUntyped: + let ret = s.typ.returnType + disp.typ.setReturnType ret + if disp.ast[resultPos].kind == nkSym: + if isEmptyType(ret): disp.ast[resultPos] = c.graph.emptyNode + else: disp.ast[resultPos].sym.typ = ret + +proc semConverterDef(c: PContext, n: PNode): PNode = + if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "converter") result = semProcAux(c, n, skConverter, converterPragmas) - var s = result.sons[namePos].sym + # macros can transform converters to nothing: + if namePos >= result.safeLen: return result + # 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 != nkConverterDef: return + var s = result[namePos].sym var t = s.typ - if t.sons[0] == nil: LocalError(n.info, errXNeedsReturnType, "converter") - if sonsLen(t) != 2: LocalError(n.info, errXRequiresOneArgument, "converter") - 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) +proc semMacroDef(c: PContext, n: PNode): PNode = result = semProcAux(c, n, skMacro, macroPragmas) - var s = result.sons[namePos].sym + # macros can transform macros to nothing: + if namePos >= result.safeLen: return result + # 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 != nkMacroDef: return + var s = result[namePos].sym var t = s.typ - if t.sons[0] == nil: LocalError(n.info, errXNeedsReturnType, "macro") - if n.sons[bodyPos].kind == nkEmpty: - LocalError(n.info, errImplOfXexpected, s.name.s) - + var allUntyped = true + var nullary = true + for i in 1..<t.n.len: + let param = t.n[i].sym + if param.typ.kind != tyUntyped: allUntyped = false + # no default value, parameters required in call + if param.ast == nil: nullary = false + if allUntyped: incl(s.flags, sfAllUntyped) + if nullary and n[genericParamsPos].kind == nkEmpty: + # macro can be called with alias syntax, remove pushed noalias flag + excl(s.flags, sfNoalias) + if n[bodyPos].kind == nkEmpty: + localError(c.config, n.info, errImplOfXexpected % s.name.s) + +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(n.sons[i]) - if f != InvalidFileIDX: - if ContainsOrIncl(c.includedFiles, f): - LocalError(n.info, errRecursiveDependencyX, f.toFilename) + 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, gIncludeFile(c.module, f))) - Excl(c.includedFiles, f) - -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 = semStmt(c, n.sons[1]) - for i in 0 .. <pragmaList.len: - if whichPragma(pragmaList.sons[i]) == wLine: - setLine(result, pragmaList.sons[i].info) + 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 = - let a = semStmt(c, n.sons[0]) - result = evalStaticExpr(c.module, a, c.p.owner) - if result.isNil: - LocalError(n.info, errCannotInterpretNodeX, renderTree(n)) - result = emptyNode - elif result.kind == nkEmpty: + #echo "semStaticStmt" + #writeStackTrace() + inc c.inStaticContext + openScope(c) + let a = semStmt(c, n[0], {}) + closeScope(c) + dec c.inStaticContext + 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] = emptyNode + result[0] = c.graph.emptyNode proc usesResult(n: PNode): bool = # nkStmtList(expr) properly propagates the void context, # so we don't need to process that all over again: - if n.kind notin {nkStmtList, nkStmtListExpr} + procDefs: + if n.kind notin {nkStmtList, nkStmtListExpr, + nkMacroDef, nkTemplateDef} + procDefs: if isAtom(n): result = n.kind == nkSym and n.sym.kind == skResult elif n.kind == nkReturnStmt: result = true else: + result = false for c in n: if usesResult(c): return true - -proc semStmtList(c: PContext, n: PNode): PNode = - # these must be last statements in a block: - const - LastBlockStmts = {nkRaiseStmt, nkReturnStmt, nkBreakStmt, nkContinueStmt} + else: + result = false + +proc inferConceptStaticParam(c: PContext, inferred, n: PNode) = + var typ = inferred.typ + let res = semConstExpr(c, n) + if not sameType(res.typ, typ.base): + localError(c.config, n.info, + "cannot infer the concept parameter '%s', due to a type mismatch. " & + "attempt to equate '%s' and '%s'." % [inferred.renderTree, $res.typ, $typ.base]) + typ.n = res + +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): - case n.sons[i].kind - of nkFinally, nkExceptBranch: - # stand-alone finally and except blocks are - # transformed into regular try blocks: - # - # var f = fopen("somefile") | var f = fopen("somefile") - # finally: fclose(f) | try: - # ... | ... - # | finally: - # | fclose(f) - var tryStmt = newNodeI(nkTryStmt, n.sons[i].info) - var body = newNodeI(nkStmtList, n.sons[i].info) - if i < n.sonsLen - 1: - body.sons = n.sons[(i+1)..(-1)] - tryStmt.addSon(body) - tryStmt.addSon(n.sons[i]) - n.sons[i] = semTry(c, tryStmt) - n.sons.setLen(i+1) - return + 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 x.typ.kind + of tyBool: + 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 x[2].typ.isUnresolvedStatic: + inferConceptStaticParam(c, x[2], x[1]) + continue + + let verdict = semConstExpr(c, n[i]) + if verdict == nil or verdict.kind != nkIntLit or verdict.intVal == 0: + localError(c.config, result.info, "concept predicate failed") + of tyFromExpr: continue + else: discard + if n[i].typ == c.enforceVoidContext: #or usesResult(n[i]): + voidContext = true + n.typ = c.enforceVoidContext + 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[i], flags) else: - n.sons[i] = semExpr(c, n.sons[i]) - if n.sons[i].typ == EnforceVoidContext or usesResult(n.sons[i]): - voidContext = true - n.typ = EnforceVoidContext - elif i != last or voidContext: - discardCheck(n.sons[i]) - else: - n.typ = n.sons[i].typ - if not isEmptyType(n.typ): - n.kind = nkStmtListExpr - case n.sons[i].kind - of nkVarSection, nkLetSection: - let (outer, inner) = insertDestructors(c, n.sons[i]) - if outer != nil: - n.sons[i] = outer - for j in countup(i+1, length-1): - inner.addSon(SemStmt(c, n.sons[j])) - n.sons.setLen(i+1) - return - of LastBlockStmts: - for j in countup(i + 1, length - 1): - case n.sons[j].kind - of nkPragma, nkCommentStmt, nkNilLit, nkEmpty: nil - else: localError(n.sons[j].info, errStmtInvalidAfterReturn) - else: nil - if result.len == 1: - result = result.sons[0] - when false: - # a statement list (s; e) has the type 'e': - if result.kind == nkStmtList and result.len > 0: - var lastStmt = lastSon(result) - if lastStmt.kind != nkNilLit and not ImplicitlyDiscardable(lastStmt): - result.typ = lastStmt.typ - #localError(lastStmt.info, errGenerated, - # "Last expression must be explicitly returned if it " & - # "is discardable or discarded") - -proc SemStmt(c: PContext, n: PNode): PNode = - # now: simply an alias: - result = semExprNoType(c, n) - -proc semStmtScope(c: PContext, n: PNode): PNode = - openScope(c) - result = semStmt(c, n) - closeScope(c) + 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 + # concept bodies should be preserved as a stmt list: + c.matchedConcept == nil and + # also, don't make life complicated for macros. + # they will always expect a proper stmtlist: + nfBlockArg notin n.flags and + 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 68abc9aa6..817cb6249 100644 --- a/compiler/semtempl.nim +++ b/compiler/semtempl.nim @@ -1,7 +1,7 @@ # # -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -10,296 +10,520 @@ # included from sem.nim discard """ - hygienic templates: - - template `||` (a, b: expr): expr = + hygienic templates: + + template `||` (a, b: untyped): untyped = let aa = a - (if aa: aa else: b) - + if aa: aa else: b + var a, b: T - - a || b || a - + + echo a || b || a + Each evaluation context has to be different and we need to perform some form of preliminary symbol lookup in template definitions. Hygiene is a way to achieve lexical scoping at compile time. """ +const + errImplOfXNotAllowed = "implementation of '$1' is not allowed" + type TSymBinding = enum 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 + of wGensym: return spGenSym of wInject: return spInject - else: nil + else: discard 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: + while a != nil: + if a.kind != skModule: + inc(i) + if i > 1: break a = nextOverloadIter(o, c, n) - inc(i) - if i > 1: break + 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(n, s) + 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: nkClosedSymChoice else: nkOpenSymChoice - result = newNodeIT(kind, n.info, newTypeS(tyNone, c)) + let kind = if r == scClosed or n.kind == nkDotExpr: nkClosedSymChoice + else: nkOpenSymChoice + result = newNodeIT(kind, info, newTypeS(tyNone, c)) a = initOverloadIter(o, c, n) while a != nil: - incl(a.flags, sfUsed) - addSon(result, newSymNode(a, n.info)) + if a.kind != skModule and (not isField or sfGenSym notin a.flags): + incl(a.flags, sfUsed) + markOwnerModuleAsUsed(c, a) + result.add newSymNode(a, info) + onUse(info, a) a = nextOverloadIter(o, c, n) -proc semBindStmt(c: PContext, n: PNode, toBind: var TIntSet): PNode = - for i in 0 .. < n.len: - var a = n.sons[i] +proc semBindStmt(c: PContext, n: PNode, toBind: var IntSet): PNode = + 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! # This is however not true anymore for hygienic templates as semantic # processing for them changes the symbol table... - let s = QualifiedLookUp(c, a) + let s = qualifiedLookUp(c, a, {checkUndeclared}) if s != nil: # we need to mark all symbols: 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) - result = newNodeI(nkEmpty, n.info) - -proc semMixinStmt(c: PContext, n: PNode, toMixin: var TIntSet): PNode = - for i in 0 .. < n.len: - toMixin.incl(considerAcc(n.sons[i]).id) - result = newNodeI(nkEmpty, n.info) - -proc replaceIdentBySym(n: var PNode, s: PNode) = + illFormedAst(a, c.config) + +proc semMixinStmt(c: PContext, n: PNode, toMixin: var IntSet): PNode = + result = copyNode(n) + for i in 0..<n.len: + toMixin.incl(considerQuotedIdent(c, n[i]).id) + 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(n.sons[1], s) - of nkPragmaExpr: replaceIdentBySym(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) + else: illFormedAst(n, c.config) type - TemplCtx {.pure, final.} = object + TemplCtx = object c: PContext - toBind, toMixin: TIntSet + toBind, toMixin, toInject: IntSet owner: PSym + cursorInBody: bool # only for nimsuggest + scopeN: int + noGenSym: int + inTemplateHeader: int + +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 - 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 + result = (n, false) + let s = qualifiedLookUp(c.c, 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) - 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 + illFormedAst(n, c.c.config) + result = (n, false) proc semTemplBody(c: var TemplCtx, n: PNode): PNode -proc openScope(c: var TemplCtx) = openScope(c.c) -proc closeScope(c: var TemplCtx) = closeScope(c.c) +proc openScope(c: var TemplCtx) = + openScope(c.c) + +proc closeScope(c: var TemplCtx) = + closeScope(c.c) -proc semTemplBodyScope(c: var TemplCtx, n: PNode): PNode = +proc semTemplBodyScope(c: var TemplCtx, n: PNode): PNode = openScope(c) result = semTemplBody(c, n) closeScope(c) proc newGenSym(kind: TSymKind, n: PNode, c: var TemplCtx): PSym = - result = newSym(kind, considerAcc(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 or symBinding(n.sons[1]) != spInject: - let ident = getIdentNode(c, n) - if not isTemplParam(c, ident): - let local = newGenSym(k, ident, c) - addPrelimDecl(c.c, local) - replaceIdentBySym(n, newSymNode(local, n.info)) + # 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) + let (ident, hasParam) = getIdentReplaceParams(c, n) + if not hasParam: + if k != skField: + c.toInject.incl(considerQuotedIdent(c.c, ident).id) + else: + if (n.kind == nkPragmaExpr and n.len >= 2 and n[1].kind == nkPragma): + let pragmaNode = n[1] + for i in 0..<pragmaNode.len: + 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, n.info, local) + onDef(n.info, local) + replaceIdentBySym(c.c, n, newSymNode(local, n.info)) + if k == skParam and c.inTemplateHeader > 0: + local.flags.incl sfTemplateParam + +proc semTemplSymbol(c: var TemplCtx, n: PNode, s: PSym; isField, isAmbiguous: bool): PNode = + incl(s.flags, sfUsed) + # bug #12885; ideally sem'checking is performed again afterwards marking + # the symbol as used properly, but the nfSem mechanism currently prevents + # that from happening, so we mark the module as used here already: + markOwnerModuleAsUsed(c.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.c, n, s, scOpen, isField) + if not isField and result.kind in {nkSym, nkOpenSymChoice}: + if openSym in c.c.features: + if result.kind == nkSym: + result = newOpenSym(result) + else: + result.typ = nil + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil + of skGenericParam: + if isField and sfGenSym in s.flags: result = n + else: + result = newSymNodeTypeDesc(s, c.c.idgen, n.info) + if not isField and s.owner != c.owner: + if openSym in c.c.features: + result = newOpenSym(result) + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil + of skParam: + result = n + of skType: + if isField and sfGenSym in s.flags: result = n + else: + if isAmbiguous: + # ambiguous types should be symchoices since lookup behaves + # differently for them in regular expressions + result = symChoice(c.c, n, s, scOpen, isField) + else: result = newSymNodeTypeDesc(s, c.c.idgen, n.info) + if not isField and not (s.owner == c.owner and + s.typ != nil and s.typ.kind == tyGenericParam) and + result.kind in {nkSym, nkOpenSymChoice}: + if openSym in c.c.features: + if result.kind == nkSym: + result = newOpenSym(result) + else: + result.typ = nil + else: + result.flags.incl nfDisabledOpenSym + result.typ = nil + else: + if isField and sfGenSym in s.flags: result = n else: - replaceIdentBySym(n, ident) + 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, 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 and not explicitInject)): + incl(s.flags, sfUsed) + result = newSymNode(s, n.info) + onUse(n.info, s) else: - n = semTemplBody(c, n) + 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) - # 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) - n.sons[namePos] = newSymNode(s, n.sons[namePos].info) + checkSonsLen(n, bodyPos + 1, c.c.config) + 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] = semTemplBody(c, n.sons[namePos]) + n[namePos] = semRoutineInTemplName(c, n[namePos], binding == spInject) + # open scope for parameters + openScope(c) + 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) - for i in patternPos..bodyPos: - n.sons[i] = semTemplBody(c, n.sons[i]) + 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) = - for i in countup(ord(symkind == skConditional), sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if (a.kind != nkIdentDefs) and (a.kind != nkVarTuple): IllFormedAst(a) - checkMinSonsLen(a, 3) - var L = sonsLen(a) - a.sons[L-2] = semTemplBody(c, a.sons[L-2]) - a.sons[L-1] = semTemplBody(c, a.sons[L-1]) - for j in countup(0, L-3): - addLocalDecl(c, a.sons[j], symKind) - -proc semPattern(c: PContext, n: PNode): PNode -proc semTemplBody(c: var TemplCtx, n: PNode): PNode = +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; s: PSym): PNode + +proc semTemplBodySons(c: var TemplCtx, n: PNode): PNode = + result = n + for i in 0..<n.len: + result[i] = semTemplBody(c, n[i]) + +proc semTemplBody(c: var TemplCtx, n: PNode): PNode = result = n + semIdeForTemplateOrGenericCheck(c.c.config, n, c.cursorInBody) case n.kind of nkIdent: - let s = QualifiedLookUp(c.c, n, {}) + 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) - elif Contains(c.toBind, s.id): - result = symChoice(c.c, n, s, scClosed) - elif s.owner == c.owner and sfGenSym in s.flags: + onUse(n.info, s) + elif contains(c.toBind, s.id): + result = symChoice(c.c, n, s, scClosed, c.noGenSym > 0) + elif contains(c.toMixin, s.name.id): + 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) + onUse(n.info, s) + else: + 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: - result = semMixinStmt(c.c, n, c.toMixin) - of nkEmpty, nkSym..nkNilLit: - nil + if c.scopeN > 0: result = semTemplBodySons(c, n) + else: result = semMixinStmt(c.c, n, c.toMixin) + 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] - checkMinSonsLen(a, 1) - 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]) + n[0] = semTemplBody(c, n[0]) + for i in 1..<n.len: + var a = n[i] + checkMinSonsLen(a, 1, c.c.config) + 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) + of nkForStmt, nkParForStmt: + openScope(c) + 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-2] = semTemplBody(c, n.sons[L-2]) - for i in countup(0, L - 3): - addLocalDecl(c, n.sons[i], skForVar) - 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) + checkSonsLen(n, 2, c.c.config) openScope(c) - if n.sons[0].kind != nkEmpty: - # labels are always 'gensym'ed: - let s = newGenSym(skLabel, n.sons[0], c) - addPrelimDecl(c.c, s) - n.sons[0] = newSymNode(s, n.sons[0].info) - n.sons[1] = semTemplBody(c, n.sons[1]) + if n[0].kind != nkEmpty: + addLocalDecl(c, n[0], skLabel) + when false: + # labels are always 'gensym'ed: + let s = newGenSym(skLabel, n[0], c) + addPrelimDecl(c.c, s) + 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: - checkMinSonsLen(n, 2) - n.sons[0] = semTemplBodyScope(c, n.sons[0]) - for i in countup(1, sonsLen(n)-1): - var a = n.sons[i] - checkMinSonsLen(a, 1) - 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]) + of nkTryStmt, nkHiddenTryStmt: + checkMinSonsLen(n, 2, c.c.config) + n[0] = semTemplBodyScope(c, n[0]) + for i in 1..<n.len: + var a = n[i] + checkMinSonsLen(a, 1, c.c.config) + openScope(c) + 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[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 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) - checkSonsLen(a, 3) - addLocalDecl(c, a.sons[0], skConst) - a.sons[1] = semTemplBody(c, a.sons[1]) - a.sons[2] = semTemplBody(c, a.sons[2]) - of nkTypeSection: - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if (a.kind != nkTypeDef): IllFormedAst(a) - checkSonsLen(a, 3) - addLocalDecl(c, a.sons[0], skType) - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if (a.kind != nkTypeDef): IllFormedAst(a) - checkSonsLen(a, 3) - if a.sons[1].kind != nkEmpty: + of nkFormalParams: + checkMinSonsLen(n, 1, c.c.config) + semTemplSomeDecl(c, n, skParam, 1) + n[0] = semTemplBody(c, n[0]) + of nkConstSection: semTemplSomeDecl(c, n, skConst) + of nkTypeSection: + 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[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[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]) + else: + a[2] = semTemplBody(c, a[2]) + of nkObjectTy: + openScope(c) + result = semTemplBodySons(c, n) + closeScope(c) + of nkRecList: + for i in 0..<n.len: + var a = n[i] + case a.kind: + of nkCommentStmt, nkNilLit, nkSym, nkEmpty: continue + of nkIdentDefs: + semTemplIdentDef(c, a, skField) + of nkRecCase, nkRecWhen: + n[i] = semTemplBody(c, a) + else: + illFormedAst(a, c.c.config) + of nkRecCase: + semTemplIdentDef(c, n[0], skField) + for i in 1..<n.len: + n[i] = semTemplBody(c, n[i]) of nkProcDef, nkLambdaKinds: result = semRoutineInTemplBody(c, n, skProc) + of nkFuncDef: + result = semRoutineInTemplBody(c, n, skFunc) of nkMethodDef: result = semRoutineInTemplBody(c, n, skMethod) of nkIteratorDef: @@ -310,256 +534,384 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = result = semRoutineInTemplBody(c, n, skMacro) of nkConverterDef: result = semRoutineInTemplBody(c, n, skConverter) - else: - # dotExpr is ambiguous: note that we explicitely allow 'x.TemplateParam', + of nkPragmaExpr: + result[0] = semTemplBody(c, n[0]) + of nkPostfix: + result[1] = semTemplBody(c, n[1]) + of nkPragma: + for x in n: + if x.kind == nkExprColonExpr: + x[1] = semTemplBody(c, x[1]) + of nkBracketExpr: + 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: + 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, nkSinkAsgn: + checkSonsLen(n, 2, c.c.config) + let a = n[0] + let b = n[1] + + let k = a.kind + case k + of nkBracketExpr: + 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: + 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}: + # 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 - if n.kind == nkDotExpr or n.kind == nkAccQuoted: - let s = QualifiedLookUp(c.c, n, {}) - if s != nil: - if 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] = semTemplBody(c, n.sons[i]) + 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) + onUse(n.info, s) + return newSymNode(s, n.info) + elif contains(c.toBind, s.id): + return symChoice(c.c, n, s, scClosed, c.noGenSym > 0) + elif contains(c.toMixin, s.name.id): + return symChoice(c.c, n, s, scForceOpen, c.noGenSym > 0) + else: + 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) -proc semTemplBodyDirty(c: var TemplCtx, n: PNode): PNode = +proc semTemplBodyDirty(c: var TemplCtx, n: PNode): PNode = result = n + semIdeForTemplateOrGenericCheck(c.c.config, n, c.cursorInBody) case n.kind of nkIdent: - let s = QualifiedLookUp(c.c, n, {}) + let s = qualifiedLookUp(c.c, n, {}) if s != nil: if s.owner == c.owner and s.kind == skParam: result = newSymNode(s, n.info) - elif Contains(c.toBind, s.id): + 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: - nil + of nkEmpty, nkSym..nkNilLit, nkComesFrom: + discard else: - # dotExpr is ambiguous: note that we explicitely allow 'x.TemplateParam', + # dotExpr is ambiguous: note that we explicitly allow 'x.TemplateParam', # so we use the generic code for nkDotExpr too if n.kind == nkDotExpr or n.kind == nkAccQuoted: - let s = QualifiedLookUp(c.c, n, {}) - if s != nil and Contains(c.toBind, s.id): + let s = qualifiedLookUp(c.c, n, {}) + 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]) - -proc transformToExpr(n: PNode): PNode = - var realStmt: int - result = n - case n.kind - of nkStmtList: - realStmt = - 1 - for i in countup(0, sonsLen(n) - 1): - case n.sons[i].kind - of nkCommentStmt, nkEmpty, nkNilLit: - nil - else: - if realStmt == - 1: realStmt = i - else: realStmt = - 2 - if realStmt >= 0: result = transformToExpr(n.sons[realStmt]) - else: n.kind = nkStmtListExpr - of nkBlockStmt: - n.kind = nkBlockExpr - #nkIfStmt: n.kind = nkIfExpr // this is not correct! - else: - nil + for i in 0..<n.len: + result[i] = semTemplBodyDirty(c, n[i]) -proc semTemplateDef(c: PContext, n: PNode): PNode = +# 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 c.p.owner.kind == skModule: - s = semIdentVis(c, skTemplate, n.sons[0], {sfExported}) + if isTopLevel(c): + s = semIdentVis(c, skTemplate, n[namePos], {sfExported}) incl(s.flags, sfGlobal) else: - s = semIdentVis(c, skTemplate, n.sons[0], {}) + s = semIdentVis(c, skTemplate, n[namePos], {}) + assert s.kind == skTemplate + + styleCheckDef(c, s) + onDef(n[namePos].info, s) # check parameter list: - pushOwner(s) + #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: - 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 - # 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]) + var allUntyped = true + var nullary = true + if n[paramsPos].kind != nkEmpty: + semParamList(c, n[paramsPos], n[genericParamsPos], s) + # a template's parameters are not gensym'ed even if that was originally the + # case as we determine whether it's a template parameter in the template + # body by the absence of the sfGenSym flag: + let retType = s.typ.returnType + if retType != nil and retType.kind != tyUntyped: + allUntyped = false + for i in 1..<s.typ.n.len: + let param = s.typ.n[i].sym + 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])) - if n.sons[patternPos].kind != nkEmpty: - n.sons[patternPos] = semPattern(c, n.sons[patternPos]) - var ctx: TemplCtx - ctx.toBind = initIntSet() - ctx.toMixin = initIntSet() - ctx.c = c - ctx.owner = s + 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 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]) - if s.typ.sons[0].kind notin {tyStmt, tyTypeDesc}: - n.sons[bodyPos] = transformToExpr(n.sons[bodyPos]) - # only parameters are resolved, no type checking is performed + n[bodyPos] = semTemplBody(ctx, n[bodyPos]) + # only parameters are resolved, no type checking is performed + semIdeForTemplateOrGeneric(c, n[bodyPos], ctx.cursorInBody) closeScope(c) - popOwner() - s.ast = n - result = n - if n.sons[bodyPos].kind == nkEmpty: - LocalError(n.info, errImplOfXexpected, s.name.s) - var proto = SearchForProc(c, c.currentScope, s) + popOwner(c) + + if sfCustomPragma in s.flags: + 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, comesFromShadowscope) = searchForProc(c, c.currentScope, s) if proto == nil: addInterfaceOverloadableSymAt(c, c.currentScope, s) - else: - SymTabReplace(c.currentScope.symbols, proto, s) - if n.sons[patternPos].kind != nkEmpty: + elif not comesFromShadowscope: + if {sfTemplateRedefinition, sfGenSym} * s.flags == {}: + #wrongRedefinition(c, n.info, proto.name.s, proto.info) + message(c.config, n.info, warnImplicitTemplateRedefinition, s.name.s) + symTabReplace(c.currentScope.symbols, proto, s) + if n[patternPos].kind != nkEmpty: c.patterns.add(s) proc semPatternBody(c: var TemplCtx, n: PNode): PNode = - template templToExpand(s: expr): expr = - s.kind == skTemplate and (s.typ.len == 1 or sfImmediate in s.flags) - + template templToExpand(s: untyped): untyped = + s.kind == skTemplate and (s.typ.len == 1 or sfAllUntyped in s.flags) + proc newParam(c: var TemplCtx, n: PNode, s: PSym): PNode = # the param added in the current scope is actually wrong here for # macros because they have a shadowed param of type 'PNimNode' (see # semtypes.addParamOrResult). Within the pattern we have to ensure # to use the param with the proper type though: incl(s.flags, sfUsed) - 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) - + proc handleSym(c: var TemplCtx, n: PNode, s: PSym): PNode = result = n if s != nil: if s.owner == c.owner and s.kind == skParam: result = newParam(c, n, s) - elif Contains(c.toBind, s.id): + elif contains(c.toBind, s.id): result = symChoice(c.c, n, s, scClosed) elif templToExpand(s): - result = semPatternBody(c, semTemplateExpr(c.c, n, s, false)) + result = semPatternBody(c, semTemplateExpr(c.c, n, s, {efNoSemCheck})) else: - nil + discard # we keep the ident unbound for matching instantiated symbols and # more flexibility - + proc expectParam(c: var TemplCtx, n: PNode): PNode = - let s = QualifiedLookUp(c.c, n, {}) + let s = qualifiedLookUp(c.c, n, {}) if s != nil and s.owner == c.owner and s.kind == skParam: result = newParam(c, n, s) else: - localError(n.info, errInvalidExpression) + localError(c.c.config, n.info, "invalid expression") result = n - + result = n case n.kind of nkIdent: - let s = QualifiedLookUp(c.c, n, {}) + let s = qualifiedLookUp(c.c, n, {}) result = handleSym(c, n, s) of nkBindStmt: result = semBindStmt(c.c, n, c.toBind) - of nkEmpty, nkSym..nkNilLit: nil + of nkEmpty, nkSym..nkNilLit: discard of nkCurlyExpr: - # we support '(pattern){x}' to bind a subpattern to a parameter 'x'; + # we support '(pattern){x}' to bind a subpattern to a parameter 'x'; # '(pattern){|x}' does the same but the matches will be gathered in 'x' if n.len != 2: - localError(n.info, errInvalidExpression) - 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] + localError(c.c.config, n.info, "invalid expression") + 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(n.info, errInvalidExpression) + localError(c.c.config, n.info, "invalid expression") + else: + localError(c.c.config, n.info, "invalid expression") + of nkStmtList, nkStmtListExpr: + if stupidStmtListExpr(n): + result = semPatternBody(c, n.lastSon) else: - localError(n.info, errInvalidExpression) + 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: nil - elif Contains(c.toBind, s.id): 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, false)) - - if n.kind == nkInfix and n.sons[0].kind == nkIdent: + return semPatternBody(c, semTemplateExpr(c.c, n, s, {efNoSemCheck})) + + 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 explicitely allow 'x.TemplateParam', + # dotExpr is ambiguous: note that we explicitly allow 'x.TemplateParam', # so we use the generic code for nkDotExpr too - case n.kind + case n.kind of nkDotExpr, nkAccQuoted: - let s = QualifiedLookUp(c.c, n, {}) + let s = qualifiedLookUp(c.c, n, {}) if s != nil: - if Contains(c.toBind, s.id): + if contains(c.toBind, s.id): return symChoice(c.c, n, s, scClosed) else: return newIdentNode(s.name, n.info) of nkPar: - if n.len == 1: return semPatternBody(c, n.sons[0]) - else: nil - for i in countup(0, sonsLen(n) - 1): - result.sons[i] = semPatternBody(c, n.sons[i]) + if n.len == 1: return semPatternBody(c, n[0]) + else: discard + 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.c = c - ctx.owner = getCurrOwner() + 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(n.info, errInvalidExpression) + localError(c.config, n.info, "a pattern cannot be empty") closeScope(c) + addPattern(c, LazySym(sym: s)) diff --git a/compiler/semthreads.nim b/compiler/semthreads.nim deleted file mode 100644 index 6f24e1f6d..000000000 --- a/compiler/semthreads.nim +++ /dev/null @@ -1,391 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Semantic analysis that deals with threads: Possible race conditions should -## be reported some day. -## -## -## ======================== -## No heap sharing analysis -## ======================== -## -## The only crucial operation that can violate the heap invariants is the -## write access. The analysis needs to distinguish between 'unknown', 'mine', -## and 'theirs' memory and pointers. Assignments 'whatever <- unknown' are -## invalid, and so are 'theirs <- whatever' but not 'mine <- theirs'. Since -## strings and sequences are heap allocated they are affected too: -## -## .. code-block:: nimrod -## proc p() = -## global = "alloc this string" # ugh! -## -## Thus the analysis is concerned with any type that contains a GC'ed -## reference... -## If the type system would distinguish between 'ref' and '!ref' and threads -## could not have '!ref' as input parameters the analysis could simply need to -## reject any write access to a global variable which contains GC'ed data. -## Thanks to the write barrier of the GC, this is exactly what needs to be -## done! Every write access to a global that contains GC'ed data needs to -## be prevented! Unfortunately '!ref' is not implemented yet... -## -## The assignment target is essential for the algorithm: only -## write access to heap locations and global variables are critical and need -## to be checked. Access via 'var' parameters is no problem to analyse since -## we need the arguments' locations in the analysis. -## -## However, this is tricky: -## -## var x = globalVar # 'x' points to 'theirs' -## while true: -## globalVar = x # NOT OK: 'theirs <- theirs' invalid due to -## # write barrier! -## x = "new string" # ugh: 'x is toUnknown'! -## -## --> Solution: toUnknown is never allowed anywhere! -## -## -## Beware that the same proc might need to be -## analysed multiple times! Oh and watch out for recursion! Recursion is handled -## by a stack of symbols that we are processing, if we come back to the same -## symbol, we have to skip this check (assume no error in the recursive case). -## However this is wrong. We need to check for the particular combination -## of (procsym, threadOwner(arg1), threadOwner(arg2), ...)! - -import - ast, astalgo, strutils, hashes, options, msgs, idents, types, os, - renderer, tables, rodread - -type - TThreadOwner = enum - toUndefined, # not computed yet - toVoid, # no return type - toNil, # cycle in computation or nil: can be overwritten - toTheirs, # some other heap - toMine # mine heap - - TCall = object {.pure.} - callee: PSym # what if callee is an indirect call? - args: seq[TThreadOwner] - - PProcCtx = ref TProcCtx - TProcCtx = object {.pure.} - nxt: PProcCtx # can be stacked - mapping: tables.TTable[int, TThreadOwner] # int = symbol ID - owner: PSym # current owner - -var - computed = tables.initTable[TCall, TThreadOwner]() - -proc hash(c: TCall): THash = - result = hash(c.callee.id) - for a in items(c.args): result = result !& hash(ord(a)) - result = !$result - -proc `==`(a, b: TCall): bool = - if a.callee != b.callee: return - if a.args.len != b.args.len: return - for i in 0..a.args.len-1: - if a.args[i] != b.args[i]: return - result = true - -proc newProcCtx(owner: PSym): PProcCtx = - assert owner != nil - new(result) - result.mapping = tables.InitTable[int, TThreadOwner]() - result.owner = owner - -proc analyse(c: PProcCtx, n: PNode): TThreadOwner - -proc analyseSym(c: PProcCtx, n: PNode): TThreadOwner = - var v = n.sym - result = c.mapping[v.id] - if result != toUndefined: return - case v.kind - of skVar, skForVar, skLet, skResult: - result = toNil - if sfGlobal in v.flags: - if sfThread in v.flags: - result = toMine - elif containsGarbageCollectedRef(v.typ): - result = toTheirs - of skTemp: result = toNil - of skConst: result = toMine - of skParam: - result = c.mapping[v.id] - if result == toUndefined: - InternalError(n.info, "param not set: " & v.name.s) - else: - result = toNil - c.mapping[v.id] = result - -proc lvalueSym(n: PNode): PNode = - result = n - while result.kind in {nkDotExpr, nkCheckedFieldExpr, - nkBracketExpr, nkDerefExpr, nkHiddenDeref}: - result = result.sons[0] - -proc writeAccess(c: PProcCtx, n: PNode, owner: TThreadOwner) = - if owner notin {toNil, toMine, toTheirs}: - InternalError(n.info, "writeAccess: " & $owner) - var a = lvalueSym(n) - if a.kind == nkSym: - var v = a.sym - var lastOwner = analyseSym(c, a) - case lastOwner - of toNil: - # fine, toNil can be overwritten - var newOwner: TThreadOwner - if sfGlobal in v.flags: - newOwner = owner - elif containsTyRef(v.typ): - # ``var local = gNode`` --> ok, but ``local`` is theirs! - newOwner = owner - else: - # ``var local = gString`` --> string copy: ``local`` is mine! - newOwner = toMine - # XXX BUG what if the tuple contains both ``tyRef`` and ``tyString``? - c.mapping[v.id] = newOwner - of toVoid, toUndefined: InternalError(n.info, "writeAccess") - of toTheirs: Message(n.info, warnWriteToForeignHeap) - of toMine: - if lastOwner != owner and owner != toNil: - Message(n.info, warnDifferentHeaps) - else: - # we could not backtrack to a concrete symbol, but that's fine: - var lastOwner = analyse(c, n) - case lastOwner - of toNil: nil # fine, toNil can be overwritten - of toVoid, toUndefined: InternalError(n.info, "writeAccess") - of toTheirs: Message(n.info, warnWriteToForeignHeap) - of toMine: - if lastOwner != owner and owner != toNil: - Message(n.info, warnDifferentHeaps) - -proc analyseAssign(c: PProcCtx, le, ri: PNode) = - var y = analyse(c, ri) # read access; ok - writeAccess(c, le, y) - -proc analyseAssign(c: PProcCtx, n: PNode) = - analyseAssign(c, n.sons[0], n.sons[1]) - -proc analyseCall(c: PProcCtx, n: PNode): TThreadOwner = - var prc = n[0].sym - var newCtx = newProcCtx(prc) - var call: TCall - call.callee = prc - newSeq(call.args, n.len-1) - for i in 1..n.len-1: - call.args[i-1] = analyse(c, n[i]) - if not computed.hasKey(call): - computed[call] = toUndefined # we are computing it - let prctyp = skipTypes(prc.typ, abstractInst).n - for i in 1.. prctyp.len-1: - var formal = prctyp.sons[i].sym - newCtx.mapping[formal.id] = call.args[i-1] - pushInfoContext(n.info) - result = analyse(newCtx, prc.getBody) - if prc.ast.sons[bodyPos].kind == nkEmpty and - {sfNoSideEffect, sfThread, sfImportc} * prc.flags == {}: - Message(n.info, warnAnalysisLoophole, renderTree(n)) - if result == toUndefined: result = toNil - if prc.typ.sons[0] != nil: - if prc.ast.len > resultPos: - result = newCtx.mapping[prc.ast.sons[resultPos].sym.id] - # if the proc body does not set 'result', nor 'return's something - # explicitely, it returns a binary zero, so 'toNil' is correct: - if result == toUndefined: result = toNil - else: - result = toNil - else: - result = toVoid - computed[call] = result - popInfoContext() - else: - result = computed[call] - if result == toUndefined: - # ugh, cycle! We are already computing it but don't know the - # outcome yet... - if prc.typ.sons[0] == nil: result = toVoid - else: result = toNil - -proc analyseVarTuple(c: PProcCtx, n: PNode) = - if n.kind != nkVarTuple: InternalError(n.info, "analyseVarTuple") - var L = n.len - for i in countup(0, L-3): AnalyseAssign(c, n.sons[i], n.sons[L-1]) - -proc analyseSingleVar(c: PProcCtx, a: PNode) = - if a.sons[2].kind != nkEmpty: AnalyseAssign(c, a.sons[0], a.sons[2]) - -proc analyseVarSection(c: PProcCtx, n: PNode): TThreadOwner = - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if a.kind == nkCommentStmt: continue - if a.kind == nkIdentDefs: - #assert(a.sons[0].kind == nkSym); also valid for after - # closure transformation: - analyseSingleVar(c, a) - else: - analyseVarTuple(c, a) - result = toVoid - -proc analyseConstSection(c: PProcCtx, t: PNode): TThreadOwner = - for i in countup(0, sonsLen(t) - 1): - var it = t.sons[i] - if it.kind == nkCommentStmt: continue - if it.kind != nkConstDef: InternalError(t.info, "analyseConstSection") - if sfFakeConst in it.sons[0].sym.flags: analyseSingleVar(c, it) - result = toVoid - -template aggregateOwner(result, ana: expr) = - var a = ana # eval once - if result != a: - if result == toNil: result = a - elif a != toNil: Message(n.info, warnDifferentHeaps) - -proc analyseArgs(c: PProcCtx, n: PNode, start = 1) = - for i in start..n.len-1: discard analyse(c, n[i]) - -proc analyseOp(c: PProcCtx, n: PNode): TThreadOwner = - if n[0].kind != nkSym or n[0].sym.kind != skProc: - if {tfNoSideEffect, tfThread} * n[0].typ.flags == {}: - Message(n.info, warnAnalysisLoophole, renderTree(n)) - result = toNil - else: - var prc = n[0].sym - case prc.magic - of mNone: - if sfSystemModule in prc.owner.flags: - # System module proc does no harm :-) - analyseArgs(c, n) - if prc.typ.sons[0] == nil: result = toVoid - else: result = toNil - else: - result = analyseCall(c, n) - of mNew, mNewFinalize, mNewSeq, mSetLengthStr, mSetLengthSeq, - mAppendSeqElem, mReset, mAppendStrCh, mAppendStrStr: - writeAccess(c, n[1], toMine) - result = toVoid - of mSwap: - var a = analyse(c, n[2]) - writeAccess(c, n[1], a) - writeAccess(c, n[2], a) - result = toVoid - of mIntToStr, mInt64ToStr, mFloatToStr, mBoolToStr, mCharToStr, - mCStrToStr, mStrToStr, mEnumToStr, - mConStrStr, mConArrArr, mConArrT, - mConTArr, mConTT, mSlice, - mRepr, mArrToSeq, mCopyStr, mCopyStrLast, - mNewString, mNewStringOfCap: - analyseArgs(c, n) - result = toMine - else: - # don't recurse, but check args: - analyseArgs(c, n) - if prc.typ.sons[0] == nil: result = toVoid - else: result = toNil - -proc analyse(c: PProcCtx, n: PNode): TThreadOwner = - case n.kind - of nkCall, nkInfix, nkPrefix, nkPostfix, nkCommand, - nkCallStrLit, nkHiddenCallConv: - result = analyseOp(c, n) - of nkAsgn, nkFastAsgn: - analyseAssign(c, n) - result = toVoid - of nkSym: result = analyseSym(c, n) - of nkEmpty, nkNone: result = toVoid - of nkNilLit, nkCharLit..nkFloat64Lit: result = toNil - of nkStrLit..nkTripleStrLit: result = toMine - of nkDotExpr, nkBracketExpr, nkDerefExpr, nkHiddenDeref: - # field access: - # pointer deref or array access: - result = analyse(c, n.sons[0]) - of nkBind: result = analyse(c, n.sons[0]) - of nkPar, nkCurly, nkBracket, nkRange: - # container construction: - result = toNil # nothing until later - for i in 0..n.len-1: aggregateOwner(result, analyse(c, n[i])) - of nkObjConstr: - if n.typ != nil and containsGarbageCollectedRef(n.typ): - result = toMine - else: - result = toNil # nothing until later - for i in 1..n.len-1: aggregateOwner(result, analyse(c, n[i])) - of nkAddr, nkHiddenAddr: - var a = lvalueSym(n) - if a.kind == nkSym: - result = analyseSym(c, a) - assert result in {toNil, toMine, toTheirs} - if result == toNil: - # assume toMine here for consistency: - c.mapping[a.sym.id] = toMine - result = toMine - else: - # should never really happen: - result = analyse(c, n.sons[0]) - of nkIfExpr: - result = toNil - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - case it.kind - of nkElifExpr: - discard analyse(c, it.sons[0]) - aggregateOwner(result, analyse(c, it.sons[1])) - of nkElseExpr: - aggregateOwner(result, analyse(c, it.sons[0])) - else: internalError(n.info, "analyseIfExpr()") - of nkStmtListExpr, nkBlockExpr: - var n = if n.kind == nkBlockExpr: n.sons[1] else: n - var L = sonsLen(n) - for i in countup(0, L-2): discard analyse(c, n.sons[i]) - if L > 0: result = analyse(c, n.sons[L-1]) - else: result = toVoid - of nkHiddenStdConv, nkHiddenSubConv, nkConv, nkCast: - result = analyse(c, n.sons[1]) - of nkStringToCString, nkCStringToString, nkChckRangeF, nkChckRange64, - nkChckRange, nkCheckedFieldExpr, nkObjDownConv, - nkObjUpConv: - result = analyse(c, n.sons[0]) - of nkRaiseStmt: - var a = analyse(c, n.sons[0]) - if a != toMine: Message(n.info, warnDifferentHeaps) - result = toVoid - of nkVarSection, nkLetSection: result = analyseVarSection(c, n) - of nkConstSection: result = analyseConstSection(c, n) - of nkTypeSection, nkCommentStmt: result = toVoid - of nkIfStmt, nkWhileStmt, nkTryStmt, nkCaseStmt, nkStmtList, nkBlockStmt, - nkElifBranch, nkElse, nkExceptBranch, nkOfBranch: - for i in 0 .. <n.len: discard analyse(c, n[i]) - result = toVoid - of nkBreakStmt, nkContinueStmt: result = toVoid - of nkReturnStmt, nkDiscardStmt: - if n.sons[0].kind != nkEmpty: result = analyse(c, n.sons[0]) - else: result = toVoid - of nkLambdaKinds, nkClosure: - result = toMine - of nkAsmStmt, nkPragma, nkIteratorDef, nkProcDef, nkMethodDef, - nkConverterDef, nkMacroDef, nkTemplateDef, - nkGotoState, nkState, nkBreakState, nkType: - result = toVoid - of nkExprColonExpr: - result = analyse(c, n.sons[1]) - else: InternalError(n.info, "analysis not implemented for: " & $n.kind) - -proc analyseThreadProc*(prc: PSym) = - var c = newProcCtx(prc) - var formals = skipTypes(prc.typ, abstractInst).n - for i in 1 .. formals.len-1: - var formal = formals.sons[i].sym - c.mapping[formal.id] = toTheirs # thread receives foreign data! - discard analyse(c, prc.getBody) - -proc needsGlobalAnalysis*: bool = - result = gGlobalOptions * {optThreads, optThreadAnalysis} == - {optThreads, optThreadAnalysis} - diff --git a/compiler/semtypes.nim b/compiler/semtypes.nim index 7efa207a8..113946fef 100644 --- a/compiler/semtypes.nim +++ b/compiler/semtypes.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -10,1057 +10,2453 @@ # this module does the semantic checking of type declarations # included from sem.nim -proc newOrPrevType(kind: TTypeKind, prev: PType, c: PContext): PType = - if prev == nil: +const + errStringOrIdentNodeExpected = "string or ident node expected" + errStringLiteralExpected = "string literal expected" + errIntLiteralExpected = "integer literal expected" + errWrongNumberOfVariables = "wrong number of variables" + 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'" + errXCannotBeAssignedTo = "'$1' cannot be assigned to" + errIteratorNotAllowed = "iterators can only be defined at the module's top level" + errXNeedsReturnType = "$1 needs a return type" + errNoReturnTypeDeclared = "no return type declared" + errTIsNotAConcreteType = "'$1' is not a concrete type" + errTypeExpected = "type expected" + errXOnlyAtModuleScope = "'$1' is only allowed at top level" + errDuplicateCaseLabel = "duplicate case label" + errMacroBodyDependsOnGenericTypes = "the macro body cannot be compiled, " & + "because the parameter '$1' has a generic type" + errIllegalRecursionInTypeX = "illegal recursion in type '$1'" + 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 or prev.kind == tyGenericBody: result = newTypeS(kind, c) - else: + else: result = prev if result.kind == tyForward: result.kind = kind -proc newConstraint(c: PContext, k: TTypeKind): PType = - result = newTypeS(tyTypeClass, c) - result.addSonSkipIntLit(newTypeS(k, c)) +proc newConstraint(c: PContext, k: TTypeKind): PType = + result = newTypeS(tyBuiltInTypeClass, 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) + 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) - if n.sons[0].kind != nkEmpty: - base = semTypeNode(c, n.sons[0].sons[0], nil) - if base.kind != tyEnum: - localError(n.sons[0].info, errInheritanceOnlyWithEnums) - counter = lastOrd(base) + 1 + checkMinSonsLen(n, 1, c.config) + if n[0].kind != nkEmpty: + base = semTypeNode(c, n[0][0], nil) + if base.kind != tyEnum: + 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 = initStrTable() var hasNull = false - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind - of nkEnumFieldDef: - e = newSymS(skEnumField, n.sons[i].sons[0], c) - var v = semConstExpr(c, n.sons[i].sons[1]) + for i in 1..<n.len: + if n[i].kind == nkEmpty: continue + var useAutoCounter = false + case n[i].kind + of nkEnumFieldDef: + if n[i][0].kind == nkPragmaExpr: + 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 + case skipTypes(v.typ, abstractInst-{tyTypeDesc}).kind + of tyTuple: + if v.len == 2: + strVal = v[1] # second tuple part is the string value if skipTypes(strVal.typ, abstractInst).kind in {tyString, tyCstring}: - x = getOrdValue(v.sons[0]) # first tuple part is the ordinal + 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(strVal.info, errStringLiteralExpected) + localError(c.config, strVal.info, errStringLiteralExpected) else: - LocalError(v.info, errWrongNumberOfVariables) + localError(c.config, v.info, errWrongNumberOfVariables) 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(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 - of nkIdent: - e = newSymS(skEnumField, n.sons[i], c) - else: illFormedAst(n) + of nkSym: + e = n[i].sym + useAutoCounter = true + of nkIdent, nkAccQuoted: + e = newSymS(skEnumField, n[i], c) + identToReplace = addr n[i] + useAutoCounter = true + of nkPragmaExpr: + e = newSymS(skEnumField, n[i][0], c) + pragma(c, e, n[i][1], enumFieldPragmas) + identToReplace = addr n[i][0] + useAutoCounter = true + else: + illFormedAst(n[i], c.config) + + if useAutoCounter: + while counter in counterSet and counter != high(typeof(counter)): + inc counter + counterSet.incl counter + elif counterSet.containsOrIncl(counter): + localError(c.config, n[i].info, errDuplicateAliasInEnumX % e.name.s) + e.typ = result e.position = int(counter) + let symNode = newSymNode(e) + if 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)) - if sfGenSym notin e.flags and not isPure: addDecl(c, e) - inc(counter) - if not hasNull: incl(result.flags, tfNeedsInit) - -proc semSet(c: PContext, n: PNode, prev: PType): PType = + 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: + 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 == tyGenericInst: base = lastSon(base) - if base.kind != tyGenericParam: - if not isOrdinalType(base): - LocalError(n.info, errOrdinalTypeExpected) - elif lengthOrd(base) > MaxSetElements: - LocalError(n.info, errSetTooBig) + 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(n.info, errXExpectsOneTypeParam, "set") - addSonSkipIntLit(result, errorType(c)) - -proc semContainer(c: PContext, n: PNode, kind: TTypeKind, kindStr: string, - prev: PType): PType = + localError(c.config, n.info, errXExpectsOneTypeParam % "set") + addSonSkipIntLit(result, errorType(c), c.idgen) + +proc semContainerArg(c: PContext; n: PNode, kindStr: string; result: PType) = + if n.len == 2: + var base = semTypeNode(c, n[1], nil) + if base.kind == tyVoid: + localError(c.config, n.info, errTIsNotAConcreteType % typeToString(base)) + addSonSkipIntLit(result, base, c.idgen) + else: + localError(c.config, n.info, errXExpectsOneTypeParam % kindStr) + 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) - addSonSkipIntLit(result, base) - else: - LocalError(n.info, errXExpectsOneTypeParam, kindStr) - addSonSkipIntLit(result, errorType(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(considerAcc(n.sons[2]), n.sons[2].info) - else: - LocalError(n.info, errXExpectsOneTypeParam, "varargs") - addSonSkipIntLit(result, errorType(c)) - -proc semAnyRef(c: PContext, n: PNode, kind: TTypeKind, prev: PType): PType = - if sonsLen(n) == 1: - result = newOrPrevType(kind, prev, c) - var base = semTypeNode(c, n.sons[0], nil) - addSonSkipIntLit(result, base) + 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: - result = newConstraint(c, kind) - -proc semVarType(c: PContext, n: PNode, prev: PType): PType = - if sonsLen(n) == 1: + localError(c.config, n.info, errXExpectsOneTypeParam % "varargs") + addSonSkipIntLit(result, errorType(c), c.idgen) + +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) - if base.kind == tyVar: - LocalError(n.info, errVarVarTypeNotAllowed) - base = base.sons[0] - addSonSkipIntLit(result, base) + 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[0] + addSonSkipIntLit(result, base, c.idgen) else: result = newConstraint(c, tyVar) - -proc semDistinct(c: PContext, n: PNode, prev: PType): PType = - if sonsLen(n) == 1: - result = newOrPrevType(tyDistinct, prev, c) - addSonSkipIntLit(result, semTypeNode(c, n.sons[0], nil)) + +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: - result = newConstraint(c, tyDistinct) - -proc semRangeAux(c: PContext, n: PNode, prev: PType): PType = - assert IsRange(n) - checkSonsLen(n, 3) + 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) + 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 = + assert isRange(n) + checkSonsLen(n, 3, c.config) result = newOrPrevType(tyRange, prev, c) result.n = newNodeI(nkRange, n.info) - if (n[1].kind == nkEmpty) or (n[2].kind == nkEmpty): - LocalError(n.Info, errRangeIsEmpty) - var a = semConstExpr(c, n[1]) - var b = semConstExpr(c, n[2]) - if not sameType(a.typ, b.typ): - LocalError(n.info, errPureTypeMismatch) - elif a.typ.kind notin {tyInt..tyInt64,tyEnum,tyBool,tyChar, - tyFloat..tyFloat128,tyUInt8..tyUInt32}: - LocalError(n.info, errOrdinalTypeExpected) - elif enumHasHoles(a.typ): - LocalError(n.info, errEnumXHasHoles, a.typ.sym.name.s) - elif not leValue(a, b): LocalError(n.Info, errRangeIsEmpty) - addSon(result.n, a) - addSon(result.n, b) - addSonSkipIntLit(result, b.typ) + # always create a 'valid' range type, but overwrite it later + # because 'semExprWithType' can raise an exception. See bug #6895. + 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] = default(array[2, PType]) + for i in 0..1: + rangeT[i] = range[i].typ.skipTypes({tyStatic}).skipIntLit(c.idgen) + + let hasUnknownTypes = c.inGenericContext > 0 and + (rangeT[0].kind == tyFromExpr or rangeT[1].kind == tyFromExpr) + + if not hasUnknownTypes: + if not sameType(rangeT[0].skipTypes({tyRange}), rangeT[1].skipTypes({tyRange})): + 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 hasUnresolvedArgs(c, range[i]): + result.n.add makeStaticExpr(c, range[i]) + result.flags.incl tfUnresolved + else: + 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") + + result[0] = rangeT[0] 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}: - if n.sons[0].intVal > 0 or n.sons[1].intVal < 0: - incl(result.flags, tfNeedsInit) - elif n.sons[0].floatVal > 0.0 or 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: - LocalError(n.sons[0].info, errRangeExpected) + 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[0].info, "expected range") result = newOrPrevType(tyError, prev, c) else: - LocalError(n.info, errXExpectsOneTypeParam, "range") + localError(c.config, n.info, errXExpectsOneTypeParam % "range") result = newOrPrevType(tyError, prev, c) -proc semArray(c: PContext, n: PNode, prev: PType): PType = - var indx, base: PType - result = newOrPrevType(tyArray, prev, c) - if sonsLen(n) == 3: - # 3 = length(array indx base) - if isRange(n[1]): indx = semRangeAux(c, n[1], nil) - else: - let e = semExprWithType(c, n.sons[1], {efDetermineType}) - if e.kind in {nkIntLit..nkUInt64Lit}: - indx = newTypeS(tyRange, c) - indx.n = newNodeI(nkRange, n.info) - addSon(indx.n, newIntTypeNode(e.kind, 0, e.typ)) - addSon(indx.n, newIntTypeNode(e.kind, e.intVal-1, e.typ)) - addSonSkipIntLit(indx, e.typ) +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.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 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: - indx = e.typ.skipTypes({tyTypeDesc}) - addSonSkipIntLit(result, indx) - if indx.kind == tyGenericInst: indx = lastSon(indx) - if indx.kind != tyGenericParam: - if not isOrdinalType(indx): - LocalError(n.sons[1].info, errOrdinalTypeExpected) - elif enumHasHoles(indx): - LocalError(n.sons[1].info, errEnumXHasHoles, indx.sym.name.s) - base = semTypeNode(c, n.sons[2], nil) - addSonSkipIntLit(result, base) - else: - LocalError(n.info, errArrayExpectsTwoTypeParams) + 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 tuninstantiatedgenericcalls). + # We are going to construct a range type that will be + # properly filled-out in semtypinst (see how tyStaticExpr + # is handled there). + result = makeRangeWithStaticExpr(c, e) + elif e.kind == nkIdent: + result = e.typ.skipTypes({tyTypeDesc}) + else: + 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 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 = skipModifier(indxB) + if indxB.kind notin {tyGenericParam, tyStatic, tyFromExpr} and + tfUnresolved notin indxB.flags: + if not isOrdinalType(indxB): + localError(c.config, n[1].info, errOrdinalTypeExpected % typeToString(indxB, preferDesc)) + elif enumHasHoles(indxB): + localError(c.config, n[1].info, "enum '$1' has holes" % + typeToString(indxB.skipTypes({tyRange}))) + elif indxB.kind != tyRange and + lengthOrd(c.config, indxB) > high(uint16).int: + # assume range type is intentional + localError(c.config, n[1].info, + "index type '$1' for array is too large" % typeToString(indxB)) + base = semTypeNode(c, n[2], nil) + # ensure we only construct a tyArray when there was no error (bug #3048): + # bug #6682: Do not propagate initialization requirements etc for the + # index type: + result = newOrPrevType(tyArray, prev, c, indx) + addSonSkipIntLit(result, base, c.idgen) + else: + localError(c.config, n.info, errArrayExpectsTwoTypeParams) result = newOrPrevType(tyError, prev, c) - -proc semOrdinal(c: PContext, n: PNode, prev: PType): PType = + +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 base.kind != tyGenericParam: - if not isOrdinalType(base): - LocalError(n.sons[1].info, errOrdinalTypeExpected) - addSonSkipIntLit(result, base) + if n.len == 2: + var base = semTypeNode(c, n[1], nil) + if base.kind != tyGenericParam: + if not isOrdinalType(base): + localError(c.config, n[1].info, errOrdinalTypeExpected % typeToString(base, preferDesc)) + addSonSkipIntLit(result, base, c.idgen) else: - LocalError(n.info, errXExpectsOneTypeParam, "ordinal") + localError(c.config, n.info, errXExpectsOneTypeParam % "ordinal") result = newOrPrevType(tyError, prev, c) - -proc semTypeIdent(c: PContext, n: PNode): PSym = - if n.kind == nkSym: - result = n.sym + +proc semAnonTuple(c: PContext, n: PNode, prev: PType): PType = + if n.len == 0: + localError(c.config, n.info, errTypeExpected) + result = newOrPrevType(tyTuple, prev, c) + for it in n: + 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 = qualifiedLookup(c, n, {checkAmbiguity, checkUndeclared}) - if result != nil: - markUsed(n, 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 also used as return type for example - if result.typ.sonsLen > 0: - let bound = result.typ.sons[0].sym - if bound != nil: - return bound - return result - if result.typ.sym == nil: - LocalError(n.info, errTypeExpected) - return errorSym(c, n) - return result.typ.sym - 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(n.info, errTypeExpected) - return errorSym(c, n) - if result.typ.kind != tyGenericParam: - # XXX get rid of this hack! - var oldInfo = n.info - reset(n[]) - n.kind = nkSym - n.sym = result - n.info = oldInfo - else: - LocalError(n.info, errIdentifierExpected) - result = errorSym(c, n) - -proc semTuple(c: PContext, n: PNode, prev: PType): PType = - if n.sonsLen == 0: return newConstraint(c, tyTuple) + result = newIntNode(nkIntLit, firstOrd(config, t)) + result.typ = t + +proc semTuple(c: PContext, n: PNode, prev: PType): PType = var typ: PType result = newOrPrevType(tyTuple, prev, c) result.n = newNodeI(nkRecList, n.info) var check = initIntSet() var counter = 0 - for i in countup(0, sonsLen(n) - 1): - var a = n.sons[i] - if (a.kind != nkIdentDefs): IllFormedAst(a) - checkMinSonsLen(a, 3) - var length = sonsLen(a) - if a.sons[length - 2].kind != nkEmpty: - typ = semTypeNode(c, a.sons[length - 2], nil) + 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 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(a.info, errTypeExpected) + localError(c.config, a.info, errTypeExpected) typ = errorType(c) - if a.sons[length - 1].kind != nkEmpty: - LocalError(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(a.sons[j].info, errAttemptToRedefine, field.name.s) + if containsOrIncl(check, field.name.id): + localError(c.config, a[j].info, "attempt to redefine: '" & field.name.s & "'") else: - addSon(result.n, newSymNode(field)) - addSonSkipIntLit(result, typ) + 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 = +proc semIdentVis(c: PContext, kind: TSymKind, n: PNode, + allowed: TSymFlags): PSym = # identifier with visibility - if n.kind == nkPostfix: - if sonsLen(n) == 2 and n.sons[0].kind == nkIdent: + if n.kind == nkPostfix: + 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 = n.sons[0].ident - if sfExported in allowed and v.id == ord(wStar): + 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: - LocalError(n.sons[0].info, errInvalidVisibilityX, v.s) + if not (sfExported in allowed): + localError(c.config, n[0].info, errXOnlyAtModuleScope % "export") + else: + localError(c.config, n[0].info, errInvalidVisibilityX % renderTree(n[0])) else: - illFormedAst(n) + result = nil + illFormedAst(n, c.config) else: result = newSymG(kind, n, c) - -proc semIdentWithPragma(c: PContext, kind: TSymKind, n: PNode, - allowed: TSymFlags): PSym = - if n.kind == nkPragmaExpr: - checkSonsLen(n, 2) - result = semIdentVis(c, kind, n.sons[0], allowed) + +proc semIdentWithPragma(c: PContext, kind: TSymKind, n: PNode, + allowed: TSymFlags, fromTopLevel = false): PSym = + if n.kind == nkPragmaExpr: + checkSonsLen(n, 2, c.config) + result = semIdentVis(c, kind, n[0], allowed) case kind - of skType: + of skType: # process pragmas later, because result.typ has not been set yet - 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) - else: nil + discard + 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) - + 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): - LocalError(ex.info, errDuplicateCaseLabel) - -proc semBranchRange(c: PContext, t, a, b: PNode, covered: var biggestInt): PNode = - checkMinSonsLen(t, 1) + if overlap(t[i][j].skipConv, ex): + localError(c.config, ex.info, errDuplicateCaseLabel) + +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).skipConvTakeType - let bt = fitNode(c, t.sons[0].typ, bc).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(b.info, errRangeIsEmpty) - else: covered = covered + getOrdValue(bc) - getOrdValue(ac) + 1 + if emptyRange(ac, bc): localError(c.config, b.info, "range is empty") + else: covered = covered + getOrdValue(bc) + 1 - getOrdValue(ac) -proc SemCaseBranchRange(c: PContext, t, b: PNode, - covered: var biggestInt): PNode = - checkSonsLen(b, 3) - result = semBranchRange(c, t, b.sons[1], b.sons[2], covered) +proc semCaseBranchRange(c: PContext, t, b: PNode, + covered: var Int128): PNode = + checkSonsLen(b, 3, c.config) + 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) - result = semBranchRange(c, t, b.sons[1], b.sons[2], covered) + checkSonsLen(b, 3, c.config) + result = semBranchRange(c, n, b[1], b[2], covered) elif b.kind == nkRange: - checkSonsLen(b, 2) - result = semBranchRange(c, t, b.sons[0], b.sons[1], covered) + checkSonsLen(b, 2, c.config) + result = semBranchRange(c, n, b[0], b[1], covered) else: - result = fitNode(c, t.sons[0].typ, b) + result = fitNode(c, n[0].typ, b, b.info) inc(covered) -proc semCaseBranch(c: PContext, t, branch: PNode, branchIndex: int, - covered: var biggestInt) = - for i in countup(0, sonsLen(branch) - 2): - var b = branch.sons[i] +proc semCaseBranch(c: PContext, n, branch: PNode, branchIndex: int, + covered: var Int128) = + let lastIndex = branch.len - 2 + for i in 0..lastIndex: + var b = branch[i] if b.kind == nkRange: - branch.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: - var r = semConstExpr(c, b) - # for ``{}`` we want to trigger the type mismatch in ``fitNode``: - if r.kind != nkCurly or len(r) == 0: - checkMinSonsLen(t, 1) - branch.sons[i] = fitNode(c, t.sons[0].typ, r) + # constant sets and arrays are allowed: + # set expected type to selector type for type inference + # even if it can be a different type like a set or array + var r = semConstExpr(c, b, expectedType = n[0].typ) + if r.kind in {nkCurly, nkBracket} and r.len == 0 and branch.len == 2: + # discarding ``{}`` and ``[]`` branches silently + delSon(branch, 0) + return + elif r.kind notin {nkCurly, nkBracket} or r.len == 0: + checkMinSonsLen(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: - # constant sets have special rules - # first element is special and will overwrite: branch.sons[i]: - branch.sons[i] = semCaseBranchSetElem(c, t, r[0], covered) + if r.kind == nkCurly: + r = deduplicate(c.config, r) + + # 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: - var L = branch.len - swap(branch.sons[L-2], branch.sons[L-1]) - checkForOverlap(c, t, i, branchIndex) - -proc semRecordNodeAux(c: PContext, n: PNode, check: var TIntSet, pos: var int, - father: PNode, rectype: PType) -proc semRecordCase(c: PContext, n: PNode, check: var TIntSet, pos: var int, + swap(branch[^2], branch[^1]) + checkForOverlap(c, n, i, branchIndex) + + # Elements added above needs to be checked for overlaps. + 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, 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) - semRecordNodeAux(c, n.sons[0], check, pos, a, rectype) - if a.sons[0].kind != nkSym: - internalError("semRecordCase: discriminant is no symbol") + checkMinSonsLen(n, 2, c.config) + 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(n.info, errSelectorMustBeOrdinal) - elif firstOrd(typ) < 0: - LocalError(n.info, errOrdXMustNotBeNegative, a.sons[0].sym.name.s) - elif lengthOrd(typ) > 0x00007FFF: - LocalError(n.info, errLenXinvalid, 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 + 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[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) + checkMinSonsLen(b, 2, c.config) semCaseBranch(c, a, b, i, covered) of nkElse: + checkSonsLen(b, 1, c.config) + if chckCovered and covered == toCover(c, a[0].typ): + message(c.config, b.info, warnUnreachableElse) chckCovered = false - checkSonsLen(b, 1) - else: illFormedAst(n) - delSon(b, sonsLen(b) - 1) - semRecordNodeAux(c, lastSon(n.sons[i]), check, pos, b, rectype) - if chckCovered and (covered != lengthOrd(a.sons[0].typ)): - localError(a.info, errNotAllCasesCovered) - addSon(father, a) - -proc semRecordNodeAux(c: PContext, n: PNode, check: var TIntSet, pos: var int, - father: PNode, rectype: PType) = + else: illFormedAst(n, c.config) + 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, 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] - if it == nil: illFormedAst(n) + 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) - if c.InGenericContext == 0: - var e = semConstBoolExpr(c, it.sons[0]) - if e.kind != nkIntLit: InternalError(e.info, "semRecordNodeAux") - elif e.intVal != 0 and branch == nil: branch = it.sons[1] + checkSonsLen(it, 2, c.config) + if c.inGenericContext == 0: + 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) - if branch == nil: branch = it.sons[0] + checkSonsLen(it, 1, c.config) + if branch == nil and not cannotResolve: branch = it[0] idx = 0 - else: illFormedAst(n) - if c.InGenericContext > 0: + else: illFormedAst(n, c.config) + if c.inGenericContext > 0 and cannotResolve: # use a new check intset here for each branch: - var newCheck: TIntSet - 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)) + of nkNilLit: + 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) - var length = sonsLen(n) + checkMinSonsLen(n, 3, c.config) var a: PNode - if father.kind != nkRecList and length>=4: a = newNodeI(nkRecList, n.info) - else: a = ast.emptyNode - if n.sons[length-1].kind != nkEmpty: - localError(n.sons[length-1].info, errInitHereNotAllowed) + if father.kind != nkRecList and n.len >= 4: a = newNodeI(nkRecList, n.info) + else: a = newNodeI(nkEmpty, n.info) var typ: PType - if n.sons[length-2].kind == nkEmpty: - LocalError(n.info, errTypeExpected) + 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) - let rec = rectype.sym - for i in countup(0, sonsLen(n)-3): - var f = semIdentWithPragma(c, skField, n.sons[i], {sfExported}) - suggestSym(n.sons[i], f) + var fieldOwner = if c.inGenericContext > 0: c.getCurrOwner + else: rectype.sym + 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 - if (rec != nil) and ({sfImportc, sfExportc} * rec.flags != {}) and - (f.loc.r == nil): - f.loc.r = toRope(f.name.s) - f.flags = f.flags + ({sfImportc, sfExportc} * rec.flags) + f.options = c.config.options + if fieldOwner != nil and + {sfImportc, sfExportc} * fieldOwner.flags != {} and + not hasCaseFields and f.loc.snippet == "": + f.loc.snippet = rope(f.name.s) + f.flags.incl {sfImportc, sfExportc} * fieldOwner.flags inc(pos) - if ContainsOrIncl(check, f.name.id): - localError(n.sons[i].info, errAttemptToRedefine, f.name.s) - if a.kind == nkEmpty: addSon(father, newSymNode(f)) - else: addSon(a, newSymNode(f)) - if a.kind != nkEmpty: addSon(father, a) - of nkEmpty: nil - else: illFormedAst(n) - -proc addInheritedFieldsAux(c: PContext, check: var TIntSet, pos: var int, + if containsOrIncl(check, f.name.id): + 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 & "'") + 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(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])) - else: internalError(n.info, "addInheritedFieldsAux(record case branch)") - of nkRecList: - for i in countup(0, sonsLen(n) - 1): - addInheritedFieldsAux(c, check, pos, n.sons[i]) + addInheritedFieldsAux(c, check, pos, lastSon(n[i])) + else: internalError(c.config, n.info, "addInheritedFieldsAux(record case branch)") + 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) + incl(check, n.sym.name.id) inc(pos) - else: InternalError(n.info, "addInheritedFieldsAux()") - -proc addInheritedFields(c: PContext, check: var TIntSet, pos: var int, - obj: PType) = - if (sonsLen(obj) > 0) and (obj.sons[0] != nil): - addInheritedFields(c, check, pos, obj.sons[0]) - addInheritedFieldsAux(c, check, pos, obj.n) - -proc skipGenericInvokation(t: PType): PType {.inline.} = + else: internalError(c.config, n.info, "addInheritedFieldsAux()") + +proc skipGenericInvocation(t: PType): PType {.inline.} = result = t - if result.kind == tyGenericInvokation: - result = result.sons[0] - if result.kind == tyGenericBody: - result = lastSon(result) + if result.kind == tyGenericInvocation: + 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): PType = - if n.sonsLen == 0: return newConstraint(c, tyObject) +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: PType = nil - # n.sons[0] contains the pragmas (if any). We process these later... - checkSonsLen(n, 3) - if n.sons[1].kind != nkEmpty: - base = skipTypes(semTypeNode(c, n.sons[1].sons[0], nil), skipPtrs) - var concreteBase = skipGenericInvokation(base) - if concreteBase.kind == tyObject and tfFinal notin concreteBase.flags: - addInheritedFields(c, check, pos, concreteBase) + var pos = 0 + var base, realBase: PType = nil + # n[0] contains the pragmas (if any). We process these later... + checkSonsLen(n, 3, c.config) + 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") else: - if concreteBase.kind != tyError: - localError(n.sons[1].info, errInheritanceOnlyWithNonFinalObjects) - base = nil - if n.kind != nkObjectTy: InternalError(n.info, "semObjectNode") + var concreteBase = skipGenericInvocation(base) + if concreteBase.kind in {tyObject, tyGenericParam, + tyGenericInvocation} and tfFinal notin concreteBase.flags: + # we only check fields duplication of object inherited from + # concrete object. If inheriting from generic object or partial + # specialized object, there will be second check after instantiation + # located in semGeneric. + if concreteBase.kind == tyObject: + 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[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, base) - result.n = newNodeI(nkRecList, n.info) - semRecordNodeAux(c, n.sons[2], check, pos, result.n, result) - if n.sons[0].kind != nkEmpty: + 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 + 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("dummy"), n.info), c) + 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) - -proc addParamOrResult(c: PContext, param: PSym, kind: TSymKind) = - if kind == skMacro and param.typ.kind != tyTypeDesc: - # within a macro, every param has the type PNimrodNode! - # and param.typ.kind in {tyTypeDesc, tyExpr, tyStmt}: - let nn = getSysSym"PNimrodNode" - var a = copySym(param) - a.typ = nn.typ - if sfGenSym notin a.flags: addDecl(c, a) + 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: - if sfGenSym notin param.flags: addDecl(c, param) - -proc paramTypeClass(c: PContext, paramType: PType, procKind: TSymKind): - tuple[typ: PType, id: PIdent] = - # if typ is not-nil, the param should be turned into a generic param - # if id is not nil, the generic param will bind just once (see below) - case paramType.kind: - of tyExpr: - if paramType.sonsLen == 0: - # proc(a, b: expr) - # no constraints, treat like generic param - result.typ = newTypeS(tyGenericParam, c) + 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.kids: + let t = findEnforcedStaticType(s) + if t != nil: return t + +proc addParamOrResult(c: PContext, param: PSym, kind: TSymKind) = + if kind == skMacro: + let staticType = findEnforcedStaticType(param.typ) + if staticType != nil: + var a = copySym(param, c.idgen) + a.typ = staticType.base + addDecl(c, a) + #elif param.typ != nil and param.typ.kind == tyTypeDesc: + # addDecl(c, param) else: - # proc(a: expr{string}, b: expr{nkLambda}) - # overload on compile time values and AST trees - result.typ = newTypeS(tyExpr, c) - result.typ.sons = paramType.sons - of tyTypeDesc: - if tfInstantiated notin paramType.flags: - result.typ = newTypeS(tyTypeDesc, c) - result.typ.sons = paramType.sons - of tyDistinct: - result = paramTypeClass(c, paramType.lastSon, procKind) - # disable the bindOnce behavior for the type class - result.id = nil + # within a macro, every param has the type NimNode! + let nn = getSysSym(c.graph, param.info, "NimNode") + var a = copySym(param, c.idgen) + a.typ = nn.typ + addDecl(c, a) + else: + 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 - of tyGenericBody: - # type Foo[T] = object - # proc x(a: Foo, b: Foo) - result.typ = newTypeS(tyTypeClass, c) - result.typ.addSonSkipIntLit(paramType) - of tyTypeClass: - result.typ = copyType(paramType, getCurrOwner(), false) - else: nil - # bindOnce by default - if paramType.sym != nil: result.id = paramType.sym.name + 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): PType = - result = paramType - if procKind in {skMacro, skTemplate}: - # generic param types in macros and templates affect overload - # resolution, but don't work as generic params when it comes - # to proc instantiation. We don't need to lift such params here. - return - ## Params having implicit generic types or pseudo types such as 'expr' - ## need to be added to the generic params lists. - ## 'expr' is different from 'expr{string}' so we must first call - ## paramTypeClass to get the actual type we are going to use. - var (typeClass, paramTypId) = paramTypeClass(c, paramType, procKind) - let isAnon = paramTypId == nil - if typeClass != nil: - if isAnon: paramTypId = getIdent(paramName & ":type") - if genericParams == nil: - # genericParams is nil when the proc is being instantiated - # the resolved type will be in scope then - let s = searchInScopes(c, paramTypId) - # tests/run/tinterf triggers this: - if s != nil: result = s.typ - else: - LocalError(info, errCannotInstantiateX, paramName) - result = errorType(c) + info: TLineInfo, anon = false): PType = + if paramType == nil: return # (e.g. proc return type) + + template recurse(typ: PType, anonFlag = false): untyped = + liftParamType(c, procKind, genericParams, typ, paramName, info, anonFlag) + + var paramTypId = if not anon and paramType.sym != nil: paramType.sym.name + else: nil + + case paramType.kind + of tyAnything: + result = addImplicitGeneric(c, newTypeS(tyGenericParam, c), nil, info, genericParams, paramName) + + of tyStatic: + 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 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, 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 or + paramTypId.id == getIdent(c.cache, "type").id): + # XXX Why doesn't this check for tyTypeDesc instead? + paramTypId = nil + let t = newTypeS(tyTypeDesc, c, paramType.base) + incl t.flags, tfCheckedForDestructor + result = addImplicitGeneric(c, t, paramTypId, info, genericParams, paramName) + else: + result = nil + of tyDistinct: + if paramType.len == 1: + # disable the bindOnce behavior for the type class + result = recurse(paramType.base, true) + else: + result = nil + of tyTuple: + result = nil + for i in 0..<paramType.len: + let t = recurse(paramType[i]) + if t != nil: + paramType[i] = t + result = paramType + + of tyAlias, tyOwned: + result = recurse(paramType.base) + + of tySequence, tySet, tyArray, tyOpenArray, + 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.elementType.kind == tyNone: + let typ = newTypeS(tyBuiltInTypeClass, c, + newTypeS(paramType.kind, c)) + result = addImplicitGeneric(c, typ, paramTypId, info, genericParams, paramName) else: - block addImplicitGeneric: - # 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 == paramTypId.id: - result = genericParams.sons[i].typ - break addImplicitGeneric - - var s = newSym(skType, paramTypId, getCurrOwner(), info) - if isAnon: s.flags.incl(sfAnon) - s.linkTo(typeClass) - s.position = genericParams.len - genericParams.addSon(newSymNode(s)) - result = typeClass + result = nil + for i in 0..<paramType.len: + if paramType[i] == paramType: + globalError(c.config, info, errIllegalRecursionInTypeX % typeToString(paramType)) + var lifted = recurse(paramType[i]) + if lifted != nil: + paramType[i] = lifted + result = paramType + + of tyGenericBody: + result = newTypeS(tyGenericInvocation, c) + result.rawAddSon(paramType) + + 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.typeBodyImpl.kind == tyUserTypeClass: + result.kind = tyUserTypeClassInst + result.rawAddSon paramType.typeBodyImpl + return addImplicitGeneric(c, result, paramTypId, info, genericParams, paramName) + + let x = instGenericContainer(c, paramType.sym.info, result, + allowMetaTypes = true) + result = newTypeS(tyCompositeTypeClass, c) + result.rawAddSon paramType + result.rawAddSon x + result = addImplicitGeneric(c, result, paramTypId, info, genericParams, paramName) + + of tyGenericInst: + 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(c, cp, paramTypId, info, genericParams, paramName) + + for i in 1..<paramType.len-1: + var lifted = recurse(paramType[i]) + if lifted != nil: + paramType[i] = lifted + result = paramType + result.last.shouldHaveMeta + + let liftBody = recurse(paramType.skipModifier, true) + if liftBody != nil: + result = liftBody + result.flags.incl tfHasMeta + #result.shouldHaveMeta + + of tyGenericInvocation: + result = nil + for i in 1..<paramType.len: + #if paramType[i].kind != tyTypeDesc: + let lifted = recurse(paramType[i]) + if lifted != nil: paramType[i] = lifted + + let body = paramType.base + 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.last.kind == tyUserTypeClass: + let expanded = instGenericContainer(c, info, paramType, + allowMetaTypes = true) + result = recurse(expanded, true) + + of tyUserTypeClasses, tyBuiltInTypeClass, tyCompositeTypeClass, + tyAnd, tyOr, tyNot, tyConcept: + result = addImplicitGeneric(c, + copyType(paramType, c.idgen, getCurrOwner(c)), paramTypId, + info, genericParams, paramName) + + of tyGenericParam: + result = nil + markUsed(c, paramType.sym.info, paramType.sym) + onUse(paramType.sym.info, paramType.sym) + if tfWildcard in paramType.flags: + paramType.flags.excl tfWildcard + paramType.sym.transitionGenericParamToType() + + else: 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) + 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) -proc semProcTypeNode(c: PContext, n, genericParams: PNode, - prev: PType, kind: TSymKind): PType = - var - res: PNode - cl: TIntSet - checkMinSonsLen(n, 1) +proc newProcType(c: PContext; info: TLineInfo; prev: PType = nil): PType = result = newOrPrevType(tyProc, prev, c) result.callConv = lastOptionEntry(c).defaultCC - result.n = newNodeI(nkFormalParams, n.info) - if genericParams != nil and sonsLen(genericParams) == 0: - cl = initIntSet() + result.n = newNodeI(nkFormalParams, info) rawAddSon(result, nil) # return type - # result.n[0] used to be `nkType`, but now it's `nkEffectList` because + # 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: - res = newNodeI(nkEffectList, n.info) - addSon(result.n, res) + 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. + checkMinSonsLen(n, 1, c.config) + result = newProcType(c, n.info, prev) var check = initIntSet() var counter = 0 - for i in countup(1, n.len - 1): - var a = n.sons[i] - if a.kind != nkIdentDefs: IllFormedAst(a) - checkMinSonsLen(a, 3) + 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 + # skip this parameter here. It'll then be re-generated in another LL + # 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 compability 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): - def = fitNode(c, typ, def) - if not (hasType or hasDefault): - typ = newTypeS(tyExpr, c) - - if skipTypes(typ, {tyGenericInst}).kind == tyEmpty: continue - for j in countup(0, length-3): - var arg = newSymG(skParam, a.sons[j], c) - var finalType = liftParamType(c, kind, genericParams, typ, - arg.name.s, arg.info).skipIntLit + # 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(tyUntyped, c) + elif skipTypes(typ, {tyGenericInst, tyAlias, tySink}).kind == tyVoid: + continue + + 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, "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, + 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(a.sons[j].info, errAttemptToRedefine, 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, a[j].info, arg) + onDef(a[j].info, arg) + a[j] = newSymNode(arg) - if n.sons[0].kind != nkEmpty: - var r = semTypeNode(c, n.sons[0], nil) - # turn explicit 'void' return type into 'nil' because the rest of the + 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}).kind != tyEmpty: - if r.sym == nil or sfAnon notin r.sym.flags: - r = liftParamType(c, kind, genericParams, r, "result", n.sons[0].info) + 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: + elif r.kind == tyAnything: + r = copyType(r, c.idgen, r.owner) r.flags.incl tfRetType - result.sons[0] = skipIntLit(r) - res.typ = result.sons[0] + 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[0].info) + if lifted != nil: + r = lifted + #if r.kind != tyGenericParam: + #echo "came here for ", typeToString(r) + r.flags.incl tfRetType + r = skipIntLit(r, c.idgen) + if kind == skIterator: + # see tchainediterators + # 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[0] = r + let oldFlags = result.flags + propagateToOwner(result, r) + if oldFlags != result.flags: + # XXX This rather hacky way keeps 'tflatmap' compiling: + if tfHasMeta notin oldFlags: + result.flags.excl tfHasMeta + result.n.typ = r + + 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.transitionGenericParamToType() + n.sym.typ.flags.excl tfWildcard proc semStmtListType(c: PContext, n: PNode, prev: PType): PType = - checkMinSonsLen(n, 1) - 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) + checkMinSonsLen(n, 1, c.config) + 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) - checkSonsLen(n, 2) + +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) - Dec(c.p.nestedBlockCounter) - -proc semGenericParamInInvokation(c: PContext, n: PNode): PType = - # XXX hack 1022 for generics ... would have been nice if the compiler had - # been designed with them in mind from start ... - when false: - if n.kind == nkSym: - # for generics we need to lookup the type var again: - var s = searchInScopes(c, n.sym.name) - if s != nil: - if s.kind == skType and s.typ != nil: - var t = n.sym.typ - echo "came here" - return t - else: - echo "s is crap:" - debug(s) - else: - echo "s is nil!!!!" + 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 semGeneric(c: PContext, n: PNode, s: PSym, prev: PType): PType = - result = newOrPrevType(tyGenericInvokation, prev, c) - var isConcrete = true +proc trySemObjectTypeForInheritedGenericInst(c: PContext, n: PNode, t: PType): bool = + var + check = initIntSet() + pos = 0 + let + 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: + 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(n.info, errCannotInstantiateX, s.name.s) - return newOrPrevType(tyError, prev, c) - elif s.typ.kind != tyGenericBody: - isConcrete = false - elif sonsLen(n) != sonsLen(s.typ): - LocalError(n.info, errWrongNumberOfArguments) + localError(c.config, n.info, "cannot instantiate the '$1' $2" % + [s.name.s, s.kind.toHumanStr]) return newOrPrevType(tyError, prev, c) - addSonSkipIntLit(result, s.typ) - # iterate over arguments: - for i in countup(1, sonsLen(n)-1): - var elem = semGenericParamInInvokation(c, n.sons[i]) - if containsGenericType(elem): isConcrete = false - #if elem.kind in {tyGenericParam, tyGenericInvokation}: isConcrete = false - if elem.isNil: rawAddSon(result, elem) - else: addSonSkipIntLit(result, elem) - if isConcrete: - if s.ast == nil: - LocalError(n.info, errCannotInstantiateX, s.name.s) - result = newOrPrevType(tyError, prev, c) + + var t = s.typ.skipTypes({tyAlias}) + if t.kind == tyCompositeTypeClass and t.base.kind == tyGenericBody: + t = t.base + result = newOrPrevType(tyGenericInvocation, prev, c) + addSonSkipIntLit(result, t, c.idgen) + + template addToResult(typ, skip) = + + if typ.isNil: + internalAssert c.config, false + rawAddSon(result, typ) else: - result = instGenericContainer(c, n, result) + if skip: + addSonSkipIntLit(result, typ, c.idgen) + else: + rawAddSon(result, makeRangeWithStaticExpr(c, typ.n)) -proc semTypeExpr(c: PContext, n: PNode): PType = + if t.kind == tyForward: + 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 + # not generic. + localError(c.config, n.info, errNoGenericParamsAllowedForX % s.name.s) + return newOrPrevType(tyError, prev, c) + else: + var m = newCandidate(c, t) + m.isNoCall = true + matches(c, n, copyTree(n), m) + + if m.state != csMatch: + var err = "cannot instantiate " + err.addTypeHeader(c.config, t) + err.add "\ngot: <$1>\nbut expected: <$2>" % [describeArgs(c, n), describeArgs(c, t.n, 0)] + localError(c.config, n.info, errGenerated, err) + return newOrPrevType(tyError, prev, c) + + var isConcrete = true + let rType = m.call[0].typ + let mIndex = if rType != nil: rType.len - 1 else: -1 + for i in 1..<m.call.len: + var typ = m.call[i].typ + # is this a 'typedesc' *parameter*? If so, use the typedesc type, + # 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, true) + else: + typ = typ.skipTypes({tyTypeDesc}) + if containsGenericType(typ): isConcrete = false + 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) + + # special check for generic object with + # generic/partial specialized parent + let tx = result.skipTypes(abstractPtrs, 50) + if tx.isNil or isTupleRecursive(tx): + localError(c.config, n.info, "illegal recursion in type '$1'" % typeToString(result[0])) + return errorType(c) + 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 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.kind == nkSym and n.sym.kind == skType: - result = n.sym.typ + if n.typ.kind == tyTypeDesc: + result = n.typ.base + # fix types constructed by macros/template: + 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 + # and cast spell upon AST. Here we need to give + # it a name taken from left hand side's node + result.sym = prev.sym + result.sym.typ = result + else: + # Less powerful routine like template do not have + # the ability to produce unnamed types. But still + # it has wild power to push a type a bit too far. + # So we need to hold it back using alias and prevent + # 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(n.info, errTypeExpected, n.renderTree) + 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 +template modifierTypeKindOfNode(n: PNode): TTypeKind = + case n.kind + of nkVarTy: tyVar + of nkRefTy: tyRef + of nkPtrTy: tyPtr + of nkStaticTy: tyStatic + of nkTypeOfExpr: tyTypeDesc + else: tyNone + +proc semTypeClass(c: PContext, n: PNode, prev: PType): PType = + # if n.len == 0: return newConstraint(c, tyTypeClass) + if isNewStyleConcept(n): + result = newOrPrevType(tyConcept, prev, c) + result.flags.incl tfCheckedForDestructor + result.n = semConceptDeclaration(c, n) + return result + + let + pragmas = n[1] + inherited = n[2] + + var owner = getCurrOwner(c) + 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.add(typ) + + openScope(c) + for param in n[0]: + var + dummyName: PNode + dummyType: PType + + let modifier = param.modifierTypeKindOfNode + + if modifier != tyNone: + dummyName = param[0] + dummyType = c.makeTypeWithModifier(modifier, candidateTypeSlot) + # 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, c.idgen, owner, param.info) + dummyParam.typ = dummyType + incl dummyParam.flags, sfUsed + addDecl(c, dummyParam) + + 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 = + 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[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[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 symFromExpectedTypeNode(c: PContext, n: PNode): PSym = + if n.kind == nkType: + result = symFromType(c, n.typ, n.info) + else: + 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 - if gCmd == cmdIdeTools: suggestExpr(c, n) + inc c.inTypeContext + + if c.config.cmd == cmdIdeTools: suggestExpr(c, n) case n.kind - of nkEmpty: nil + of nkEmpty: result = n.typ of nkTypeOfExpr: - # for ``type(countup(1,3))``, see ``tests/ttoseq``. - checkSonsLen(n, 1) - result = semExprWithType(c, n.sons[0], {efInTypeof}).typ - of nkPar: - if sonsLen(n) == 1: result = semTypeNode(c, n.sons[0], prev) + # for ``typeof(countup(1,3))``, see ``tests/ttoseq``. + checkSonsLen(n, 1, c.config) + result = semTypeOf(c, n[0], prev) + if result.kind == tyTypeDesc: result.flags.incl tfExplicit + of nkPar: + if n.len == 1: result = semTypeNode(c, n[0], prev) else: - # XXX support anon tuple here - LocalError(n.info, errTypeExpected) - result = newOrPrevType(tyError, prev, c) + result = semAnonTuple(c, n, prev) + of nkTupleConstr: result = semAnonTuple(c, n, prev) of nkCallKinds: - if n[0].kind == nkIdent: - let op = n.sons[0].ident - if op.id in {ord(wAnd), ord(wOr)} or op.s == "|": - checkSonsLen(n, 3) + let x = n[0] + 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]) + result = semTypeNode(c, b, prev) + 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[1], prev) + if result.skipTypes({tyGenericInst, tyAlias, tySink, tyOwned}).kind in NilableTypes+GenericTypes: + if tfNotNil in result.flags: + result = freshType(c, result, prev) + result.flags.excl(tfNotNil) + 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[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) - if t1 == nil: - LocalError(n.sons[1].info, errTypeExpected) + t1 = semTypeNode(c, n[1], nil) + t2 = semTypeNode(c, n[2], nil) + if t1 == nil: + localError(c.config, n[1].info, errTypeExpected) result = newOrPrevType(tyError, prev, c) - elif t2 == nil: - LocalError(n.sons[2].info, errTypeExpected) + elif t2 == nil: + localError(c.config, n[2].info, errTypeExpected) result = newOrPrevType(tyError, prev, c) else: - result = newTypeS(tyTypeClass, c) - result.addSonSkipIntLit(t1) - result.addSonSkipIntLit(t2) - result.flags.incl(if op.id == ord(wAnd): tfAll else: tfAny) + result = if op.id == ord(wAnd): makeAndType(c, t1, t2) + else: makeOrType(c, t1, t2) elif op.id == ord(wNot): - checkSonsLen(n, 3) - result = semTypeNode(c, n.sons[1], prev) - if result.kind in NilableTypes and n.sons[2].kind == nkNilLit: - result = freshType(result, prev) - result.flags.incl(tfNotNil) + case n.len + of 3: + 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) + else: + localError(c.config, n.info, errGenerated, "invalid type") + of 2: + let negated = semTypeNode(c, n[1], prev) + result = makeNotType(c, negated) else: - LocalError(n.info, errGenerated, "invalid type") + localError(c.config, n.info, errGenerated, "invalid type") + elif op.id == ord(wPtr): + result = semAnyRef(c, n, tyPtr, prev) + elif op.id == ord(wRef): + result = semAnyRef(c, n, tyRef, prev) + elif op.id == ord(wType): + checkSonsLen(n, 2, c.config) + result = semTypeOf(c, n[1], prev) + elif op.s == "typeof" and ( + (n[0].kind == nkSym and n[0].sym.magic == mTypeOf) 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: - result = semTypeExpr(c, n) - else: - result = semTypeExpr(c, n) + 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) - var s = semTypeIdent(c, n.sons[0]) + checkMinSonsLen(n, 2, c.config) + 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 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 mExpr, mTypeDesc: - result = semTypeNode(c, n.sons[0], 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[0], nil) if result != nil: - result = copyType(result, getCurrOwner(), 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), c.idgen) + of mVar: + result = newOrPrevType(tyVar, prev, c) + var base = semTypeNode(c, n[1], nil) + if base.kind in {tyVar, tyLent}: + localError(c.config, n.info, "type 'var var' is not allowed") + 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 nkIdent, nkDotExpr, nkAccQuoted: + of nkDotExpr: + let typeExpr = semExpr(c, n) + if typeExpr.typ.isNil: + localError(c.config, n.info, "object constructor needs an object type;" & + " for named arguments use '=' instead of ':'") + result = errorType(c) + elif typeExpr.typ.kind == tyFromExpr: + result = typeExpr.typ + elif typeExpr.typ.kind != tyTypeDesc: + localError(c.config, n.info, errTypeExpected) + result = errorType(c) + else: + result = typeExpr.typ.base + if result.isMetaType and + result.kind != tyUserTypeClass: + # the dot expression may refer to a concept type in + # a different module. allow a normal alias then. + let preprocessed = semGenericStmt(c, n) + result = makeTypeFromExpr(c, preprocessed.copyTree) + else: + let alias = maybeAliasType(c, result, prev) + if alias != nil: result = alias + of nkIdent, nkAccQuoted: var s = semTypeIdent(c, n) - if s.typ == nil: - if s.kind != skError: LocalError(n.info, errTypeExpected) + if s.typ == nil: + if s.kind != skError: localError(c.config, n.info, errTypeExpected) result = newOrPrevType(tyError, prev, c) elif s.kind == skParam and s.typ.kind == tyTypeDesc: - assert s.typ.len > 0 - InternalAssert prev == nil - result = s.typ.sons[0] + internalAssert c.config, s.typ.base.kind != tyNone + result = s.typ.base elif prev == nil: 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 - result = prev + else: + 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.itemId = s.typ.itemId + result = prev of nkSym: - if n.sym.kind == skType and n.sym.typ != nil: - var t = n.sym.typ - if prev == nil: + let s = getGenSym(c, n.sym) + 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 or prev.kind == tyGenericBody: result = t - else: + else: assignType(prev, t) result = prev - markUsed(n, n.sym) + markUsed(c, n.info, n.sym) + onUse(n.info, n.sym) else: - if n.sym.kind != skError: LocalError(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 = semStaticType(c, n[0], prev) of nkProcTy, nkIteratorTy: - if n.sonsLen == 0: - result = newConstraint(c, tyProc) + 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) + 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: - checkSonsLen(n, 2) - openScope(c) - result = semProcTypeNode(c, n.sons[0], nil, prev, skProc) - # dummy symbol for `pragma`: - var s = newSymS(skProc, newIdentNode(getIdent("dummy"), n.info), c) - s.typ = result - if n.sons[1].kind == nkEmpty or n.sons[1].len == 0: - if result.callConv == ccDefault: - result.callConv = ccClosure - #Message(n.info, warnImplicitClosure, renderTree(n)) - else: - pragma(c, s, n.sons[1], procTypePragmas) - when useEffectSystem: SetEffectsForProcType(result, n.sons[1]) - closeScope(c) - if n.kind == nkIteratorTy: - result.flags.incl(tfIterator) - result.callConv = ccClosure + 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 nkSharedTy: - checkSonsLen(n, 1) - result = semTypeNode(c, n.sons[0], prev) - result = freshType(result, prev) - result.flags.incl(tfShared) + of nkOpenSym: result = semTypeNode(c, n[0], prev) else: - LocalError(n.info, errTypeExpected) - result = newOrPrevType(tyError, prev, c) - -proc setMagicType(m: PSym, kind: TTypeKind, size: int) = + 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 + +proc setMagicType(conf: ConfigRef; m: PSym, kind: TTypeKind, size: int) = + # source : https://en.wikipedia.org/wiki/Data_structure_alignment#x86 m.typ.kind = kind - m.typ.align = size m.typ.size = size - -proc processMagicType(c: PContext, m: PSym) = + # this usually works for most basic types + # Assuming that since ARM, ARM64 don't support unaligned access + # data is aligned to type size + m.typ.align = size.int16 + + # FIXME: proper support for clongdouble should be added. + # long double size can be 8, 10, 12, 16 bytes depending on platform & compiler + 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(m, tyInt, intSize) - of mInt8: setMagicType(m, tyInt8, 1) - of mInt16: setMagicType(m, tyInt16, 2) - of mInt32: setMagicType(m, tyInt32, 4) - of mInt64: setMagicType(m, tyInt64, 8) - of mUInt: setMagicType(m, tyUInt, intSize) - of mUInt8: setMagicType(m, tyUInt8, 1) - of mUInt16: setMagicType(m, tyUInt16, 2) - of mUInt32: setMagicType(m, tyUInt32, 4) - of mUInt64: setMagicType(m, tyUInt64, 8) - of mFloat: setMagicType(m, tyFloat, floatSize) - of mFloat32: setMagicType(m, tyFloat32, 4) - of mFloat64: setMagicType(m, tyFloat64, 8) - of mFloat128: setMagicType(m, tyFloat128, 16) - of mBool: setMagicType(m, tyBool, 1) - of mChar: setMagicType(m, tyChar, 1) - of mString: - setMagicType(m, tyString, ptrSize) - rawAddSon(m.typ, getSysType(tyChar)) - of mCstring: - setMagicType(m, tyCString, ptrSize) - rawAddSon(m.typ, getSysType(tyChar)) - of mPointer: setMagicType(m, tyPointer, ptrSize) - of mEmptySet: - setMagicType(m, tySet, 1) - rawAddSon(m.typ, newTypeS(tyEmpty, c)) - of mIntSetBaseType: setMagicType(m, tyRange, intSize) - of mNil: setMagicType(m, tyNil, ptrSize) - of mExpr: setMagicType(m, tyExpr, 0) - of mStmt: setMagicType(m, tyStmt, 0) - of mTypeDesc: setMagicType(m, tyTypeDesc, 0) - of mVoidType: setMagicType(m, tyEmpty, 0) - of mArray: setMagicType(m, tyArray, 0) - of mOpenArray: setMagicType(m, tyOpenArray, 0) - of mVarargs: setMagicType(m, tyVarargs, 0) - of mRange: setMagicType(m, tyRange, 0) - of mSet: setMagicType(m, tySet, 0) - of mSeq: setMagicType(m, tySequence, 0) - of mOrdinal: setMagicType(m, tyOrdinal, 0) - of mPNimrodNode: nil - else: LocalError(m.info, errTypeExpected) - -proc semGenericConstraints(c: PContext, n: PNode, result: PType) = - var x = semTypeNode(c, n, nil) - if x.kind in StructuralEquivTypes and ( - sonsLen(x) == 0 or x.sons[0].kind in {tyGenericParam, tyEmpty}): - x = newConstraint(c, x.kind) - result.addSonSkipIntLit(x) - -proc semGenericParamList(c: PContext, n: PNode, father: PType = nil): PNode = + 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, szUncomputedSize) + rawAddSon(m.typ, getSysType(c.graph, m.info, tyChar)) + if optSeqDestructors in c.config.globalOptions: + incl m.typ.flags, tfHasAsgn + of mCstring: + setMagicIntegral(c.config, m, tyCstring, c.config.target.ptrSize) + rawAddSon(m.typ, getSysType(c.graph, m.info, tyChar)) + of mPointer: setMagicIntegral(c.config, m, tyPointer, c.config.target.ptrSize) + of mNil: setMagicType(c.config, m, tyNil, c.config.target.ptrSize) + of mExpr: + if m.name.s == "auto": + setMagicIntegral(c.config, m, tyAnything, 0) + else: + setMagicIntegral(c.config, m, tyUntyped, 0) + of mStmt: + 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: + setMagicIntegral(c.config, m, tyVoid, 0) + of mArray: + setMagicType(c.config, m, tyArray, szUncomputedSize) + of mOpenArray: + setMagicType(c.config, m, tyOpenArray, szUncomputedSize) + of mVarargs: + setMagicType(c.config, m, tyVarargs, szUncomputedSize) + of mRange: + setMagicIntegral(c.config, m, tyRange, szUncomputedSize) + rawAddSon(m.typ, newTypeS(tyNone, c)) + of mSet: + setMagicIntegral(c.config, m, tySet, szUncomputedSize) + of mUncheckedArray: + setMagicIntegral(c.config, m, tyUncheckedArray, szUncomputedSize) + of mSeq: + 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: + 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, 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 = 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) + 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) - var L = sonsLen(a) - var def = a.sons[L-1] - var typ: PType - if a.sons[L-2].kind != nkEmpty: - typ = newTypeS(tyGenericParam, c) - semGenericConstraints(c, a.sons[L-2], typ) - if sonsLen(typ) == 1 and typ.sons[0].kind == tyTypeDesc: - typ = typ.sons[0] - elif def.kind != nkEmpty: typ = newTypeS(tyExpr, c) - else: typ = nil - for j in countup(0, L-3): - var s: PSym + 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 def.kind != nkEmpty: + def = semConstExpr(c, def) + if typ == nil: + if def.typ.kind != tyTypeDesc: + typ = newTypeS(tyStatic, c, def.typ) + else: + # the following line fixes ``TV2*[T:SomeNumber=TR] = array[0..1, T]`` + # from manyloc/named_argument_bug/triengine: + def.typ = def.typ.skipTypes({tyTypeDesc}) + if not containsGenericType(def.typ): + def = fitNode(c, typ, def, def.info) + if typ == nil: - s = newSymG(skType, a.sons[j], c) - s.typ = newTypeS(tyGenericParam, c) - else: - case typ.kind - of tyTypeDesc: - s = newSymG(skType, a.sons[j], c) - s.typ = newTypeS(tyGenericParam, c) - of tyExpr: - #echo "GENERIC EXPR ", a.info.toFileLineCol - # not a type param, but an expression - # proc foo[x: expr](bar: int) what is this? - s = newSymG(skGenericParam, a.sons[j], c) - s.typ = typ + typ = newTypeS(tyGenericParam, c) + if father == nil: typ.flags.incl tfWildcard + + typ.flags.incl tfGenericTypeParam + + for j in 0..<a.len-2: + var finalType: PType + if j == 0: + finalType = typ else: - # This handles cases like proc foo[t: tuple] - # XXX: we want to turn that into a type class - s = newSymG(skType, a.sons[j], c) - s.typ = typ - if def.kind != nkEmpty: s.ast = def - s.typ.sym = s - if father != nil: addSonSkipIntLit(father, s.typ) - s.position = i - addSon(result, newSymNode(s)) - if sfGenSym notin s.flags: addDecl(c, s) + 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 31fbc33e1..759e8e6ab 100644 --- a/compiler/semtypinst.nim +++ b/compiler/semtypinst.nim @@ -1,7 +1,7 @@ # # -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -9,226 +9,858 @@ # This module does the instantiation of generic types. -import ast, astalgo, msgs, types, magicsys, semdata, renderer +import std / tables -proc checkPartialConstructedType(info: TLineInfo, t: PType) = - if tfAcyclic in t.flags and skipTypes(t, abstractInst).kind != tyObject: - LocalError(info, errInvalidPragmaX, "acyclic") - elif t.kind == tyVar and t.sons[0].kind == tyVar: - LocalError(info, errVarVarTypeNotAllowed) +import ast, astalgo, msgs, types, magicsys, semdata, renderer, options, + lineinfos, modulegraphs -proc checkConstructedType*(info: TLineInfo, typ: PType) = - var t = typ.skipTypes({tyDistinct}) - if t.kind in {tyTypeClass}: nil - elif tfAcyclic in t.flags and skipTypes(t, abstractInst).kind != tyObject: - LocalError(info, errInvalidPragmaX, "acyclic") - elif t.kind == tyVar and t.sons[0].kind == tyVar: - LocalError(info, errVarVarTypeNotAllowed) - elif computeSize(t) < 0: - LocalError(info, errIllegalRecursionInTypeX, 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) +when defined(nimPreviewSlimSystem): + import std/assertions -proc searchInstTypes(key: PType): PType = - let genericTyp = key.sons[0] - InternalAssert genericTyp.kind == tyGenericBody and - key.sons[0] == genericTyp and - genericTyp.sym != nil +const tfInstClearedFlags = {tfHasMeta, tfUnresolved} - if genericTyp.sym.typeInstCache == nil: - return +proc checkPartialConstructedType(conf: ConfigRef; info: TLineInfo, t: PType) = + if t.kind in {tyVar, tyLent} and t.elementType.kind in {tyVar, tyLent}: + localError(conf, info, "type 'var var' is not allowed") + +proc checkConstructedType*(conf: ConfigRef; info: TLineInfo, typ: PType) = + var t = typ.skipTypes({tyDistinct}) + if t.kind in tyTypeClasses: discard + elif t.kind in {tyVar, tyLent} and t.elementType.kind in {tyVar, tyLent}: + localError(conf, info, "type 'var var' is not allowed") + elif computeSize(conf, t) == szIllegalRecursion or isTupleRecursive(t): + localError(conf, info, "illegal recursion in type '" & typeToString(t) & "'") + +proc searchInstTypes*(g: ModuleGraph; key: PType): PType = + result = nil + let genericTyp = key[0] + if not (genericTyp.kind == tyGenericBody and + genericTyp.sym != 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 TChannel[empty]. Why? - # See the notes for PActor in handleGenericInvokation - return - block MatchType: - for j in 1 .. high(key.sons): + # types such as Channel[empty]. Why? + # See the notes for PActor in handleGenericInvocation + # 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 FirstGenericParamAt..<key.kidsLen: # XXX sameType is not really correct for nested generics? - if not sameType(inst.sons[j], key.sons[j]): - break MatchType - + 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 genericTyp = inst.sons[0] - genericTyp.sym.typeInstCache.safeAdd(inst) +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 + addToGenericCache(c, gt.sym, inst) type - TReplTypeVars* {.final.} = object + LayeredIdTable* {.acyclic.} = ref object + topLayer*: TypeMapping + nextLayer*: LayeredIdTable + + TReplTypeVars* = object c*: PContext - typeMap*: TIdTable # map PType to PType - symMap*: TIdTable # map PSym to PSym + 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 # 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, t: PType): PSym +proc replaceTypeVarsN*(cl: var TReplTypeVars, n: PNode; start=0; expectedType: PType = nil): PNode + +proc initLayeredTypeMap*(pt: sink TypeMapping): LayeredIdTable = + result = LayeredIdTable() + result.topLayer = pt + +proc newTypeMapLayer*(cl: var TReplTypeVars): LayeredIdTable = + result = LayeredIdTable(nextLayer: cl.typeMap, topLayer: initTable[ItemId, PType]()) + +proc lookup(typeMap: LayeredIdTable, key: PType): PType = + result = nil + var tm = typeMap + while tm != nil: + result = getOrDefault(tm.topLayer, key.itemId) + if result != nil: return + tm = tm.nextLayer -proc ReplaceTypeVarsT*(cl: var TReplTypeVars, t: PType): PType -proc ReplaceTypeVarsS(cl: var TReplTypeVars, s: PSym): PSym -proc ReplaceTypeVarsN(cl: var TReplTypeVars, n: PNode): PNode +template put(typeMap: LayeredIdTable, key, value: PType) = + typeMap.topLayer[key.itemId] = value -proc prepareNode(cl: var TReplTypeVars, n: PNode): PNode = +template checkMetaInvariants(cl: TReplTypeVars, t: PType) = # noop code + when false: + if t != nil and tfHasMeta in t.flags and + cl.allowMetaTypes == false: + echo "UNEXPECTED META ", t.id, " ", instantiationInfo(-1) + debug t + writeStackTrace() + +proc replaceTypeVarsT*(cl: var TReplTypeVars, t: PType): PType = + result = replaceTypeVarsTAux(cl, t) + checkMetaInvariants(cl, result) + +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 = ReplaceTypeVarsT(cl, n.typ) - if result.kind == nkSym: result.sym = ReplaceTypeVarsS(cl, n.sym) - for i in 0 .. safeLen(n)-1: - # XXX HACK: ``f(a, b)``, avoid to instantiate `f` - if i == 0: result.add(n[i]) - else: result.add(prepareNode(cl, n[i])) - -proc ReplaceTypeVarsN(cl: var TReplTypeVars, n: PNode): PNode = + result.typ = t + 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 + return n.kind == nkSym and + (n.sym.kind == skGenericParam or + (n.sym.kind == skType and sfFromGeneric in n.sym.flags)) + +when false: # old workaround + proc reResolveCallsWithTypedescParams(cl: var TReplTypeVars, n: PNode): PNode = + # This is needed for tuninstantiatedgenericcalls + # It's possible that a generic param will be used in a proc call to a + # typedesc accepting proc. After generic param substitution, such procs + # should be optionally instantiated with the correct type. In order to + # perform this instantiation, we need to re-run the generateInstance path + # in the compiler, but it's quite complicated to do so at the moment so we + # resort to a mild hack; the head symbol of the call is temporary reset and + # overload resolution is executed again (which may trigger generateInstance). + if n.kind in nkCallKinds and sfFromGeneric in n[0].sym.flags: + var needsFixing = false + for i in 1..<n.safeLen: + if isTypeParam(n[i]): needsFixing = true + if needsFixing: + n[0] = newSymNode(n[0].sym.owner) + return cl.c.semOverloadedCall(cl.c, n, n, {skProc, skFunc}, {}) + + for i in 0..<n.safeLen: + n[i] = reResolveCallsWithTypedescParams(cl, n[i]) + + return n + +proc replaceObjBranches(cl: TReplTypeVars, n: PNode): PNode = + result = n + 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) - result.typ = ReplaceTypeVarsT(cl, n.typ) + 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: - nil + discard + of nkOpenSymChoice, nkClosedSymChoice: result = n of nkSym: - result.sym = ReplaceTypeVarsS(cl, n.sym) + result.sym = + if n.typ != nil and n.typ == n.sym.typ: + replaceTypeVarsS(cl, n.sym, result.typ) + else: + replaceTypeVarsS(cl, n.sym, replaceTypeVarsT(cl, n.sym.typ)) + # sym type can be nil if was gensym created by macro, see #24048 + if result.sym.typ != nil and result.sym.typ.kind == tyVoid: + # don't add the 'void' field + result = newNodeI(nkRecList, n.info) of nkRecWhen: var branch: PNode = nil # the branch to take - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - if it == nil: illFormedAst(n) + 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) - var cond = prepareNode(cl, it.sons[0]) - var e = cl.c.semConstExpr(cl.c, cond) - if e.kind != nkIntLit: - InternalError(e.info, "ReplaceTypeVarsN: when condition not a bool") - if e.intVal != 0 and branch == nil: branch = it.sons[1] + checkSonsLen(it, 2, cl.c.config) + 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) - if branch == nil: branch = it.sons[0] - else: illFormedAst(n) + checkSonsLen(it, 1, cl.c.config) + if branch == nil: branch = it[0] + else: illFormedAst(n, cl.c.config) if branch != nil: - result = ReplaceTypeVarsN(cl, branch) + result = replaceTypeVarsN(cl, branch) else: result = newNodeI(nkRecList, n.info) + of nkStaticExpr: + var n = prepareNode(cl, n) + when false: + n = reResolveCallsWithTypedescParams(cl, n) + result = if cl.allowMetaTypes: 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) - for i in countup(0, length - 1): - result.sons[i] = ReplaceTypeVarsN(cl, n.sons[i]) - -proc ReplaceTypeVarsS(cl: var TReplTypeVars, s: PSym): PSym = + if n.len > 0: + newSons(result, n.len) + if start > 0: + result[0] = n[0] + for i in start..<n.len: + result[i] = replaceTypeVarsN(cl, n[i]) + +proc replaceTypeVarsS(cl: var TReplTypeVars, s: PSym, t: PType): PSym = if s == nil: return nil - result = PSym(idTableGet(cl.symMap, s)) - if result == nil: - result = copySym(s, false) - incl(result.flags, sfFromGeneric) - idTablePut(cl.symMap, s, result) - result.typ = ReplaceTypeVarsT(cl, s.typ) - result.owner = s.owner - result.ast = ReplaceTypeVarsN(cl, s.ast) - -proc lookupTypeVar(cl: TReplTypeVars, t: PType): PType = - result = PType(idTableGet(cl.typeMap, t)) + # 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: + #[ + + 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 = 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: - LocalError(t.sym.info, errCannotInstantiateX, typeToString(t)) + if cl.allowMetaTypes or tfRetType in t.flags: return + localError(cl.c.config, t.sym.info, "cannot instantiate: '" & typeToString(t) & "'") result = errorType(cl.c) - elif result.kind == tyGenericParam: - InternalError(cl.info, "substitution with generic parameter") - -proc handleGenericInvokation(cl: var TReplTypeVars, t: PType): PType = - # tyGenericInvokation[A, tyGenericInvokation[A, B]] - # is difficult to handle: - var body = t.sons[0] - if body.kind != tyGenericBody: InternalError(cl.info, "no generic body") - var header: PType = nil + # In order to prevent endless recursions, we must remember + # this bad lookup and replace it with errorType everywhere. + # These code paths are only active in "nim check" + cl.typeMap.put(t, result) + elif result.kind == tyGenericParam and not cl.allowMetaTypes: + internalError(cl.c.config, cl.info, "substitution with generic parameter") + +proc instCopyType*(cl: var TReplTypeVars, t: PType): PType = + # XXX: relying on allowMetaTypes is a kludge + 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.sink = nil + +proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = + # tyGenericInvocation[A, tyGenericInvocation[A, B]] + # is difficult to handle: + 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: - result = searchInstTypes(t) - if result != nil: return - for i in countup(1, sonsLen(t) - 1): - var x = t.sons[i] - if x.kind == tyGenericParam: + if cl.allowMetaTypes: + result = getOrDefault(cl.localCache, t.itemId) + else: + result = searchInstTypes(cl.c.graph, t) + + 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 header == nil: header = copyType(t, t.owner, false) - header.sons[i] = x + if x != nil: + if header == t: header = instCopyType(cl, t) + header[i] = x + propagateToOwner(header, x) + else: propagateToOwner(header, x) - #idTablePut(cl.typeMap, body.sons[i-1], x) - if header != nil: + + if header != t: # search again after first pass: - result = searchInstTypes(header) - if result != nil: 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 = copyType(t, t.owner, false) + header = instCopyType(cl, t) + + 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) # 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: - result = newType(tyGenericInst, t.sons[0].owner) - result.rawAddSon(header.sons[0]) - cacheTypeInst(result) - - for i in countup(1, sonsLen(t) - 1): - var x = replaceTypeVarsT(cl, t.sons[i]) - assert x.kind != tyGenericInvokation - header.sons[i] = x + if not cl.allowMetaTypes: + cacheTypeInst(cl.c, result) + else: + cl.localCache[t.itemId] = result + + let oldSkipTypedesc = cl.skipTypedesc + cl.skipTypedesc = true + + cl.typeMap = newTypeMapLayer(cl) + + for i in FirstGenericParamAt..<t.kidsLen: + var x = replaceTypeVarsT(cl): + if header[i].kind == tyGenericInst: + t[i] + else: + header[i] + assert x.kind != tyGenericInvocation + header[i] = x propagateToOwner(header, x) - idTablePut(cl.typeMap, body.sons[i-1], x) - - for i in countup(1, sonsLen(t) - 1): + cl.typeMap.put(body[i-1], x) + + 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]) - - var newbody = ReplaceTypeVarsT(cl, lastSon(body)) - newbody.flags = newbody.flags + t.flags + body.flags - result.flags = result.flags + newbody.flags - newbody.callConv = body.callConv - newbody.n = ReplaceTypeVarsN(cl, lastSon(body).n) + rawAddSon(result, header[i], propagateHasAsgn = false) + + if body.kind == tyError: + return + + let bbody = last body + var newbody = replaceTypeVarsT(cl, bbody) + cl.skipTypedesc = oldSkipTypedesc + newbody.flags = newbody.flags + (t.flags + body.flags - tfInstClearedFlags) + result.flags = result.flags + newbody.flags - tfInstClearedFlags + + cl.typeMap = cl.typeMap.nextLayer + + # This is actually wrong: tgeneric_closure fails with this line: + #newbody.callConv = body.callConv # This type may be a generic alias and we want to resolve it here. # One step is enough, because the recursive nature of - # handleGenericInvokation will handle the alias-to-alias-to-alias case + # handleGenericInvocation will handle the alias-to-alias-to-alias case if newbody.isGenericAlias: newbody = newbody.skipGenericAlias + rawAddSon(result, newbody) - checkPartialConstructedType(cl.info, newbody) - -proc ReplaceTypeVarsT*(cl: var TReplTypeVars, t: PType): PType = + checkPartialConstructedType(cl.c.config, cl.info, newbody) + 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*: + 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} + 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.returnType != nil and t.returnType.kind == tyVoid: + t.setReturnType nil + + for i in FirstParamAt..<t.signatureLen: + # don't touch any memory unless necessary + if t[i].kind == tyVoid: + var pos = i + for j in i+1..<t.signatureLen: + if t[j].kind != tyVoid: + t[pos] = t[j] + t.n[pos] = t.n[j] + inc pos + newSons t, pos + setLen t.n.sons, pos + break + +proc skipIntLiteralParams*(t: PType; idgen: IdGenerator) = + for i, p in t.ikids: + if p == nil: continue + let skipped = p.skipIntLit(idgen) + if skipped != p: + 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.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 + # The type must be fully instantiated! + if n.isNil: + return + #internalAssert n.kind != nkRecWhen + case n.kind + of nkSym: + propagateToOwner(t, n.sym.typ) + of nkRecList, nkRecCase, nkOfBranch, nkElse: + for son in n: + propagateFieldFlags(t, son) + else: discard + +proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = + template bailout = + 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 == nil: return + + 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 tyTypeClass: nil - of tyGenericParam: - result = lookupTypeVar(cl, t) - if result.kind == tyGenericInvokation: - result = handleGenericInvokation(cl, result) - of tyGenericInvokation: - result = handleGenericInvokation(cl, t) + of tyGenericInvocation: + result = handleGenericInvocation(cl, t) + if result.last.kind == tyUserTypeClass: + result.kind = tyUserTypeClassInst + of tyGenericBody: - InternalError(cl.info, "ReplaceTypeVarsT: tyGenericBody") - result = ReplaceTypeVarsT(cl, lastSon(t)) - of tyInt: - result = skipIntLit(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)) + + of tyFromExpr: + if cl.allowMetaTypes: return + # This assert is triggered when a tyFromExpr was created in a cyclic + # way. You should break the cycle at the point of creation by introducing + # a call such as: `n.typ = makeTypeFromExpr(c, n.copyTree)` + # Otherwise, the cycle will be fatal for the prepareNode call below + assert t.n.typ != t + var n = prepareNode(cl, t.n) + if n.kind != nkEmpty: + 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 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, son = n.typ) + result.n = n + else: + result = n.typ + + of tyInt, tyFloat: + result = skipIntLit(t, cl.c.idgen) + + of tyTypeDesc: + let lookup = cl.typeMap.lookup(t) + if lookup != nil: + result = lookup + 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) + 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): - result = copyType(t, t.owner, false) - incl(result.flags, tfFromGeneric) + #if not cl.allowMetaTypes: + bailout() + result = instCopyType(cl, t) result.size = -1 # needs to be recomputed - for i in countup(0, sonsLen(result) - 1): - result.sons[i] = ReplaceTypeVarsT(cl, result.sons[i]) - result.n = ReplaceTypeVarsN(cl, result.n) - if result.Kind in GenericTypes: - LocalError(cl.info, errCannotInstantiateX, TypeToString(t, preferName)) - if result.kind == tyProc and result.sons[0] != nil: - if result.sons[0].kind == tyEmpty: - result.sons[0] = nil - -proc generateTypeInstance*(p: PContext, pt: TIdTable, arg: PNode, - t: PType): PType = - var cl: TReplTypeVars - InitIdTable(cl.symMap) - copyIdTable(cl.typeMap, pt) - cl.info = arg.info - cl.c = p - pushInfoContext(arg.info) - result = ReplaceTypeVarsT(cl, t) - popInfoContext() + #if not cl.allowMetaTypes: + 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, tyOwned}) + if r2.kind in {tyPtr, tyRef}: + r = skipTypes(r2, {tyPtr, tyRef}) + 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.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, 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) + + 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 = + result = TReplTypeVars(symMap: initSymMapping(), + localCache: initTypeMapping(), typeMap: typeMap, + info: info, c: p, owner: owner) + +proc replaceTypesInBody*(p: PContext, pt: TypeMapping, n: PNode; + owner: PSym, allowMetaTypes = false, + fromStaticExpr = false, expectedType: PType = nil): PNode = + var typeMap = initLayeredTypeMap(pt) + var cl = initTypeVars(p, typeMap, n.info, owner) + cl.allowMetaTypes = allowMetaTypes + pushInfoContext(p.config, n.info) + result = replaceTypeVarsN(cl, n, expectedType = expectedType) + popInfoContext(p.config) + +proc prepareTypesInBody*(p: PContext, pt: TypeMapping, n: PNode; + owner: PSym = nil): PNode = + var typeMap = initLayeredTypeMap(pt) + var cl = initTypeVars(p, typeMap, n.info, owner) + pushInfoContext(p.config, n.info) + result = prepareNode(cl, n) + popInfoContext(p.config) + +when false: + # 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, 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: TypeMapping, info: TLineInfo, + t: PType): PType = + var typeMap = initLayeredTypeMap(pt) + 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: 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 8e8fe20bf..000000000 --- a/compiler/service.nim +++ /dev/null @@ -1,98 +0,0 @@ -# -# -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf -# -# See the file "copying.txt", included in this -# distribution, for details about the copyright. -# - -## Implements the "compiler as a service" feature. - -import - sockets, - times, commands, options, msgs, nimconf, - extccomp, strutils, os, platform, parseopt - -# 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 CRC 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? - arguments* = "" - # the arguments to be passed to the program that - # should be run - -proc ProcessCmdLine*(pass: TCmdLinePass, cmd: string) = - var p = parseopt.initOptParser(cmd) - var argsCount = 0 - while true: - parseopt.next(p) - case p.kind - of cmdEnd: break - of cmdLongOption, cmdShortOption: - # hint[X]:off is parsed as (p.key = "hint[X]", p.val = "off") - # we fix this here - 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 - ProcessSwitch(key, val, pass, gCmdLineInfo) - else: - ProcessSwitch(p.key, p.val, pass, gCmdLineInfo) - of cmdArgument: - if argsCount == 0: - options.command = p.key - else: - if pass == passCmd1: options.commandArgs.add p.key - if argsCount == 1: - # support UNIX style filenames anywhere for portable build scripts: - options.gProjectName = unixToNativePath(p.key) - arguments = cmdLineRest(p) - break - inc argsCount - - if pass == passCmd2: - if optRun notin gGlobalOptions and arguments != "": - rawMessage(errArgsNeedRunOption, []) - -proc serve*(action: proc (){.nimcall.}) = - template execute(cmd) = - curCaasCmd = cmd - processCmdLine(passCmd2, cmd) - action() - gDirtyBufferIdx = 0 - gDirtyOriginalIdx = 0 - gErrorCounter = 0 - - let typ = getConfigVar("server.type") - case typ - of "stdin": - while true: - var line = stdin.readLine.string - if line == "quit": quit() - execute line - echo "" - FlushFile(stdout) - - of "tcp", "": - var server = Socket() - let p = getConfigVar("server.port") - let port = if p.len > 0: parseInt(p).TPort else: 6000.TPort - server.bindAddr(port, getConfigVar("server.address")) - var inp = "".TaintedString - server.listen() - new(stdoutSocket) - while true: - accept(server, stdoutSocket) - stdoutSocket.readLine(inp) - execute inp.string - stdoutSocket.send("\c\L") - stdoutSocket.close() - else: - echo "Invalid server.type:", typ - quit 1 diff --git a/compiler/sighashes.nim b/compiler/sighashes.nim new file mode 100644 index 000000000..d8dfe1828 --- /dev/null +++ b/compiler/sighashes.nim @@ -0,0 +1,437 @@ +# +# +# The Nim Compiler +# (c) Copyright 2017 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Computes hash values for routine (proc, method etc) signatures. + +import ast, ropes, modulegraphs, options, msgs, pathutils +from std/hashes import Hash +import std/tables +import types +import ../dist/checksums/src/checksums/md5 + + +when defined(nimPreviewSlimSystem): + import std/assertions + + +proc `&=`(c: var MD5Context, s: string) = md5Update(c, s, s.len) +proc `&=`(c: var MD5Context, ch: char) = + # 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]; conf: ConfigRef) +proc hashSym(c: var MD5Context, s: PSym) = + if sfAnon in s.flags or s.kind == skGenericParam: + c &= ":anon" + else: + var it = s + while it != nil: + c &= it.name.s + c &= "." + it = it.owner + c &= "#" + c &= s.disamb + +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}, conf + c &= it.name.s + c &= "." + it = it.owner + c &= "#" + c &= s.disamb + +proc hashTree(c: var MD5Context, n: PNode; flags: set[ConsiderFlag]; conf: ConfigRef) = + if n == nil: + c &= "\255" + return + let k = n.kind + c &= char(k) + # 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) + 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 + of nkFloatLit..nkFloat64Lit: + let v = n.floatVal + lowlevel v + of nkStrLit..nkTripleStrLit: + c &= n.strVal + else: + for i in 0..<n.len: hashTree(c, n[i], flags, conf) + +proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]; conf: ConfigRef) = + if t == nil: + c &= "\254" + return + + case t.kind + of tyGenericInvocation: + for a in t.kids: + c.hashType a, flags, conf + of tyDistinct: + if CoDistinct in flags: + if t.sym != nil: c.hashSym(t.sym) + if t.sym == nil or tfFromGeneric in t.flags: + c.hashType t.elementType, flags, conf + elif CoType in flags or t.sym == nil: + c.hashType t.elementType, flags, conf + else: + c.hashSym(t.sym) + of tyGenericInst: + if sfInfixCall in t.base.sym.flags: + # This is an imported C++ generic type. + # 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 + c.hashType normalizedType.genericHead, flags, conf + for _, a in normalizedType.genericInstParams: + c.hashType a, flags, conf + else: + 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``: + c &= char(t.kind) + if t.sym != nil and {sfImportc, sfExportc} * t.sym.flags != {}: + c.hashSym(t.sym) + of tyObject, tyEnum: + if t.typeInst != nil: + # 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 {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) + + 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.hasElementType and t.baseClass != nil: + hashType c, t.baseClass, flags, conf + of tyRef, tyPtr, tyVar: + c &= char(t.kind) + 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, {}, conf) + of tyTuple: + c &= char(t.kind) + if t.n != nil and CoType notin flags: + for i in 0..<t.n.len: + assert(t.n[i].kind == nkSym) + c &= t.n[i].sym.name.s + c &= ':' + c.hashType(t.n[i].sym.typ, flags+{CoIgnoreRange}, conf) + c &= ',' + else: + 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, {}, conf) + c.hashType(t.elementType, flags, conf) + of tyStatic: + c &= char(t.kind) + 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 ") + if CoProc in flags and t.n != nil: + let params = t.n + for i in 1..<params.len: + let param = params[i].sym + c &= param.name.s + c &= ':' + c.hashType(param.typ, flags, conf) + c &= ',' + c.hashType(t.returnType, flags, conf) + else: + for a in t.signature: c.hashType(a, flags, conf) + c &= char(t.callConv) + # purity of functions doesn't have to affect the mangling (which is in fact + # problematic for HCR - someone could have cached a pointer to another + # 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) + c.hashType(t.indexType, flags-{CoIgnoreRange}, conf) + c.hashType(t.elementType, flags-{CoIgnoreRange}, conf) + else: + c &= char(t.kind) + 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): + import db_sqlite + + let db = open(connection="sighashes.db", user="araq", password="", + database="sighashes") + db.exec(sql"DROP TABLE IF EXISTS sighashes") + db.exec sql"""CREATE TABLE sighashes( + id integer primary key, + hash varchar(5000) not null, + type varchar(5000) not null, + unique (hash, type))""" + # 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; conf: ConfigRef; flags: set[ConsiderFlag] = {CoType}): SigHash = + result = default(SigHash) + var c: MD5Context = default(MD5Context) + md5Init c + 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; conf: ConfigRef): SigHash = + result = default(SigHash) + var c: MD5Context = default(MD5Context) + md5Init c + hashType c, s.typ, {CoProc}, conf + + var m = s + while m.kind != skModule: m = m.owner + let p = m.owner + assert p.kind == skPackage + c &= p.name.s + c &= "." + c &= m.name.s + if sfDispatcher in s.flags: + c &= ".dispatcher" + # so that createThread[void]() (aka generic specialization) gets a unique + # 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 + +proc hashNonProc*(s: PSym): SigHash = + result = default(SigHash) + var c: MD5Context = default(MD5Context) + md5Init c + hashSym(c, s) + var it = s + while it != nil: + c &= it.name.s + c &= "." + it = it.owner + # for bug #5135 we also take the position into account, but only + # for parameters, because who knows what else position dependency + # might cause: + if s.kind == skParam: + c &= s.position + md5Final c, result.MD5Digest + +proc hashOwner*(s: PSym): SigHash = + result = default(SigHash) + var c: MD5Context = default(MD5Context) + md5Init c + var m = s + while m.kind != skModule: m = m.owner + let p = m.owner + assert p.kind == skPackage + c &= p.name.s + c &= "." + c &= m.name.s + + 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]; 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 regarding + # Nim changes: + 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) + #if sigs == "_jckmNePK3i2MFnWwZlp6Lg" and s.name.s == "contains": + # echo "counter ", counter, " ", s.id + if counter != 0: + result.add "_" & rope(counter+1) + # this minor hack is necessary to make tests/collections/thashes compile. + # The inlined hash function's original module is ambiguous so we end up + # generating duplicate names otherwise: + if s.typ.callConv == ccInline: + result.add rope(currentModule) + sigCollisions.inc(sig) + else: + let sig = hashNonProc(s) + result = rope($sig) + let counter = sigCollisions.getOrDefault(sig) + if counter != 0: + result.add "_" & rope(counter+1) + sigCollisions.inc(sig) + diff --git a/compiler/sigmatch.nim b/compiler/sigmatch.nim index 041baf126..6ea2c7bb5 100644 --- a/compiler/sigmatch.nim +++ b/compiler/sigmatch.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2013 Andreas Rumpf # # See the file "copying.txt", included in this @@ -10,16 +10,41 @@ ## This module implements the signature matching for resolving ## 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, - docgen +import + ast, astalgo, semdata, types, msgs, renderer, lookups, semtypinst, + magicsys, idents, lexer, options, parampatterns, trees, + linter, lineinfos, lowerings, modulegraphs, concepts + +import std/[intsets, strutils, tables] + +when defined(nimPreviewSlimSystem): + import std/assertions type - TCandidateState* = enum + 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 - TCandidate* {.final.} = object + CandidateError* = object + sym*: PSym + firstMismatch*: MismatchInfo + diagnostics*: seq[string] + enabled*: bool + + CandidateErrors* = seq[CandidateError] + + TCandidate* = object + c*: PContext exactMatches*: int # also misused to prefer iters over procs genericMatches: int # also misused to prefer constraints subtypeMatches: int @@ -28,118 +53,355 @@ type state*: TCandidateState callee*: PType # may not be nil! calleeSym*: PSym # may be nil - calleeScope: int # may be -1 for unknown scope + 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 - proxyMatch*: bool # to prevent instantiations + 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 - inheritancePenalty: int # to prefer closest father object type - - 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`` - isGeneric, - isFromIntLit, # conversion *from* int literal; proven safe - isEqual - + coerceDistincts*: bool # this is an explicit coercion that can strip away + # a distrinct type + typedescMatched*: bool + isNoCall*: bool # misused for generic type instantiations C[T] + inferredTypes: seq[PType] # inferred types during the current signature + # matching. they will be reset if the matching + # is not successful. may replace the bindings + # table in the future. + diagnostics*: seq[string] # \ + # when diagnosticsEnabled, the matching process + # will collect extra diagnostics that will be + # displayed to the user. + # triggered when overload resolution fails + # or when the explain pragma is used. may be + # triggered with an idetools command in the + # future. + # 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] + + const isNilConversion = isConvertible # maybe 'isIntConv' fits better? - -proc markUsed*(n: PNode, s: PSym) - -proc initCandidateAux(c: var TCandidate, callee: PType) {.inline.} = - 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*(c: var TCandidate, callee: PType) = - initCandidateAux(c, callee) - c.calleeSym = nil - initIdTable(c.bindings) - -proc put(t: var TIdTable, key, val: PType) {.inline.} = - IdTablePut(t, key, val) - -proc initCandidate*(c: var TCandidate, callee: PSym, binding: PNode, - calleeScope = -1) = - initCandidateAux(c, callee.typ) - c.calleeSym = callee - c.calleeScope = calleeScope - initIdTable(c.bindings) - 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 - #debug(formalTypeParam) - put(c.bindings, formalTypeParam, binding[i].typ) - -proc copyCandidate(a: var TCandidate, b: TCandidate) = - 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) + maxInheritancePenalty = high(int) div 2 + +proc markUsed*(c: PContext; info: TLineInfo, s: PSym; checkStyle = true) +proc markOwnerModuleAsUsed*(c: PContext; s: PSym) + +proc initCandidateAux(ctx: PContext, + callee: PType): TCandidate {.inline.} = + result = TCandidate(c: ctx, exactMatches: 0, subtypeMatches: 0, + convMatches: 0, intConvMatches: 0, genericMatches: 0, + state: csEmpty, firstMismatch: MismatchInfo(), + callee: callee, call: nil, baseTypeMatch: false, + genericConverter: false, inheritancePenalty: -1 + ) + +proc initCandidate*(ctx: PContext, callee: PType): TCandidate = + result = initCandidateAux(ctx, callee) + result.calleeSym = nil + result.bindings = initTypeMapping() + +proc put(c: var TCandidate, key, val: PType) {.inline.} = + ## Given: proc foo[T](x: T); foo(4) + ## key: 'T' + ## val: 'int' (typeof(4)) + when false: + let old = 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 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): TCandidate = + result = initCandidateAux(ctx, callee.typ) + result.calleeSym = callee + if callee.kind in skProcKinds and calleeScope == -1: + result.calleeScope = cmpScopes(ctx, callee) + else: + 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: + 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 = + result = initCandidate(ctx, callee, binding, calleeScope) + +proc newCandidate*(ctx: PContext, callee: PType): TCandidate = + 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 while true: case t.kind - of tyGenericInst, tyArray, tyRef, tyPtr, tyDistinct, tyArrayConstr, - tyOpenArray, tyVarargs, tySet, tyRange, tySequence, tyGenericBody: - 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 - of tyVar: - # but do not make 'var T' more specific than 'T'! - t = t.sons[0] - of tyGenericInvokation, tyTuple: - result = ord(t.kind == tyGenericInvokation) - for i in 0 .. <t.len: result += t.sons[i].sumGeneric break - of tyGenericParam, tyExpr, tyStmt, tyTypeDesc, tyTypeClass: break - else: return 0 + of tyGenericBody: + t = t.typeBodyImpl + of tyGenericInst, tyStatic: + t = t.skipModifier + inc result + of tyOr: + var maxBranch = 0 + for branch in t.kids: + let branchSum = sumGeneric(branch) + if branchSum > maxBranch: maxBranch = branchSum + inc result, maxBranch + break + of tyTypeDesc: + t = t.elementType + if t.kind == tyEmpty: break + inc result + 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 + else: + break proc complexDisambiguation(a, b: PType): int = - 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 - result = x - y + # 'a' matches better if *every* argument matches better or equal than 'b'. + var winner = 0 + 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 + else: winner = -1 + elif x > y: + if winner != 1: + # contradiction + return 0 + else: + if winner != -1: + return 0 + result = winner when false: - proc betterThan(a, b: PType): bool {.inline.} = a.sumGeneric > b.sumGeneric - - if a.len > 1 and b.len > 1: - let aa = a.sons[1].sumGeneric - let bb = b.sons[1].sumGeneric - var a = a - var b = b - - if aa < bb: swap(a, b) - # all must be better - for i in 2 .. <min(a.len, b.len): - if not a.sons[i].betterThan(b.sons[i]): return 0 - # a must be longer or of the same length as b: - result = a.len - b.len - -proc cmpCandidates*(a, b: TCandidate): int = + var x, y: int + 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) = + echo "Candidate '", c.calleeSym.name.s, "' at ", c.c.config $ c.calleeSym.info + echo " exact matches: ", c.exactMatches + echo " generic matches: ", c.genericMatches + echo " subtype matches: ", c.subtypeMatches + echo " intconv matches: ", c.intConvMatches + echo " conv matches: ", c.convMatches + echo " inheritance: ", c.inheritancePenalty + +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 @@ -150,394 +412,1188 @@ proc cmpCandidates*(a, b: TCandidate): int = if result != 0: return result = a.convMatches - b.convMatches if result != 0: return - if (a.calleeScope != -1) and (b.calleeScope != -1): - result = a.calleeScope - b.calleeScope + result = cmpInheritancePenalty(a.inheritancePenalty, b.inheritancePenalty) + if result != 0: return + if isFormal: + # check for generic subclass relation + result = checkGeneric(a, b) if result != 0: return - # the other way round because of other semantics: - result = b.inheritancePenalty - a.inheritancePenalty + # prefer more specialized generic over more general generic: + result = complexDisambiguation(a.callee, b.callee) if result != 0: return - # prefer more specialized generic over more general generic: - result = complexDisambiguation(a.callee, b.callee) - -proc writeMatches*(c: TCandidate) = - Writeln(stdout, "exact matches: " & $c.exactMatches) - Writeln(stdout, "subtype matches: " & $c.subtypeMatches) - Writeln(stdout, "conv matches: " & $c.convMatches) - Writeln(stdout, "intconv matches: " & $c.intConvMatches) - Writeln(stdout, "generic matches: " & $c.genericMatches) + # only as a last resort, consider scoping: + result = a.calleeScope - b.calleeScope -proc argTypeToString(arg: PNode): string = +proc argTypeToString(arg: PNode; prefer: TPreferedDesc): string = if arg.kind in nkSymChoices: - result = typeToString(arg[0].typ) - for i in 1 .. <arg.len: + result = typeToString(arg[0].typ, prefer) + for i in 1..<arg.len: result.add(" | ") - result.add typeToString(arg[i].typ) + result.add typeToString(arg[i].typ, prefer) + elif arg.typ == nil: + result = "void" else: - result = arg.typ.typeToString - -proc NotFoundError*(c: PContext, n: PNode) = - # Gives a detailed error message; this is separated from semOverloadedCall, - # as semOverlodedCall is already pretty slow (and we need this information - # only in case of an error). - if c.InCompilesContext > 0: - # fail fast: - GlobalError(n.info, errTypeMismatch, "") - var result = msgKindToString(errTypeMismatch) - for i in countup(1, sonsLen(n) - 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: - 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: - arg = c.semOperand(c, n.sons[i]) - n.sons[i] = arg - if arg.typ.kind == tyError: return - add(result, argTypeToString(arg)) - if i != sonsLen(n) - 1: add(result, ", ") - add(result, ')') - var candidates = "" - var o: TOverloadIter - var sym = initOverloadIter(o, c, n.sons[0]) - while sym != nil: - if sym.kind in RoutineKinds: - add(candidates, getProcHeader(sym)) - add(candidates, "\n") - sym = nextOverloadIter(o, c, n.sons[0]) - if candidates != "": - add(result, "\n" & msgKindToString(errButExpected) & "\n" & candidates) - LocalError(n.Info, errGenerated, result) - -proc typeRel(c: var TCandidate, f, a: PType): TTypeRelation -proc concreteType(c: TCandidate, t: PType): PType = + result = arg.typ.typeToString(prefer) + +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 = "" + 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 tyArrayConstr: - # make it an array - result = newType(tyArray, t.owner) - addSonSkipIntLit(result, t.sons[0]) # XXX: t.owner is wrong for ID! - addSonSkipIntLit(result, t.sons[1]) # XXX: semantic checking for the type? - of tyNil: - result = nil # what should it be? - of tyGenericParam: + of tyTypeDesc: + if c.isNoCall: result = t + else: result = nil + of tySequence, tySet: + if t.elementType.kind == tyEmpty: result = nil + else: result = t + of tyGenericParam, tyAnything, tyConcept: result = t - while true: - result = PType(idTableGet(c.bindings, t)) + if c.isNoCall: return + while true: + 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 tyGenericInvokation: - InternalError("cannot resolve type: " & typeToString(t)) - result = t + of tyGenericInvocation: + 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 = - if a.kind == f.kind: + +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(f) and - ab.n.intVal <= lastOrd(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 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: + 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(f) and - a.n[1].intVal <= lastOrd(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 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}: - result = true - elif f.kind in {tyFloat..tyFloat128} and - a.kind in {tyFloat..tyFloat128}: - result = true + case f.kind + 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}: + # `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: +proc handleFloatRange(f, a: PType): TTypeRelation = + if a.kind == f.kind: result = isEqual - else: + else: let ab = skipTypes(a, {tyRange}) var k = ab.kind if k == f.kind: result = isSubrange + elif isFloatLit(ab): result = isFromIntLit elif isIntLit(ab): result = isConvertible - elif k >= tyFloat and k <= tyFloat128: result = isConvertible + elif k >= tyFloat and k <= tyFloat128: + # conversion to "float32" is not as good: + if f.kind == tyFloat32: result = isConvertible + else: result = isIntConv else: result = isNone - -proc isObjectSubtype(a, f: PType): int = + +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.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 assert t.kind == tyObject var depth = 0 - while t != nil and not sameObjectTypes(f, t): - assert t.kind == tyObject - t = t.sons[0] + var last = a + while t != nil and not sameObjectTypes(f, t): + if t.kind != tyObject: # avoid entering generic params etc + return -1 + t = t.baseClass if t == nil: break - t = skipTypes(t, {tyGenericInst}) + last = t + t = skipTypes(t, skipPtrs) inc depth if t != nil: + genericParamPut(c, last, fGenericOrigin) result = depth + else: + result = -1 + +type + SkippedPtr = enum skippedNone, skippedRef, skippedPtr + +proc skipToObject(t: PType; skipped: var SkippedPtr): PType = + var r = t + # we're allowed to skip one level of ptr/ref: + var ptrs = 0 + while r != nil: + case r.kind + of tyGenericInvocation: + r = r.genericHead + of tyRef: + inc ptrs + skipped = skippedRef + r = r.elementType + of tyPtr: + inc ptrs + skipped = skippedPtr + 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 minRel(a, b: TTypeRelation): TTypeRelation = +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 + var t = a.skipToObject(askip) + let r = f.skipToObject(fskip) + if r == nil: return false + var depth = 0 + var last = a + # 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.baseClass + if t == nil: break + last = t + t = t.skipToObject(askip) + inc depth + if t != nil and askip == fskip: + 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 tupleRel(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 - for i in countup(0, sonsLen(f) - 1): - var m = typeRel(c, f.sons[i], a.sons[i]) + let firstField = if f.kind == tyTuple: 0 + else: 1 + 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: InternalError(f.n.info, "tupleRel") - elif a.n.sons[i].kind != nkSym: InternalError(a.n.info, "tupleRel") + 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 + 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 proc allowsNil(f: PType): TTypeRelation {.inline.} = result = if tfNotNil notin f.flags: isSubtype else: isNone -proc procTypeRel(c: var TCandidate, f, a: PType): TTypeRelation = - proc inconsistentVarTypes(f, a: PType): bool {.inline.} = - result = f.kind != a.kind and (f.kind == tyVar or a.kind == tyVar) +proc inconsistentVarTypes(f, a: PType): bool {.inline.} = + result = (f.kind != a.kind and + (f.kind in {tyVar, tyLent, tySink} or a.kind in {tyVar, tyLent, tySink})) or + isOutParam(f) != isOutParam(a) + +proc procParamTypeRel(c: var TCandidate; f, a: PType): TTypeRelation = + ## For example we have: + ## ```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: + ## - matches f=T to a=Q. Since f is metatype, we resolve it + ## to int (which is already known at this point). So in this case + ## Q=int mapping will be saved to c.bindings. + ## - matches f=S to a=W. Both of these metatypes are unknown, so we + ## return with isBothMetaConvertible to ask for rerun. + ## - matches f=S to a=W. At this point the return type of innerProc + ## is known (we get it from c.bindings). We can use that value + ## to match with f, and save back to c.bindings. + var + f = f + a = a + + if a.isMetaType: + 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 chance that the target + # type is already fully-determined, so we are + # going to try resolve it + 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 + # Note that this typeRel call will save a's resolved type into c.bindings + let reverseRel = typeRel(c, a, f) + 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 <= isSubrange or inconsistentVarTypes(f, a): + result = isNone + + #if result == isEqual: + # inc c.exactMatches + +proc procTypeRel(c: var TCandidate, f, a: PType): TTypeRelation = case a.kind of tyProc: - if sonsLen(f) != sonsLen(a): return - # Note: We have to do unification for the parameters before the - # return type! + var f = f + copyingEraseVoidParams(c, f) + if f.signatureLen != a.signatureLen: return result = isEqual # start with maximum; also correct for no # params at all - for i in countup(1, sonsLen(f)-1): - var m = typeRel(c, f.sons[i], a.sons[i]) - if m <= isSubtype or inconsistentVarTypes(f.sons[i], a.sons[i]): - return isNone - else: result = minRel(m, result) - if f.sons[0] != nil: - if a.sons[0] != nil: - var m = typeRel(c, f.sons[0], a.sons[0]) - # Subtype is sufficient for return types! - if m < isSubtype or inconsistentVarTypes(f.sons[0], a.sons[0]): - return isNone - elif m == isSubtype: result = isConvertible - else: result = minRel(m, result) - else: - return isNone - elif a.sons[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} == {}: - # noSideEffect implies ``tfThread``! XXX really? - return isNone - elif f.flags * {tfIterator} != a.flags * {tfIterator}: + + if 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 = isConvertible + + 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.len: + checkParam(f[i], a[i]) + + if f[0] != nil: + if a[0] != nil: + checkParam(f[0], a[0]) else: return isNone + elif a[0] != nil: + return isNone + + result = getProcConvMismatch(c.c.config, f, a, result)[1] + when useEffectSystem: - if not compatibleEffects(f, a): return isNone - of tyNil: result = f.allowsNil - else: nil + if compatibleEffects(f, a) != efCompat: return isNone + when defined(drnim): + if not c.c.graph.compatibleProps(c.c.graph, f, a): return isNone -proc matchTypeClass(c: var TCandidate, f, a: PType): TTypeRelation = - result = if matchTypeClass(c.bindings, f, a): isGeneric - else: isNone + of tyNil: + result = f.allowsNil + else: result = isNone proc typeRangeRel(f, a: PType): TTypeRelation {.noinline.} = - let - a0 = firstOrd(a) - a1 = lastOrd(a) - f0 = firstOrd(f) - f1 = lastOrd(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: + 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() + prevMatchedConcept = c.matchedConcept + prevCandidateType = typeClass[0][0] + + if prevMatchedConcept != nil: + matchedConceptContext.prev = prevMatchedConcept + matchedConceptContext.depth = prevMatchedConcept.depth + 1 + if prevMatchedConcept.depth > 4: + localError(m.c.graph.config, body.info, $body & " too nested for type matching") + return nil + + openScope(c) + matchedConceptContext.candidateType = a + typeClass[0][0] = a + c.matchedConcept = addr(matchedConceptContext) + defer: + c.matchedConcept = prevMatchedConcept + typeClass[0][0] = prevCandidateType + closeScope(c) + + var typeParams: seq[(PSym, PType)] = @[] + + if ff.kind == tyUserTypeClassInst: + for i in 1..<(ff.len - 1): + var + typeParamName = ff.base[i-1].sym.name + typ = ff[i] + param: PSym = nil + alreadyBound = idTableGet(m.bindings, typ) + + if alreadyBound != nil: typ = alreadyBound + + template paramSym(kind): untyped = + newSym(kind, typeParamName, c.idgen, typeClass.sym, typeClass.sym.info, {}) + + block addTypeParam: + for prev in typeParams: + if prev[1].id == typ.id: + param = paramSym prev[0].kind + param.typ = prev[0].typ + break addTypeParam + + case typ.kind + 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 tyFromExpr: + param = paramSym skVar + param.typ = typ.exactReplica + #copyType(typ, c.idgen, typ.owner) + else: + param = paramSym skType + param.typ = if typ.isMetaType: + newTypeS(tyInferred, c, typ) + else: + makeTypeDesc(c, typ) + + typeParams.add((param, typ)) + + addDecl(c, param) + + var + oldWriteHook = default typeof(m.c.config.writelnHook) + diagnostics: seq[string] = @[] + errorPrefix: string + flags: TExprFlags = {} + collectDiagnostics = m.diagnosticsEnabled or + sfExplain in typeClass.sym.flags + + if collectDiagnostics: + oldWriteHook = m.c.config.writelnHook + # XXX: we can't write to m.diagnostics directly, because + # Nim doesn't support capturing var params in closures + diagnostics = @[] + flags = {efExplain} + m.c.config.writelnHook = proc (s: string) = + if errorPrefix.len == 0: errorPrefix = typeClass.sym.name.s & ":" + let msg = s.replace("Error:", errorPrefix) + if oldWriteHook != nil: oldWriteHook msg + diagnostics.add msg + + var checkedBody = c.semTryExpr(c, body.copyTree, flags) + + if collectDiagnostics: + m.c.config.writelnHook = oldWriteHook + for msg in diagnostics: + m.diagnostics.add msg + m.diagnosticsEnabled = true + + if checkedBody == nil: return nil + + # The inferrable type params have been identified during the semTryExpr above. + # We need to put them in the current sigmatch's binding table in order for them + # to be resolvable while matching the rest of the parameters + for p in typeParams: + put(m, p[1], p[0].typ) + + if ff.kind == tyUserTypeClassInst: + result = generateTypeInstance(c, m.bindings, typeClass.sym.info, ff) + else: + result = ff.exactReplica + #copyType(ff, c.idgen, ff.owner) + + result.n = checkedBody + +proc shouldSkipDistinct(m: TCandidate; rules: PNode, callIdent: PIdent): bool = + # XXX This is bad as 'considerQuotedIdent' can produce an error! + if rules.kind == nkWith: + for r in rules: + if considerQuotedIdent(m.c, r) == callIdent: return true + return false + else: + for r in rules: + if considerQuotedIdent(m.c, r) == callIdent: return false + return true + +proc maybeSkipDistinct(m: TCandidate; t: PType, callee: PSym): PType = + if t != nil and t.kind == tyDistinct and t.n != nil and + shouldSkipDistinct(m, t.n, callee.name): + result = t.base else: + result = t + +proc tryResolvingStaticExpr(c: var TCandidate, n: 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)]) + # Here, N-1 will be initially nkStaticExpr that can be evaluated only after + # N is bound to a concrete value during the matching of the first param. + # 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 = + # This is a simple integer arithimetic equation solver, + # capable of deriving the value of a static parameter in + # expressions such as (N + 5) / 2 = rhs + # + # Preconditions: + # + # * The input of this proc must be semantized + # - all templates should be expanded + # - aby constant folding possible should already be performed + # + # * There must be exactly one unresolved static parameter + # + # Result: + # + # The proc will return true if the static types was successfully + # inferred. The result will be bound to the original static type + # in the TCandidate. + # + if lhs.kind in nkCallKinds and lhs[0].kind == nkSym: + case lhs[0].sym.magic + of mAddI, mAddU, mInc, mSucc: + if lhs[1].kind == nkIntLit: + return inferStaticParam(c, lhs[2], rhs - lhs[1].intVal) + elif lhs[2].kind == nkIntLit: + return inferStaticParam(c, lhs[1], rhs - lhs[2].intVal) + + of mDec, mSubI, mSubU, mPred: + if lhs[1].kind == nkIntLit: + return inferStaticParam(c, lhs[2], lhs[1].intVal - rhs) + elif lhs[2].kind == nkIntLit: + return inferStaticParam(c, lhs[1], rhs + lhs[2].intVal) + + of mMulI, mMulU: + if lhs[1].kind == nkIntLit: + if rhs mod lhs[1].intVal == 0: + return inferStaticParam(c, lhs[2], rhs div lhs[1].intVal) + elif lhs[2].kind == nkIntLit: + if rhs mod lhs[2].intVal == 0: + return inferStaticParam(c, lhs[1], rhs div lhs[2].intVal) + + of mDivI, mDivU: + if lhs[1].kind == nkIntLit: + if lhs[1].intVal mod rhs == 0: + return inferStaticParam(c, lhs[2], lhs[1].intVal div rhs) + elif lhs[2].kind == nkIntLit: + return inferStaticParam(c, lhs[1], lhs[2].intVal * rhs) + + of mShlI: + if lhs[2].kind == nkIntLit: + return inferStaticParam(c, lhs[1], rhs shr lhs[2].intVal) + + of mShrI: + 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: + return inferStaticParam(c, lhs[1], rhs) + + else: discard + + 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: + # inside concepts, binding is currently done with + # direct mutation of the involved types: + lhs.typ.n = inferred.n + return true + + return false + +proc failureToInferStaticParam(conf: ConfigRef; n: PNode) = + let staticParam = n.findUnresolvedStatic + let name = if staticParam != nil: staticParam.sym.name.s + else: "unknown" + localError(conf, n.info, "cannot infer the value of the static param '" & name & "'") + +proc inferStaticsInRange(c: var TCandidate, + inferred, concrete: PType): TTypeRelation = + let lowerBound = tryResolvingStaticExpr(c, inferred.n[0], + allowUnresolved = true) + let upperBound = tryResolvingStaticExpr(c, inferred.n[1], + allowUnresolved = true) + template doInferStatic(e: PNode, r: Int128) = + var exp = e + var rhs = r + 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: + return isGeneric + else: + return isNone + doInferStatic(upperBound, lengthOrd(c.c.config, concrete) + lowerBound.intVal - 1) + elif upperBound.kind == nkIntLit: + doInferStatic(lowerBound, getInt(upperBound) + 1 - lengthOrd(c.c.config, concrete)) + +template subtypeCheck() = + 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, tyOwned} and + typeRel(c, lhs, rhs, {trNoCovariance}) == isSubtype + + case f.kind + of tyRef, tyPtr, tyOwned: + return baseTypesCheck(f.base, a.base) + of tyGenericInst: + let body = f.base + return body == a.base and + a.len == 3 and + tfWeakCovariant notin body[0].flags and + baseTypesCheck(f[1], a[1]) + else: + return false + +when false: + proc maxNumericType(prev, candidate: PType): PType = + let c = candidate.skipTypes({tyRange}) + template greater(s) = + if c.kind in s: result = c + case prev.kind + of tyInt: greater({tyInt64}) + of tyInt8: greater({tyInt, tyInt16, tyInt32, tyInt64}) + of tyInt16: greater({tyInt, tyInt32, tyInt64}) + of tyInt32: greater({tyInt64}) + + of tyUInt: greater({tyUInt64}) + of tyUInt8: greater({tyUInt, tyUInt16, tyUInt32, tyUInt64}) + of tyUInt16: greater({tyUInt, tyUInt32, tyUInt64}) + of tyUInt32: greater({tyUInt64}) + + of tyFloat32: greater({tyFloat64, tyFloat128}) + of tyFloat64: greater({tyFloat128}) + else: discard + +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 + # or a subtype relationship. + # + # 2) When used with a concrete type against a type class (such as generic + # signature of a proc), it will check whether the concrete type is a member + # of the designated type class. + # + # 3) When used with two type classes, it will check whether the types + # 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. -proc typeRel(c: var TCandidate, f, a: PType): TTypeRelation = - # is a subtype of f? result = isNone assert(f != nil) - assert(a != nil) + + 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 + + assert(aOrig != nil) + + var + useTypeLoweringRuleInTypeClass = c.c.matchedConcept != nil and + not c.isNoCall and + f.kind != tyTypeDesc and + tfExplicit notin aOrig.flags and + tfConceptMatchedTypeSym notin aOrig.flags + + aOrig = if useTypeLoweringRuleInTypeClass: + aOrig.skipTypes({tyTypeDesc}) + else: + aOrig + + if aOrig.kind == tyInferred: + let prev = aOrig.previouslyInferred + if prev != nil: + return typeRel(c, f, prev, flags) + else: + var candidate = f + + case f.kind + of tyGenericParam: + var prev = idTableGet(c.bindings, f) + if prev != nil: candidate = prev + of tyFromExpr: + let computedType = tryResolvingStaticExpr(c, f.n).typ + case computedType.kind + of tyTypeDesc: + candidate = computedType.base + of tyStatic: + candidate = computedType + else: + # XXX What is this non-sense? Error reporting in signature matching? + discard "localError(f.n.info, errTypeExpected)" + else: + discard + + result = typeRel(c, aOrig.base, candidate, flags) + if result != isNone: + c.inferredTypes.add aOrig + aOrig.add candidate + result = isEqual + return + + template doBind: bool = trDontBind notin flags + + # 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, skipModifier(aOrig), flags) + if a.kind == tyGenericInst and - skipTypes(f, {tyVar}).kind notin { - tyGenericBody, tyGenericInvokation, - tyGenericParam, tyTypeClass}: - return typeRel(c, f, lastSon(a)) - if a.kind == tyVar and f.kind != tyVar: - return typeRel(c, f, a.sons[0]) + skipTypes(f, {tyStatic, tyVar, tyLent, tySink}).kind notin { + tyGenericBody, tyGenericInvocation, + tyGenericInst, tyGenericParam} + tyTypeClasses: + return typeRel(c, f, skipModifier(a), flags) + + if a.isResolvedUserTypeClass: + return typeRel(c, f, a.skipModifier, flags) + + template bindingRet(res) = + if doBind: + let bound = aOrig.skipTypes({tyRange}).skipIntLit(c.c.idgen) + put(c, f, bound) + return res + + template considerPreviousT(body: untyped) = + var prev = idTableGet(c.bindings, f) + if prev == nil: body + else: return typeRel(c, prev, a, flags) + + if c.c.inGenericContext > 0 and not c.isNoCall and + (tfUnresolved in a.flags or a.kind in tyTypeClasses): + # cheap check for unresolved arg, not nested + return isNone + + case a.kind + of tyOr: + # XXX: deal with the current dual meaning of tyGenericParam + c.typedescMatched = true + # seq[int|string] vs seq[number] + # 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.kids: + let x = typeRel(c, f, branch, flags + {trDontBind}) + if x == isNone: return isNone + if x < result: result = x + return result + of tyAnd: + # XXX: deal with the current dual meaning of tyGenericParam + c.typedescMatched = true + # seq[Sortable and Iterable] vs seq[Sortable] + # only one match is enough + for branch in a.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: + # seq[!int] vs seq[!number] + # 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.elementType, f.elementType, flags) + + else: + # negative type classes are essentially infinite, + # so only the `any` type class is their superset + return if f.kind == tyAnything: isGeneric + else: isNone + of tyAnything: + if f.kind == tyAnything: return isGeneric + else: return isNone + of tyUserTypeClass, tyUserTypeClassInst: + if c.c.matchedConcept != nil and c.c.matchedConcept.depth <= 4: + # consider this: 'var g: Node' *within* a concept where 'Node' + # is a concept too (tgraph) + inc c.c.matchedConcept.depth + 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 - of tyEnum: + of tyEnum: if a.kind == f.kind and sameEnumTypes(f, a): result = isEqual elif sameEnumTypes(f, skipTypes(a, {tyRange})): result = isSubtype - of tyBool, tyChar: + of tyBool, tyChar: if a.kind == f.kind: result = isEqual elif skipTypes(a, {tyRange}).kind == f.kind: result = isSubtype of tyRange: if a.kind == f.kind: - result = typeRel(c, base(f), base(a)) + if f.base.kind == tyNone: return isGeneric + 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: + let r = tryResolvingStaticExpr(c, f.n[i], expectedType = expectedType) + if r != nil: + f.n[i] = r result = typeRangeRel(f, a) - elif skipTypes(f, {tyRange}).kind == a.kind: - result = isIntConv - elif isConvertibleToRange(skipTypes(f, {tyRange}), 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) + else: + let f = skipTypes(f, {tyRange}) + if f.kind == a.kind and (f.kind != tyEnum or sameEnumTypes(f, a)): + result = isIntConv + elif isConvertibleToRange(c.c, f, a): + result = isConvertible # a convertible to f + 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: - if a.kind == f.kind: result = typeRel(c, base(f), base(a)) - else: result = typeRel(c, base(f), a) - of tyArray, tyArrayConstr: - # tyArrayConstr cannot happen really, but - # we wanna be safe here - case a.kind - of tyArray, tyArrayConstr: - var fRange = f.sons[0] - if fRange.kind == tyGenericParam: - var prev = PType(idTableGet(c.bindings, fRange)) + 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: + 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.bindings, fRange, a.sons[0]) + if typeRel(c, fRange, aRange) == isNone: + return isNone + put(c, fRange, a.indexType) fRange = a else: fRange = prev - result = typeRel(c, f.sons[1], a.sons[1]) - if result < isGeneric: result = isNone - elif lengthOrd(fRange) != lengthOrd(a): result = isNone - else: nil + let ff = f[1].skipTypes({tyTypeDesc}) + # This typeDesc rule is wrong, see bug #7331 + let aa = a[1] #.skipTypes({tyTypeDesc}) + + if f.indexType.kind != tyGenericParam and aa.kind == tyEmpty: + result = isGeneric + else: + result = typeRel(c, ff, aa, flags) + if result < isGeneric: + if nimEnableCovariance and + trNoCovariance notin flags and + ff.kind == aa.kind and + isCovariantPtr(c, ff, aa): + result = isSubtype + else: + 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 of tyOpenArray, tyVarargs: - case a.Kind - of tyOpenArray, tyVarargs: - result = typeRel(c, base(f), base(a)) - if result < isGeneric: result = isNone - of tyArrayConstr: - if (f.sons[0].kind != tyGenericParam) and (a.sons[1].kind == tyEmpty): - result = isSubtype # [] is allowed here - elif typeRel(c, base(f), a.sons[1]) >= isGeneric: - result = isSubtype - of tyArray: - if (f.sons[0].kind != tyGenericParam) and (a.sons[1].kind == tyEmpty): - result = isSubtype - elif typeRel(c, base(f), a.sons[1]) >= isGeneric: - result = isConvertible - of tySequence: - if (f.sons[0].kind != tyGenericParam) and (a.sons[0].kind == tyEmpty): + # 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.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, flags) + if baseRel >= isGeneric: result = isConvertible - elif typeRel(c, base(f), a.sons[0]) >= isGeneric: + elif nimEnableCovariance and + trNoCovariance notin flags and + ff.kind == aa.kind and + isCovariantPtr(c, ff, aa): result = isConvertible - else: nil - of tySequence: - case a.Kind + + case a.kind + of tyOpenArray, tyVarargs: + result = typeRel(c, base(f), base(a), flags) + if result < isGeneric: result = isNone + of tyArray: + if (f[0].kind != tyGenericParam) and (a.elementType.kind == tyEmpty): + return isSubtype + 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.elementType) + of tyString: + if f.kind == tyOpenArray: + if f[0].kind == tyChar: + result = isConvertible + elif f[0].kind == tyGenericParam and a.len > 0 and + typeRel(c, base(f), base(a), flags) >= isGeneric: + result = isConvertible + else: discard + of tySequence, tyUncheckedArray: + if a.kind == f.kind: + if (f[0].kind != tyGenericParam) and (a.elementType.kind == tyEmpty): result = isSubtype else: - result = typeRel(c, f.sons[0], a.sons[0]) - if result < isGeneric: result = isNone - elif tfNotNil in f.flags and tfNotNil notin a.flags: - result = isNilConversion - of tyNil: result = f.allowsNil - else: nil + let ff = f[0] + let aa = a.elementType + result = typeRel(c, ff, aa, flags) + if result < isGeneric: + if nimEnableCovariance and + trNoCovariance notin flags and + ff.kind == aa.kind and + isCovariantPtr(c, ff, aa): + result = isSubtype + else: + result = isNone + elif a.kind == tyNil: + result = isNone of tyOrdinal: if isOrdinalType(a): - var x = if a.kind == tyOrdinal: a.sons[0] else: a - result = typeRel(c, f.sons[0], x) - if result < isGeneric: result = isNone - of tyForward: InternalError("forward type in typeRel()") + var x = if a.kind == tyOrdinal: a.elementType else: a + if f[0].kind == tyNone: + result = isGeneric + else: + result = typeRel(c, f[0], x, flags) + if result < isGeneric: result = isNone + elif a.kind == tyGenericParam: + result = isGeneric + of tyForward: + #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 = tupleRel(c, f, a) + of tyTuple: + if a.kind == tyTuple: result = recordRel(c, f, a, flags) of tyObject: - if a.kind == tyObject: - if sameObjectTypes(f, a): result = isEqual + let effectiveArgType = if useTypeLoweringRuleInTypeClass: + a else: - var depth = isObjectSubtype(a, f) - if depth > 0: - inc(c.inheritancePenalty, depth) + 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) + elif trIsOutParam notin flags: + c.inheritancePenalty = isObjectSubtype(c, effectiveArgType, f, nil) + if c.inheritancePenalty > 0: result = isSubtype of tyDistinct: - if (a.kind == tyDistinct) and sameDistinctTypes(f, a): result = isEqual - of tySet: - if a.kind == tySet: - if (f.sons[0].kind != tyGenericParam) and (a.sons[0].kind == tyEmpty): + a = a.skipTypes({tyOwned, tyGenericInst, tyRange}) + if a.kind == tyDistinct: + if sameDistinctTypes(f, a): result = isEqual + #elif f.base.kind == tyAnything: result = isGeneric # issue 4435 + elif c.coerceDistincts: result = typeRel(c, f.base, a, flags) + elif c.coerceDistincts: result = typeRel(c, f.base, a, flags) + of tySet: + if a.kind == tySet: + 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! - of tyPtr: - case a.kind - of tyPtr: - result = typeRel(c, base(f), base(a)) - if result <= isConvertible: result = isNone - elif tfNotNil in f.flags and tfNotNil notin a.flags: - result = isNilConversion - of tyNil: result = f.allowsNil - else: nil - of tyRef: - case a.kind - of tyRef: - result = typeRel(c, base(f), base(a)) - if result <= isConvertible: result = isNone + else: + 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-1: + if typeRel(c, f[i], a[i], flags) == isNone: return isNone + result = typeRel(c, f.elementType, a.elementType, flags + {trNoCovariance}) + subtypeCheck() + if result <= isIntConv: result = isNone elif tfNotNil in f.flags and tfNotNil notin a.flags: result = isNilConversion - of tyNil: result = f.allowsNil - else: nil + 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: @@ -546,22 +1602,25 @@ proc typeRel(c: var TCandidate, f, a: PType): TTypeRelation = result = isEqual of tyNil: result = f.allowsNil of tyProc: - if a.callConv != ccClosure: result = isConvertible - of tyPtr, tyCString: result = isConvertible - else: nil - of tyString: - case a.kind - of tyString: - if tfNotNil in f.flags and tfNotNil notin a.flags: - result = isNilConversion + if isDefined(c.c.config, "nimPreviewProcConversion"): + result = isNone else: - result = isEqual - of tyNil: result = f.allowsNil - else: nil - of tyCString: + 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 + else: discard + of tyString: + case a.kind + of tyString: result = isEqual + of tyNil: result = isNone + else: discard + of tyCstring: # conversion from string to cstring is automatic: - case a.Kind - of tyCString: + case a.kind + of tyCstring: if tfNotNil in f.flags and tfNotNil notin a.flags: result = isNilConversion else: @@ -569,452 +1628,1369 @@ proc typeRel(c: var TCandidate, f, a: PType): TTypeRelation = of tyNil: result = f.allowsNil of tyString: result = isConvertible of tyPtr: - if a.sons[0].kind == tyChar: result = isConvertible - of tyArray: - if (firstOrd(a.sons[0]) == 0) and - (skipTypes(a.sons[0], {tyRange}).kind in {tyInt..tyInt64}) and - (a.sons[1].kind == tyChar): - result = isConvertible - else: nil - of tyEmpty: - if a.kind == tyEmpty: result = isEqual - of tyGenericInst: - result = typeRel(c, lastSon(f), a) - of tyGenericBody: - let ff = lastSon(f) - if ff != nil: result = typeRel(c, ff, a) - of tyGenericInvokation: + 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, 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 = idTableGet(c.bindings, f) + let origF = f + var f = if prev == nil: f else: prev + + let deptha = a.genericAliasDepth() + let depthf = f.genericAliasDepth() + let skipBoth = deptha == depthf and (a.len > 0 and f.len > 0 and a.base != f.base) + + let roota = if skipBoth or deptha > depthf: a.skipGenericAlias else: a + let rootf = if skipBoth or depthf > deptha: f.skipGenericAlias else: f + + if a.kind == tyGenericInst: + if roota.base == rootf.base: + let nextFlags = flags + {trNoCovariance} + var hasCovariance = false + # 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[i-1].flags + hasCovariance = + if tfCovariant in paramFlags: + if tfWeakCovariant in paramFlags: + isCovariantPtr(c, ff, aa) + else: + ff.kind notin {tyRef, tyPtr} and res == isSubtype + else: + tfContravariant in paramFlags and + typeRel(c, aa, ff, flags) == isSubtype + if hasCovariance: + continue + + return isNone + if prev == nil: put(c, f, a) + else: + let fKind = rootf.last.kind + if fKind in {tyAnd, tyOr}: + result = typeRel(c, last(f), a, flags) + if result != isNone: put(c, f, a) + return + + var aAsObject = roota.last + + if fKind in {tyRef, tyPtr}: + if aAsObject.kind == tyObject: + # bug #7600, tyObject cannot be passed + # as argument to tyRef/tyPtr + return isNone + elif aAsObject.kind == fKind: + aAsObject = aAsObject.base + + if aAsObject.kind == tyObject and trIsOutParam notin flags: + let baseType = aAsObject.base + if baseType != nil: + inc c.inheritancePenalty, 1 + int(c.inheritancePenalty < 0) + let ret = typeRel(c, f, baseType, flags) + return if ret in {isEqual,isGeneric}: isSubtype else: ret + + result = isNone + else: + assert last(origF) != nil + result = typeRel(c, last(origF), a, flags) + if result != isNone and a.kind != tyNil: + put(c, f, a) + of tyGenericBody: + considerPreviousT: + if a == f or a.kind == tyGenericInst and a.skipGenericAlias[0] == f: + bindingRet isGeneric + let ff = last(f) + if ff != nil: + result = typeRel(c, ff, a, flags) + of tyGenericInvocation: var x = a.skipGenericAlias - if x.kind == tyGenericInvokation or f.sons[0].kind != tyGenericBody: - #InternalError("typeRel: tyGenericInvokation -> tyGenericInvokation") - # simply no match for now: - nil - elif x.kind == tyGenericInst and - (f.sons[0] == x.sons[0]) and - (sonsLen(x) - 1 == sonsLen(f)): - for i in countup(1, sonsLen(f) - 1): - if x.sons[i].kind == tyGenericParam: - InternalError("wrong instantiated type!") - elif typeRel(c, f.sons[i], x.sons[i]) <= isSubtype: return + 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 and not preventHack: + let inst = prepareMetatypeForSigmatch(c.c, c.bindings, c.call.info, f) + return typeRel(c, inst, a, flags) + + if x.kind == tyGenericInvocation: + if f[0] == x[0]: + for i in 1..<f.len: + # Handle when checking against a generic that isn't fully instantiated + if i >= x.len: return + let tr = typeRel(c, f[i], x[i], flags) + if tr <= isSubtype: return + result = isGeneric + 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[i], x[i], flags) <= isSubtype: + # Workaround for regression #4589 + 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: - result = typeRel(c, f.sons[0], x) + let genericBody = f[0] + var askip = skippedNone + var fskip = skippedNone + let aobj = x.skipToObject(askip) + 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: + # + # proc internalFind[T,D](n: PNode[T,D], key: T): ref TItem[T,D] + # proc internalPut[T,D](ANode: ref TNode[T,D], Akey: T, Avalue: D, + # Oldvalue: var D): ref TNode[T,D] + # var root = internalPut[int, int](nil, 312, 312, oldvalue) + # var it1 = internalFind(root, 312) # cannot instantiate: 'D' + # # we steal the generic parameters from the tyGenericBody: - for i in countup(1, sonsLen(f) - 1): - var x = PType(idTableGet(c.bindings, f.sons[0].sons[i - 1])) - if x == nil or x.kind in {tyGenericInvokation, tyGenericParam}: - InternalError("wrong instantiated type!") - put(c.bindings, f.sons[i], x) - of tyGenericParam, tyTypeClass: - var x = PType(idTableGet(c.bindings, f)) + for i in 1..<f.len: + let x = idTableGet(c.bindings, genericBody[i-1]) + if x == nil: + discard "maybe fine (for e.g. a==tyNil)" + elif x.kind in {tyGenericInvocation, tyGenericParam}: + internalError(c.c.graph.config, "wrong instantiated type!") + else: + let key = f[i] + let old = 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) + if not (genericSubtype and aobj.sym.id != fobj.sym.id) and aOrig.kind != tyGenericBody: + depth = -1 + + if depth >= 0: + 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.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 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 + of tyNot: + considerPreviousT: + 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 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.last, a, flags) + else: + considerPreviousT: + if aOrig == f: return isEqual + var matched = matchUserTypeClass(c, f, aOrig) + if matched != nil: + 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.last.skipGenericAlias + if a.kind == tyGenericInst and roota.base == rootf.base: + 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.last, a, flags) + if result != isNone: + put(c, f, a) + result = isGeneric + of tyGenericParam: + let doBindGP = doBind or trBindGenericParam in flags + var x = idTableGet(c.bindings, f) if x == nil: - result = matchTypeClass(c, f, a) - if result == isGeneric: - var concrete = concreteType(c, a) - if concrete == nil: + 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 + # by a tyTypeDesc params. Unfortunately, this requires more substantial + # changes in semtypinst and elsewhere. + if tfWildcard in a.flags: + result = isGeneric + elif a.kind == tyTypeDesc: + if f.len == 0: + result = isGeneric + else: + 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 = last(aa) + if aa.kind in {tyGenericParam} + tyTypeClasses: + # If the constraint is a genericParam or typeClass this isGeneric + return isGeneric + result = typeRel(c, f.base, aa, flags) + if result > isGeneric: result = isGeneric + 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: + # 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) + if result in {isEqual, isSubtype}: + result = isGeneric + elif a.kind == tyTypeDesc: + # somewhat special typing rule, the following is illegal: + # proc p[T](x: T) + # p(int) result = isNone else: - put(c.bindings, f, concrete) + result = isGeneric + + if result == isGeneric: + var concrete = a + if tfWildcard in a.flags: + a.sym.transitionGenericParamToType() + a.flags.excl tfWildcard + elif doBind: + # careful: `trDontDont` (set by `checkGeneric`) is not always respected in this call graph. + # typRel having two different modes (binding and non-binding) can make things harder to + # 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 doBindGP: + put(c, f, concrete) + elif result > isGeneric: + result = isGeneric elif a.kind == tyEmpty: result = isGeneric elif x.kind == tyGenericParam: result = isGeneric else: - 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 = idTableGet(c.bindings, f) + if prev == nil: + if aOrig.kind == tyStatic: + 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 = if f.base.kind != tyNone: + typeRel(c, f.last, aOrig.n.typ, flags) + else: isGeneric + if result != isNone: + 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.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, flags) + result = isNone + of tyInferred: + let prev = f.previouslyInferred + if prev != nil: + result = typeRel(c, prev, a, flags) + else: + result = typeRel(c, f.base, a, flags) + if result != isNone: + c.inferredTypes.add f + f.add a of tyTypeDesc: - var prev = PType(idTableGet(c.bindings, f)) + var prev = idTableGet(c.bindings, f) if prev == nil: - if a.kind == tyTypeDesc: - if f.sonsLen == 0: + # 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 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 = matchTypeClass(c, f, a.sons[0]) - if result == isGeneric: - put(c.bindings, f, a) + result = isNone + elif f.base.kind == tyNone: + result = isGeneric else: - result = isNone + result = typeRel(c, f.base, a.base, flags) + + if result != isNone: + put(c, f, a) else: - InternalAssert prev.sonsLen == 1 - result = typeRel(c, prev.sons[0], a) - of tyExpr, tyStmt: + if tfUnresolved in f.flags: + result = typeRel(c, prev.base, a, flags) + elif a.kind == tyTypeDesc: + result = typeRel(c, prev.base, a.base, flags) + else: + result = isNone + of tyTyped: + if aOrig != nil: + put(c, f, aOrig) result = isGeneric - of tyProxy: + of tyError: result = isEqual - else: internalError("typeRel: " & $f.kind) - -proc cmpTypes*(f, a: PType): TTypeRelation = - var c: TCandidate - InitCandidate(c, f) - result = typeRel(c, f, a) - -proc getInstantiatedType(c: PContext, arg: PNode, m: TCandidate, - f: PType): PType = - result = PType(idTableGet(m.bindings, f)) - if result == nil: + of tyFromExpr: + # fix the expression, so it contains the already instantiated types + if f.n == nil or f.n.kind == nkEmpty: return isGeneric + 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, reevaluated.base, a, flags) + of tyStatic: + result = typeRel(c, reevaluated.base, a, flags) + if result != isNone and reevaluated.n != nil: + if not exprStructuralEquivalent(aOrig.n, reevaluated.n): + result = isNone + else: + # bug #14136: other types are just like 'tyStatic' here: + result = typeRel(c, 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 = newCandidate(c, f) + result = typeRel(m, f, a) + +proc getInstantiatedType(c: PContext, arg: PNode, m: TCandidate, + f: PType): PType = + result = idTableGet(m.bindings, f) + if result == nil: result = generateTypeInstance(c, m.bindings, arg, f) if result == nil: - InternalError(arg.info, "getInstantiatedType") + internalError(c.graph.config, arg.info, "getInstantiatedType") result = errorType(c) - -proc implicitConv(kind: TNodeKind, f: PType, arg: PNode, m: TCandidate, - c: PContext): PNode = + +proc implicitConv(kind: TNodeKind, f: PType, arg: PNode, m: TCandidate, + c: PContext): PNode = result = newNodeI(kind, arg.info) if containsGenericType(f): - if not m.proxyMatch: - 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 - if result.typ == nil: InternalError(arg.info, "implicitConv") - addSon(result, ast.emptyNode) - addSon(result, arg) + result.typ = f.skipTypes({tySink}) + # keep varness + if arg.typ != nil and arg.typ.kind == tyVar: + result.typ = toVar(result.typ, tyVar, c.idgen) + else: + result.typ = result.typ.skipTypes({tyVar}) + + if result.typ == nil: internalError(c.graph.config, arg.info, "implicitConv") + result.add c.graph.emptyNode + 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 userConvMatch(c: PContext, m: var TCandidate, f, a: PType, - arg: PNode): PNode = +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(arg, c.converters[i]) + 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, - arg: PNode): PNode = +proc localConvMatch(c: PContext, m: var TCandidate, f, a: PType, + arg: PNode): PNode = # arg.typ can be nil in 'suggest': if isNil(arg.typ): return nil + + # sem'checking for 'echo' needs to be re-entrant: + # XXX we will revisit this issue after 0.10.2 is released + if f == arg.typ and arg.kind == nkHiddenStdConv: return arg + var call = newNodeI(nkCall, arg.info) call.add(f.n.copyTree) call.add(arg.copyTree) - result = c.semOverloadedCall(c, call, call, RoutineKinds) + # 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)) m.baseTypeMatch = true -proc ParamTypesMatchAux(c: PContext, m: var TCandidate, f, a: PType, - arg, argOrig: PNode): PNode = - var r: TTypeRelation - let fMaybeExpr = f.skipTypes({tyDistinct}) - if fMaybeExpr.kind == tyExpr: - if fMaybeExpr.sonsLen == 0: - r = isGeneric +proc incMatches(m: var TCandidate; r: TTypeRelation; convMatch = 1) = + case r + of isConvertible, isIntConv: inc(m.convMatches, convMatch) + of isSubtype, isSubrange: inc(m.subtypeMatches) + of isGeneric, isInferred, isBothMetaConvertible: inc(m.genericMatches) + of isFromIntLit: inc(m.intConvMatches, 256) + of isInferredConvertible: + inc(m.convMatches) + of isEqual: inc(m.exactMatches) + of isNone: discard + +template matchesVoidProc(t: PType): bool = + (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 + + # 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) + return argSemantized + + if a.kind == tyStatic: + if m.callee.kind == tyGenericBody and + a.n == nil and + tfGenericTypeParam notin a.flags: + return newNodeIT(nkType, argOrig.info, makeTypeFromExpr(c, arg)) + elif a.kind == tyFromExpr and c.inGenericContext > 0: + # don't try to evaluate + discard + elif arg.kind != nkEmpty: + var evaluated = c.semTryConstExpr(c, arg) + if evaluated != nil: + # Don't build the type in-place because `evaluated` and `arg` may point + # to the same object and we'd end up creating recursive types (#9255) + let typ = newTypeS(tyStatic, c, 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: + result = makeStaticExpr(m.c, arg) + result.typ.flags.incl tfUnresolved + 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 + # anywhere and breaks symmetry. It's hard to get rid of though, my + # custom seqs example fails to compile without this: + if r != isNone and m.calleeSym != nil and + m.calleeSym.kind in {skMacro, skTemplate}: + # XXX: duplicating this is ugly, but we cannot (!) move this + # directly into typeRel using return-like templates + incMatches(m, r) + if f.kind == tyTyped: + return arg + elif f.kind == tyTypeDesc: + return arg + elif f.kind == tyStatic and arg.typ.n != nil: + return arg.typ.n else: - let match = matchTypeClass(m, fMaybeExpr, a) - if match != isGeneric: r = isNone + return argSemantized # argOrig + + 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: - # XXX: Ideally, this should happen much earlier somewhere near - # semOpAux, but to do that, we need to be able to query the - # overload set to determine whether compile-time value is expected - # for the param before entering the full-blown sigmatch algorithm. - # This is related to the immediate pragma since querying the - # overload set could help there too. - var evaluated = c.semConstExpr(c, arg) - if evaluated != nil: - r = isGeneric - arg.typ = newTypeS(tyExpr, c) - arg.typ.n = evaluated - - if r == isGeneric: - put(m.bindings, f, arg.typ) - else: - r = typeRel(m, f, a) - + 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: + of isConvertible: + if f.skipTypes({tyRange}).kind in {tyInt, tyUInt}: + inc(m.convMatches) inc(m.convMatches) - result = implicitConv(nkHiddenStdConv, f, copyTree(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, copyTree(arg), m, c) - of isSubtype: + result = implicitConv(nkHiddenStdConv, f, arg, m, c) + of isSubtype: inc(m.subtypeMatches) - result = implicitConv(nkHiddenSubConv, f, copyTree(arg), m, c) + if f.kind == tyTypeDesc: + result = arg + else: + result = implicitConv(nkHiddenSubConv, f, arg, m, c) of isSubrange: inc(m.subtypeMatches) - #result = copyTree(arg) - result = implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c) + if f.kind in {tyVar}: + result = arg + else: + result = implicitConv(nkHiddenStdConv, f, arg, m, c) + 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 m.calleeSym != nil and m.calleeSym.kind in {skMacro, skTemplate}: - if f.kind == tyStmt and argOrig.kind == nkDo: - result = argOrig[bodyPos] - elif f.kind == tyTypeDesc: - result = arg - else: - result = argOrig + if arg.typ == nil: + result = arg + 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 + result.typ = getInstantiatedType(c, arg, m, f) else: - result = copyTree(arg) - result.typ = getInstantiatedType(c, arg, m, f) - # BUG: f may not be the right key! - if skipTypes(result.typ, abstractVar-{tyTypeDesc}).kind in {tyTuple}: - result = implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c) - # BUGFIX: use ``result.typ`` and not `f` here + result = arg + of isBothMetaConvertible: + # 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: inc(m.intConvMatches, 256) - result = implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c) - of isEqual: + result = implicitConv(nkHiddenStdConv, f, arg, m, c) + of isEqual: inc(m.exactMatches) - result = copyTree(arg) - if skipTypes(f, abstractVar-{tyTypeDesc}).kind in {tyTuple}: - result = implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c) + result = arg + 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 infere T in ``ref T``: - if a.kind == tyProxy: + # do not do this in ``typeRel`` as it then can't infer T in ``ref T``: + if a.kind == tyFromExpr: return nil + elif a.kind == tyError: inc(m.genericMatches) - m.proxyMatch = true - return copyTree(arg) - result = userConvMatch(c, m, f, a, arg) + m.matchedErrorType = true + return arg + elif a.kind == tyVoid and f.matchesVoidProc and argOrig.kind == nkStmtList: + # lift do blocks without params to lambdas + # now deprecated + message(c.config, argOrig.info, warnStmtListLambda) + let p = c.graph + let lifted = c.semExpr(c, newProcNode(nkDo, argOrig.info, body = argOrig, + params = nkFormalParams.newTree(p.emptyNode), name = p.emptyNode, pattern = p.emptyNode, + genericParams = p.emptyNode, pragmas = p.emptyNode, exceptions = p.emptyNode), {}) + if f.kind == tyBuiltInTypeClass: + inc m.genericMatches + put(m, f, lifted.typ) + inc m.convMatches + return implicitConv(nkHiddenStdConv, f, lifted, m, c) + result = userConvMatch(c, m, f, a, arg) # check for a base type match, which supports varargs[T] without [] # 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 + of isSubtype: # bug #4799, varargs accepting subtype relation object + inc(m.subtypeMatches) + if base(f).kind == tyTypeDesc: + result = arg + else: + 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*(c: PContext, m: var TCandidate, f, a: PType, + +proc paramTypesMatch*(m: var TCandidate, f, a: PType, arg, argOrig: PNode): PNode = if arg == nil or arg.kind notin nkSymChoices: - result = ParamTypesMatchAux(c, 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. - var x, y, z: TCandidate - initCandidate(x, m.callee) - initCandidate(y, m.callee) - initCandidate(z, m.callee) - x.calleeSym = m.calleeSym - y.calleeSym = m.calleeSym - z.calleeSym = m.calleeSym + result = paramTypesMatchAux(m, f, a, arg, argOrig) + else: + # symbol kinds that don't participate in symchoice type disambiguation: + let matchSet = {low(TSymKind)..high(TSymKind)} - {skModule, skPackage} + var best = -1 - for i in countup(0, sonsLen(arg) - 1): - if arg.sons[i].sym.kind in {skProc, skIterator, skMethod, skConverter}: - copyCandidate(z, m) - var r = typeRel(z, f, arg.sons[i].typ) - if r != isNone: - 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 - x.state = csMatch - of csMatch: - var cmp = cmpCandidates(x, z) - if cmp < 0: - best = i + 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 - 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(arg.info, "x.state is not csMatch") - # ambiguous: more than one symbol fits - result = nil - else: + 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(arg, arg.sons[best].sym) - result = ParamTypesMatchAux(c, 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) = - if sonsLen(father) <= at: setlen(father.sons, at + 1) - father.sons[at] = son +proc setSon(father: PNode, at: int, son: PNode) = + let oldLen = father.len + if oldLen <= at: + setLen(father.sons, at + 1) + father[at] = son + # insert potential 'void' parameters: + #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: - result = c.semOperand(c, a, {efDetermineType}) + 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: result = c.semOperand(c, a, {efDetermineType}) else: result = a + considerGenSyms(c, result) -proc prepareNamedParam(a: PNode) = - if a.sons[0].kind != nkIdent: - var info = a.sons[0].info - a.sons[0] = newIdentNode(considerAcc(a.sons[0]), info) +proc prepareNamedParam(a: PNode; c: PContext) = + 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(tyArrayConstr, c) + result = newTypeS(tyArray, c) rawAddSon(result, makeRangeType(c, 0, 0, n.info)) - addSonSkipIntLit(result, skipTypes(n.typ, {tyGenericInst, tyVar, tyOrdinal})) + addSonSkipIntLit(result, skipTypes(n.typ, + {tyVar, tyLent, tyOrdinal}), c.idgen) proc arrayConstr(c: PContext, info: TLineInfo): PType = - result = newTypeS(tyArrayConstr, c) + result = newTypeS(tyArray, c) rawAddSon(result, makeRangeType(c, 0, -1, info)) rawAddSon(result, newTypeS(tyEmpty, c)) # needs an empty basetype! proc incrIndexType(t: PType) = - assert t.kind == tyArrayConstr - inc t.sons[0].n.sons[1].intVal + assert t.kind == tyArray + inc t.indexType.n[1].intVal + +template isVarargsUntyped(x): untyped = + x.kind == tyVarargs and x[0].kind == tyUntyped + +template isVarargsTyped(x): untyped = + x.kind == tyVarargs and x[0].kind == tyTyped + +proc findFirstArgBlock(m: var TCandidate, n: PNode): int = + # see https://github.com/nim-lang/RFCs/issues/405 + result = int.high + for a2 in countdown(n.len-1, 0): + # checking `nfBlockArg in n[a2].flags` wouldn't work inside templates + if n[a2].kind != nkStmtList: break + let formalLast = m.callee.n[m.callee.n.len - (n.len - a2)] + # parameter has to occupy space (no default value, not void or varargs) + if formalLast.kind == nkSym and formalLast.sym.ast == nil and + formalLast.sym.typ.kind notin {tyVoid, tyVarargs}: + result = a2 + else: break -proc matchesAux(c: PContext, n, nOrig: PNode, - m: var TCandidate, marker: var TIntSet) = - template checkConstraint(n: expr) {.immediate, dirty.} = - if not formal.constraint.isNil: +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 + + template checkConstraint(n: untyped) {.dirty.} = + 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 - - var f = 1 # iterates over formal parameters - var a = 1 # iterates over the actual given arguments - m.state = csMatch # until proven otherwise - m.call = newNodeI(n.kind, n.info) - m.call.typ = base(m.callee) # may be nil - var formalLen = sonsLen(m.callee.n) - addSon(m.call, copyTree(n.sons[0])) - var container: PNode = nil # constructed container - var formal: PSym = nil + 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.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: - if n.sons[a].kind == nkExprEqExpr: + c.openShadowScope + + if a >= formalLen-1 and f < formalLen and m.callee.n[f].typ.isVarargsUntyped: + formal = m.callee.n[f].sym + incl(marker, formal.position) + + 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: + 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]) - if n.sons[a].sons[0].kind != nkIdent: - LocalError(n.sons[a].info, errNamedParamHasToBeIdent) - m.state = csNoMatch - return - formal = getSymFromList(m.callee.n, n.sons[a].sons[0].ident, 1) - if formal == nil: + 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 - if ContainsOrIncl(marker, formal.position): - # already in namedParams: - LocalError(n.sons[a].info, errCannotBindXTwice, formal.name.s) - 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[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(c, m, formal.typ, n.sons[a].typ, - n.sons[a].sons[1], nOrig.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]) - if m.baseTypeMatch: - assert(container == nil) - container = newNodeIT(nkBracket, n.sons[a].info, arrayConstr(c, arg)) - addSon(container, arg) + noMatch() + checkConstraint(n[a][1]) + if m.baseTypeMatch: + #assert(container == nil) + 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: + else: setSon(m.call, formal.position + 1, arg) + inc f else: # unnamed param if f >= formalLen: # too many arguments? - if tfVarArgs in m.callee.flags: + 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(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])) - elif formal != nil: + 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 - n.sons[a] = prepareOperand(c, formal.typ, n.sons[a]) - var arg = ParamTypesMatch(c, m, formal.typ, n.sons[a].typ, - n.sons[a], nOrig.sons[a]) - if (arg != nil) and m.baseTypeMatch and (container != nil): - addSon(container, arg) + m.typedescMatched = false + incl(marker, formal.position) + 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: + container.add arg incrIndexType(container.typ) + 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(n.sons[a].info, "matches") - return - formal = m.callee.n.sons[f].sym - if ContainsOrIncl(marker, formal.position): - # already in namedParams: - LocalError(n.sons[a].info, errCannotBindXTwice, formal.name.s) - m.state = csNoMatch - return - m.baseTypeMatch = false - n.sons[a] = prepareOperand(c, formal.typ, n.sons[a]) - var arg = ParamTypesMatch(c, m, formal.typ, n.sons[a].typ, - n.sons[a], nOrig.sons[a]) - if arg == nil: - m.state = csNoMatch - return - if m.baseTypeMatch: - assert(container == nil) - container = newNodeIT(nkBracket, n.sons[a].info, arrayConstr(c, arg)) - addSon(container, arg) - setSon(m.call, formal.position + 1, - implicitConv(nkHiddenStdConv, formal.typ, container, m, c)) - if f != formalLen - 1: container = nil + 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: + 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[a].info, arrayConstr(c, n.info)) + setSon(m.call, formal.position + 1, container) + else: + incrIndexType(container.typ) + container.add n[a] else: - setSon(m.call, formal.position + 1, arg) - checkConstraint(n.sons[a]) - inc(a) - inc(f) + m.baseTypeMatch = false + 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: + 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[a].info, arrayConstr(c, arg)) + container.typ.flags.incl tfVarargs + else: + incrIndexType(container.typ) + 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) + elif formal.typ.kind != tyVarargs or container == nil: + setSon(m.call, formal.position + 1, arg) + inc f + container = nil + 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]) -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]) + if m.state == csMatch and not (m.calleeSym != nil and m.calleeSym.kind in {skTemplate, skMacro}): + c.mergeShadowScope + else: + c.closeShadowScope + + 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: @@ -1022,35 +2998,218 @@ proc partialMatch*(c: PContext, n, nOrig: PNode, m: var TCandidate) = matchesAux(c, n, nOrig, m, marker) proc matches*(c: PContext, n, nOrig: PNode, m: var TCandidate) = + 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 - if not ContainsOrIncl(marker, formal.position): + 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)) - addSon(m.call, implicitConv(nkHiddenStdConv, formal.typ, - container, m, c)) + # 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.kind = kMissingParam + m.firstMismatch.formal = formal break else: - # use default value: - setSon(m.call, formal.position + 1, copyTree(formal.ast)) - inc(f) - -proc argtypeMatches*(c: PContext, f, a: PType): bool = - var m: TCandidate - initCandidate(m, f) - let res = paramTypesMatch(c, m, f, a, ast.emptyNode, nil) + # 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 != {}: + 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.len > 1: t.newSons 1 + +proc argtypeMatches*(c: PContext, f, a: PType, fromHlo = false): bool = + 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 # instantiate generic converters for that - result = res != nil + if not fromHlo: + res != nil + else: + # 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 = + 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[col] + + if op == attachedDeepCopy: + if f.kind in {tyRef, tyPtr}: f = f.elementType + else: + 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) + if op == attachedDeepCopy: + assert sfFromGeneric in result.flags include suggest + +when not declared(tests): + template tests(s: untyped) = discard + +tests: + var dummyOwner = newSym(skModule, getIdent("test_module"), nil, unknownLineInfo) + + proc `|` (t1, t2: PType): PType = + result = newType(tyOr, dummyOwner) + result.rawAddSon(t1) + result.rawAddSon(t2) + + proc `&` (t1, t2: PType): PType = + result = newType(tyAnd, dummyOwner) + result.rawAddSon(t1) + result.rawAddSon(t2) + + proc `!` (t: PType): PType = + result = newType(tyNot, dummyOwner) + result.rawAddSon(t) + + proc seq(t: PType): PType = + result = newType(tySequence, dummyOwner) + result.rawAddSon(t) + + proc array(x: int, t: PType): PType = + result = newType(tyArray, dummyOwner) + + var n = newNodeI(nkRange, unknownLineInfo) + n.add newIntNode(nkIntLit, 0) + n.add newIntNode(nkIntLit, x) + let range = newType(tyRange, dummyOwner) + + result.rawAddSon(range) + result.rawAddSon(t) + + suite "type classes": + let + int = newType(tyInt, dummyOwner) + float = newType(tyFloat, dummyOwner) + string = newType(tyString, dummyOwner) + ordinal = newType(tyOrdinal, dummyOwner) + any = newType(tyAnything, dummyOwner) + number = int | float + + var TFoo = newType(tyObject, dummyOwner) + TFoo.sym = newSym(skType, getIdent"TFoo", dummyOwner, unknownLineInfo) + + var T1 = newType(tyGenericParam, dummyOwner) + 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.position = 1 + + setup: + var c = newCandidate(nil, nil) + + template yes(x, y) = + test astToStr(x) & " is " & astToStr(y): + check typeRel(c, y, x) == isGeneric + + template no(x, y) = + test astToStr(x) & " is not " & astToStr(y): + check typeRel(c, y, x) == isNone + + yes seq(any), array(10, int) | seq(any) + # Sure, seq[any] is directly included + + yes seq(int), seq(any) + yes seq(int), seq(number) + # Sure, the int sequence is certainly + # part of the number sequences (and all sequences) + + no seq(any), seq(float) + # Nope, seq[any] includes types that are not seq[float] (e.g. seq[int]) + + yes seq(int|string), seq(any) + # Sure + + yes seq(int&string), seq(any) + # Again + + yes seq(int&string), seq(int) + # A bit more complicated + # seq[int&string] is not a real type, but it's analogous to + # seq[Sortable and Iterable], which is certainly a subset of seq[Sortable] + + no seq(int|string), seq(int|float) + # Nope, seq[string] is not included in not included in + # the seq[int|float] set + + no seq(!(int|string)), seq(string) + # A sequence that is neither seq[int] or seq[string] + # is obviously not seq[string] + + no seq(!int), seq(number) + # Now your head should start to hurt a bit + # A sequence that is not seq[int] is not necessarily a number sequence + # it could well be seq[string] for example + + yes seq(!(int|string)), seq(!string) + # all sequnece types besides seq[int] and seq[string] + # are subset of all sequence types that are not seq[string] + + no seq(!(int|string)), seq(!(string|TFoo)) + # Nope, seq[TFoo] is included in the first set, but not in the second + + no seq(!string), seq(!number) + # Nope, seq[int] in included in the first set, but not in the second + + yes seq(!number), seq(any) + yes seq(!int), seq(any) + no seq(any), seq(!any) + no seq(!int), seq(!any) + + 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 b86a2c365..a5213086b 100644 --- a/compiler/suggest.nim +++ b/compiler/suggest.nim @@ -1,103 +1,414 @@ # # -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. # ## This file implements features required for IDE support. +## +## Due to Nim's nature and the fact that ``system.nim`` is always imported, +## there are lots of potential symbols. Furthermore thanks to templates and +## macros even context based analysis does not help much: In a context like +## ``let x: |`` where a type has to follow, that type might be constructed from +## a template like ``extractField(MyObject, fieldName)``. We deal with this +## problem by smart sorting so that the likely symbols come first. This sorting +## is done this way: +## +## - If there is a prefix (foo|), symbols starting with this prefix come first. +## - If the prefix is part of the name (but the name doesn't start with it), +## these symbols come second. +## - If we have a prefix, only symbols matching this prefix are returned and +## nothing else. +## - If we have no prefix, consider the context. We currently distinguish +## between type and non-type contexts. +## - Finally, sort matches by relevance. The relevance is determined by the +## number of usages, so ``strutils.replace`` comes before +## ``strutils.wordWrap``. +## - In any case, sorting also considers scoping information. Local variables +## get high priority. # included from sigmatch.nim -import algorithm +import prefixmatches, suggestsymdb +from wordrecg import wDeprecated, wError, wAddr, wYield + +import std/[algorithm, sets, parseutils, tables] + +when defined(nimsuggest): + import pathutils # importer const sep = '\t' - sectionSuggest = "sug" - sectionDef = "def" - sectionContext = "con" - sectionUsage = "use" #template sectionSuggest(): expr = "##begin\n" & getStackTrace() & "##end\n" -proc SymToStr(s: PSym, isLocal: bool, section: string, li: TLineInfo): string = - result = section +template origModuleName(m: PSym): string = m.name.s + +proc findDocComment(n: PNode): PNode = + if n == nil: return nil + if n.comment.len > 0: return n + if n.kind in {nkStmtList, nkStmtListExpr, nkObjectTy, nkRecList} and n.len > 0: + result = findDocComment(n[0]) + if result != nil: return + if n.len > 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(g: ModuleGraph; s: PSym): string = + var n = findDocComment(s.ast) + if n.isNil and s.kind in routineKinds and s.ast != nil: + n = findDocComment(getBody(g, s)) + if not n.isNil: + result = n.comment.replace("\n##", "\n").strip + else: + result = "" + +proc cmpSuggestions(a, b: Suggest): int = + template cf(field) {.dirty.} = + result = b.field.int - a.field.int + if result != 0: return result + + cf prefix + cf contextFits + cf scope + # when the first type matches, it's better when it's a generic match: + cf quality + cf localUsages + cf globalUsages + # if all is equal, sort alphabetically for deterministic output, + # independent of hashing order: + result = cmp(a.name[], b.name[]) + +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; + 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.prefix = prefix + result.contextFits = inTypeContext == (s.kind in {skType, skGenericParam}) + result.scope = scope + result.name = addr s.name.s + when defined(nimsuggest): + result.globalUsages = s.allUsages.len + var c = 0 + for u in s.allUsages: + if u.fileIndex == info.fileIndex: inc c + result.localUsages = c + result.symkind = byte s.kind + if optIdeTerse notin g.config.globalOptions: + result.qualifiedPath = @[] + if not isLocal and s.kind != skModule: + let ow = s.owner + if ow != nil and ow.kind != skModule and ow.owner != nil: + let ow2 = ow.owner + result.qualifiedPath.add(ow2.origModuleName) + if ow != nil: + result.qualifiedPath.add(ow.origModuleName) + 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: + if section == ideInlayHints: + result.forth = typeToString(s.typ, preferInlayHint) + else: + result.forth = typeToString(s.typ, preferInferredEffects) + else: + result.forth = "" + when defined(nimsuggest) and not defined(noDocgen) and not defined(leanCompiler): + 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($s.kind) + result.add($suggest.line) result.add(sep) - if not isLocal and s.kind != skModule: - let ow = s.owner - if ow.kind != skModule and ow.owner != nil: - let ow2 = ow.owner - result.add(ow2.name.s) - result.add('.') - result.add(ow.name.s) - result.add('.') - result.add(s.name.s) + result.add($suggest.column) result.add(sep) - if s.typ != nil: - result.add(typeToString(s.typ)) + result.add(suggest.label) result.add(sep) - result.add(toFullPath(li)) + result.add($suggest.paddingLeft) result.add(sep) - result.add($ToLinenumber(li)) + result.add($suggest.paddingRight) result.add(sep) - result.add($ToColumn(li)) + result.add($suggest.allowInsert) result.add(sep) - result.add(s.extractDocComment.escape) + result.add(suggest.tooltip) -proc SymToStr(s: PSym, isLocal: bool, section: string): string = - result = SymToStr(s, isLocal, section, s.info) +proc `$`*(suggest: Suggest): string = + if suggest.section == ideInlayHints: + result = $suggest.inlayHintInfo + else: + 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) + 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.quality) + if suggest.section == ideSug: + result.add(sep) + result.add($suggest.prefix) + + 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: + conf.suggestWriteln($s) + +proc produceOutput(a: var Suggestions; conf: ConfigRef) = + if conf.ideCmd in {ideSug, ideCon}: + a.sort cmpSuggestions + when defined(debug): + # debug code + writeStackTrace() + if a.len > conf.suggestMaxResults: a.setLen(conf.suggestMaxResults) + if not isNil(conf.suggestionResultHook): + for s in a: + conf.suggestionResultHook(s) + else: + for s in a: + conf.suggestWriteln($s) + +proc filterSym(s: PSym; prefix: PNode; res: var PrefixMatch): bool {.inline.} = + proc prefixMatch(s: PSym; n: PNode): PrefixMatch = + case n.kind + of nkIdent: result = n.ident.s.prefixMatch(s.name.s) + of nkSym: result = n.sym.name.s.prefixMatch(s.name.s) + of nkOpenSymChoice, nkClosedSymChoice, nkAccQuoted: + if n.len > 0: + result = prefixMatch(s, n[0]) + 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 filterSym(s: PSym): bool {.inline.} = - result = s.name.s[0] in lexer.SymChars and s.kind != skModule +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 + not isKeyword(s.name) proc fieldVisible*(c: PContext, f: PSym): bool {.inline.} = let fmoduleId = getModule(f).id - result = sfExported in f.flags or fmoduleId == c.module.id or - fmoduleId == c.friendModule.id - -proc suggestField(c: PContext, s: PSym, outputs: var int) = - if filterSym(s) and fieldVisible(c, s): - SuggestWriteln(SymToStr(s, isLocal=true, sectionSuggest)) - inc outputs - -when not defined(nimhygiene): - {.pragma: inject.} - -template wholeSymTab(cond, section: expr) {.immediate.} = - var isLocal = true - for scope in walkScopes(c.currentScope): - if scope == c.topLevelScope: isLocal = false - for item in items(scope.symbols): - let it {.inject.} = item - if cond: - SuggestWriteln(SymToStr(it, isLocal = isLocal, section)) - inc outputs - -proc suggestSymList(c: PContext, list: PNode, outputs: var int) = - for i in countup(0, sonsLen(list) - 1): - if list.sons[i].kind == nkSym: - suggestField(c, list.sons[i].sym, outputs) + result = sfExported in f.flags or fmoduleId == c.module.id + + if not result: + for module in c.friendModules: + if fmoduleId == module.id: return true + if f.kind == skField: + var symObj = f.owner.typ.toObjectFromRefPtrGeneric.sym + assert symObj != nil + for scope in allScopes(c.currentScope): + for sym in scope.allowPrivateAccess: + if symObj.id == sym.id: return true + +proc getQuality(s: PSym): range[0..100] = + result = 100 + if s.typ != nil and s.typ.paramsLen > 0: + var exp = s.typ.firstParamType.skipTypes({tyGenericInst, tyVar, tyLent, tyAlias, tySink}) + if exp.kind == tyVarargs: exp = elemType(exp) + if exp.kind in {tyUntyped, tyTyped, tyGenericParam, tyAnything}: result = 50 + + # 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 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: PNode, outputs: var int) = +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], outputs) - of nkRecCase: - var L = sonsLen(n) - if L > 0: - suggestObject(c, n.sons[0], outputs) - for i in countup(1, L-1): suggestObject(c, lastSon(n.sons[i]), outputs) - of nkSym: suggestField(c, n.sym, outputs) - else: nil - -proc nameFits(c: PContext, s: PSym, n: PNode): bool = - var op = n.sons[0] - if op.kind in {nkOpenSymChoice, nkClosedSymChoice}: op = op.sons[0] + of nkRecList: + for i in 0..<n.len: suggestObject(c, n[i], f, info, outputs) + of nkRecCase: + 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 = 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 @@ -105,163 +416,201 @@ proc nameFits(c: PContext, s: PSym, n: PNode): bool = else: return false result = opr.id == s.name.id -proc argsFit(c: PContext, candidate: PSym, n, nOrig: PNode): bool = - case candidate.kind +proc argsFit(c: PContext, candidate: PSym, n, nOrig: PNode): bool = + case candidate.kind of OverloadableSyms: - var m: TCandidate - initCandidate(m, candidate, nil) + var m = newCandidate(c, candidate, nil) sigmatch.partialMatch(c, n, nOrig, m) result = m.state != csNoMatch else: result = false -proc suggestCall(c: PContext, n, nOrig: PNode, outputs: var int) = - wholeSymTab(filterSym(it) and nameFits(c, it, n) and argsFit(c, it, n, nOrig), - sectionContext) - -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: - result = sigmatch.argtypeMatches(c, s.typ.sons[1], firstArg) +proc suggestCall(c: PContext, n, nOrig: PNode, outputs: var Suggestions) = + let info = n.info + 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 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.firstParamType.skipTypes({tyGenericInst, tyVar, tyLent, tyAlias, tySink}) + if exp.kind == tyVarargs: exp = elemType(exp) + if exp.kind in {tyUntyped, tyTyped, tyGenericParam, tyAnything}: return + result = sigmatch.argtypeMatches(c, s.typ.firstParamType, firstArg) + else: + result = false -proc suggestOperations(c: PContext, n: PNode, typ: PType, outputs: var int) = +proc suggestOperations(c: PContext, n, f: PNode, typ: PType, outputs: var Suggestions) = assert typ != nil - wholeSymTab(filterSym(it) and typeFits(c, it, typ), sectionSuggest) + let info = n.info + wholeSymTab(filterSymNoOpr(it, f, pm) and typeFits(c, it, typ), ideSug) -proc suggestEverything(c: PContext, n: PNode, outputs: var int) = +proc suggestEverything(c: PContext, n, f: PNode, outputs: var Suggestions) = # do not produce too many symbols: - var isLocal = true - for scope in walkScopes(c.currentScope): - if scope == c.topLevelScope: isLocal = false - for it in items(scope.symbols): - if filterSym(it): - SuggestWriteln(SymToStr(it, isLocal = isLocal, sectionSuggest)) - inc outputs - if scope == c.topLevelScope: break - -proc suggestFieldAccess(c: PContext, n: PNode, outputs: var int) = + 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 typ = n.typ + 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.isEmpty: + # error: no known module name: + typ = nil + else: + let m = c.graph.importModuleCallback(c.graph, c.module, fileInfoIdx(c.config, fullPath)) + if m == nil: typ = nil + else: + for it in allSyms(c.graph, n.sym): + if filterSym(it, field, pm): + 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: - if n.kind == nkSym and n.sym.kind == skModule: - if n.sym == c.module: + if n.kind == nkSym and n.sym.kind == skModule: + if n.sym == c.module: # all symbols accessible, because we are in the current module: for it in items(c.topLevelScope.symbols): - if filterSym(it): - SuggestWriteln(SymToStr(it, isLocal=false, sectionSuggest)) - inc outputs - else: - for it in items(n.sym.tab): - if filterSym(it): - SuggestWriteln(SymToStr(it, isLocal=false, sectionSuggest)) - inc outputs + if filterSym(it, field, pm): + outputs.add(symToSuggest(c.graph, it, isLocal=false, ideSug, + n.info, it.getQuality, pm, + c.inTypeContext > 0, -99)) + else: + for it in allSyms(c.graph, n.sym): + if filterSym(it, field, pm): + outputs.add(symToSuggest(c.graph, it, isLocal=false, ideSug, + n.info, it.getQuality, pm, + c.inTypeContext > 0, -99)) else: # fallback: - suggestEverything(c, n, 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, outputs) - t = t.sons[0] - suggestOperations(c, n, typ, outputs) + suggestEverything(c, n, field, outputs) else: - typ = skipTypes(typ, {tyGenericInst, tyVar, tyPtr, tyRef}) - 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 true: - suggestObject(c, t.n, outputs) - if t.sons[0] == nil: break - t = skipTypes(t.sons[0], {tyGenericInst}) - suggestOperations(c, n, typ, outputs) - elif typ.kind == tyTuple and typ.n != nil: - suggestSymList(c, typ.n, outputs) - suggestOperations(c, n, typ, outputs) - else: - suggestOperations(c, n, typ, outputs) + 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.baseClass == nil: break + t = skipTypes(t.baseClass, skipPtrs) + elif typ.kind == tyTuple and typ.n != nil: + # 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) -proc findClosestDot(n: PNode): PNode = - if n.kind == nkDotExpr and msgs.inCheckpoint(n.info) == cpExact: - result = n +type + TCheckPointResult* = enum + cpNone, cpFuzzy, cpExact + +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: - for i in 0.. <safeLen(n): - result = findClosestDot(n.sons[i]) - if result != nil: return + result = cpNone -const - CallNodes = {nkCall, nkInfix, nkPrefix, nkPostfix, nkCommand, nkCallStrLit} - -proc findClosestCall(n: PNode): PNode = - if n.kind in callNodes and msgs.inCheckpoint(n.info) == cpExact: - result = n +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: + result = true + else: + result = false else: - for i in 0.. <safeLen(n): - result = findClosestCall(n.sons[i]) - if result != nil: return - -proc isTracked(current: TLineInfo, tokenLen: int): bool = - # the column of an identifier is at its *end*, so we subtract to get the - # start of it. - for i in countup(0, high(checkPoints)): - if current.fileIndex == checkPoints[i].fileIndex: - if current.line == checkPoints[i].line: - let col = checkPoints[i].col - if col >= current.col-tokenLen and col <= current.col: - return true - -proc findClosestSym(n: PNode): PNode = - if n.kind == nkSym and msgs.inCheckpoint(n.info) == cpExact: - result = n - elif n.kind notin {nkNone..nkNilLit}: - for i in 0.. <sonsLen(n): - result = findClosestSym(n.sons[i]) - if result != nil: return - -proc safeSemExpr(c: PContext, n: PNode): PNode = - try: - result = c.semExpr(c, n) - except ERecoverableError: - result = ast.emptyNode - -proc fuzzySemCheck(c: PContext, n: PNode): PNode = - result = safeSemExpr(c, n) - if result == nil or result.kind == nkEmpty: - result = newNodeI(n.kind, n.info) - if n.kind notin {nkNone..nkNilLit}: - for i in 0 .. < sonsLen(n): result.addSon(fuzzySemCheck(c, n.sons[i])) - -var - usageSym*: PSym - lastLineInfo: TLineInfo - -proc findUsages(node: PNode, s: PSym) = - if usageSym == nil and isTracked(node.info, s.name.s.len): - usageSym = s - SuggestWriteln(SymToStr(s, isLocal=false, sectionUsage)) - elif s == usageSym: - if lastLineInfo != node.info: - SuggestWriteln(SymToStr(s, isLocal=false, sectionUsage, node.info)) - lastLineInfo = node.info - -proc findDefinition(node: PNode, s: PSym) = - if isTracked(node.info, s.name.s.len): - SuggestWriteln(SymToStr(s, isLocal=false, sectionDef)) - SuggestQuit() - -type - TSourceMap = object - lines: seq[TLineMap] - - TEntry = object - pos: int - sym: PSym + result = false - TLineMap = object - entries: seq[TEntry] +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 -var - gSourceMaps: seq[TSourceMap] = @[] +when defined(nimsuggest): + # Since TLineInfo defined a == operator that doesn't include the column, + # we map TLineInfo to a unique int here for this lookup table: + proc infoToInt(info: TLineInfo): int64 = + info.fileIndex.int64 + info.line.int64 shl 32 + info.col.int64 shl 48 + + proc addNoDup(s: PSym; info: TLineInfo) = + # ensure nothing gets too slow: + if s.allUsages.len > 500: return + let infoAsInt = info.infoToInt + for infoB in s.allUsages: + if infoB.infoToInt == infoAsInt: return + s.allUsages.add(info) + +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(g.config, symToSuggest(g, s, isLocal=false, ideUse, info, 100, PrefixMatch.None, false, 0)) + elif s == usageSym: + 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*(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(g.config, symToSuggest(g, s, isLocal=false, x, info, 100, PrefixMatch.None, false, 0)) + +proc findDefinition(g: ModuleGraph; info: TLineInfo; s: PSym; usageSym: var PSym) = + if s.isNil: return + if isTracked(info, g.config.m.trackPos, s.name.s.len) or (s == usageSym and sfForward notin s.flags): + suggestResult(g.config, symToSuggest(g, s, isLocal=false, ideDef, info, 100, PrefixMatch.None, false, 0, useSuppliedInfo = s == usageSym)) + if sfForward notin s.flags 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) @@ -269,105 +618,242 @@ proc ensureIdx[T](x: var T, y: int) = proc ensureSeq[T](x: var seq[T]) = if x == nil: newSeq(x, 0) -proc resetSourceMap*(fileIdx: int32) = - ensureIdx(gSourceMaps, fileIdx) - gSourceMaps[fileIdx].lines = @[] - -proc addToSourceMap(sym: Psym, info: TLineInfo) = - ensureIdx(gSourceMaps, info.fileIndex) - ensureSeq(gSourceMaps[info.fileIndex].lines) - ensureIdx(gSourceMaps[info.fileIndex].lines, info.line) - ensureSeq(gSourceMaps[info.fileIndex].lines[info.line].entries) - gSourceMaps[info.fileIndex].lines[info.line].entries.add(TEntry(pos: info.col, sym: sym)) - -proc defFromLine(entries: var seq[TEntry], col: int32) = - if entries == nil: return - # The sorting is done lazily here on purpose. - # No need to pay the price for it unless the user requests - # "goto definition" on a particular line - sort(entries) do (a,b: TEntry) -> int: - return cmp(a.pos, b.pos) - - for e in entries: - # currently, the line-infos for most expressions point to - # one position past the end of the expression. This means - # that the first expr that ends after the cursor column is - # the one we are looking for. - if e.pos >= col: - SuggestWriteln(SymToStr(e.sym, isLocal=false, sectionDef)) - return - -proc defFromSourceMap*(i: TLineInfo) = - if not ((i.fileIndex < gSourceMaps.len) and - (gSourceMaps[i.fileIndex].lines != nil) and - (i.line < gSourceMaps[i.fileIndex].lines.len)): return - - defFromLine(gSourceMaps[i.fileIndex].lines[i.line].entries, i.col) - -proc suggestSym*(n: PNode, s: PSym) {.inline.} = +proc suggestSym*(g: ModuleGraph; info: TLineInfo; s: PSym; usageSym: var PSym; isDecl=true) {.inline.} = ## misnamed: should be 'symDeclared' - if optUsages in gGlobalOptions: - findUsages(n, s) - if optDef in gGlobalOptions: - findDefinition(n, s) - if isServing: - addToSourceMap(s, n.info) - -proc markUsed(n: PNode, s: PSym) = + let conf = g.config + when defined(nimsuggest): + g.suggestSymbols.add SymInfoPair(sym: s, info: info, isDecl: isDecl), optIdeExceptionInlayHints in g.config.globalOptions + + if conf.suggestVersion == 0: + if s.allUsages.len == 0: + s.allUsages = @[info] + else: + s.addNoDup(info) + + if conf.ideCmd == ideUse: + findUsages(g, info, s, usageSym) + elif conf.ideCmd == ideDef: + 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(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(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) = + 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: Message(n.info, warnDeprecated, s.name.s) - if sfError in s.flags: LocalError(n.info, errWrongSymbolX, s.name.s) - suggestSym(n, s) - -proc useSym*(sym: PSym): PNode = - result = newSymNode(sym) - markUsed(result, sym) - -proc suggestExpr*(c: PContext, node: PNode) = - var cp = msgs.inCheckpoint(node.info) - if cp == cpNone: return - var outputs = 0 + 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 + + 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! + try: + result = c.semExpr(c, n) + except ERecoverableError: + result = c.graph.emptyNode + +proc sugExpr(c: PContext, n: PNode, outputs: var Suggestions) = + if n.kind == nkDotExpr: + 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: + let prefix = if n.len == 2 and n[1].info.line == n[0].info.line and + not c.config.m.trackPosAttached: n[1] else: nil + suggestFieldAccess(c, obj, prefix, outputs) + + #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) + +proc suggestExprNoCheck*(c: PContext, n: PNode) = # This keeps semExpr() from coming here recursively: - if c.InCompilesContext > 0: return - inc(c.InCompilesContext) - - if optSuggest in gGlobalOptions: - var n = findClosestDot(node) - if n == nil: n = node - else: cp = cpExact - if n.kind == nkDotExpr and cp == cpExact: - var obj = safeSemExpr(c, n.sons[0]) - suggestFieldAccess(c, obj, outputs) - else: - #debug n - suggestEverything(c, n, outputs) - - if optContext in gGlobalOptions: - var n = findClosestCall(node) - if n == nil: n = node - else: cp = cpExact - - if n.kind in CallNodes: + if c.compilesContextId > 0: return + inc(c.compilesContextId) + var outputs: Suggestions = @[] + if c.config.ideCmd == ideSug: + sugExpr(c, n, outputs) + 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) - - dec(c.InCompilesContext) - if outputs > 0 and optUsages notin gGlobalOptions: SuggestQuit() - -proc suggestStmt*(c: PContext, n: PNode) = + 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}: + produceOutput(outputs, c.config) + suggestQuit() + +proc suggestExpr*(c: PContext, n: PNode) = + if exactEquals(c.config.m.trackPos, n.info): suggestExprNoCheck(c, n) + +proc suggestDecl*(c: PContext, n: PNode; s: PSym) = + let attached = c.config.m.trackPosAttached + 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 findSuggest*(c: PContext, n: PNode) = - if n == nil: return +proc suggestStmt*(c: PContext, n: PNode) = suggestExpr(c, n) - for i in 0.. <safeLen(n): - findSuggest(c, n.sons[i]) + +proc suggestEnum*(c: PContext; n: PNode; t: PType) = + var outputs: Suggestions = @[] + suggestSymList(c, t.n, nil, n.info, outputs) + produceOutput(outputs, c.config) + if outputs.len > 0: suggestQuit() + +proc suggestPragmas*(c: PContext, n: PNode) = + ## Suggests anything that might be a pragma + ## - template that has {.pragma.} + ## - macros + ## - user pragmas + let info = n.info + var outputs: Suggestions = @[] + # First filter for template/macros + wholeSymTab(filterSym(it, n, pm) and + (sfCustomPragma in it.flags or it.kind == skMacro), + ideSug) + + # Now show suggestions for user pragmas + for pragma in c.userPragmas: + var pm = default(PrefixMatch) + if filterSym(pragma, n, pm): + outputs &= symToSuggest(c.graph, pragma, isLocal=true, ideSug, info, + pragma.getQuality, pm, c.inTypeContext > 0, 0, + extractDocs=false) + + produceOutput(outputs, c.config) + if outputs.len > 0: + suggestQuit() + +template trySuggestPragmas*(c: PContext, n: PNode) = + ## Runs [suggestPragmas] when compiling nimsuggest and + ## we are querying the node + when defined(nimsuggest): + let tmp = n + if c.config.ideCmd == ideSug and exactEquals(c.config.m.trackPos, tmp.info): + suggestPragmas(c, tmp) + +proc suggestSentinel*(c: PContext) = + if c.config.ideCmd != ideSug or c.module.position != c.config.m.trackPos.fileIndex.int32: return + if c.compilesContextId > 0: return + inc(c.compilesContextId) + var outputs: Suggestions = @[] + # suggest everything: + for (it, scopeN, isLocal) in 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 3965cb3fe..6b325c77f 100644 --- a/compiler/syntaxes.nim +++ b/compiler/syntaxes.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -9,168 +9,137 @@ ## Implements the dispatcher for the different parsers. -import - strutils, llstream, ast, astalgo, idents, lexer, options, msgs, parser, - pbraces, filters, filter_tmpl, renderer +import + llstream, ast, idents, lexer, options, msgs, parser, + filters, filter_tmpl, renderer, lineinfos, pathutils -type - TFilterKind* = enum - filtNone, filtTemplate, filtReplace, filtStrip - TParserKind* = enum - skinStandard, skinBraces, skinEndX +import std/strutils +when defined(nimPreviewSlimSystem): + import std/[syncio, assertions] -const - parserNames*: array[TParserKind, string] = ["standard", "braces", "endx"] - filterNames*: array[TFilterKind, string] = ["none", "stdtmpl", "replace", - "strip"] +export Parser, parseAll, parseTopLevelStmt, checkFirstLineIndentation, closeParser -type - TParsers*{.final.} = object - skin*: TParserKind - parser*: TParser +type + 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': + 3 + else: + 0 -proc parseFile*(fileIdx: int32): PNode{.procvar.} -proc openParsers*(p: var TParsers, fileIdx: int32, inputstream: PLLStream) -proc closeParsers*(p: var TParsers) -proc parseAll*(p: var TParsers): PNode -proc parseTopLevelStmt*(p: var TParsers): PNode - # implements an iterator. Returns the next top-level statement or nil if end - # of stream. - -# implementation - -proc ParseFile(fileIdx: int32): PNode = - var - p: TParsers - f: tfile - let filename = fileIdx.toFullPath - if not open(f, filename): - rawMessage(errCannotOpenFile, filename) - return - OpenParsers(p, fileIdx, LLStreamOpen(f)) - result = ParseAll(p) - CloseParsers(p) - -proc parseAll(p: var TParsers): PNode = - case p.skin - of skinStandard: - result = parser.parseAll(p.parser) - of skinBraces: - result = pbraces.parseAll(p.parser) - of skinEndX: - InternalError("parser to implement") - result = ast.emptyNode - # skinEndX: result := pendx.parseAll(p.parser); - -proc parseTopLevelStmt(p: var TParsers): PNode = - case p.skin - of skinStandard: - result = parser.parseTopLevelStmt(p.parser) - of skinBraces: - result = pbraces.parseTopLevelStmt(p.parser) - of skinEndX: - InternalError("parser to implement") - result = ast.emptyNode - #skinEndX: result := pendx.parseTopLevelStmt(p.parser); - -proc UTF8_BOM(s: string): int = - if (s[0] == '\xEF') and (s[1] == '\xBB') and (s[2] == '\xBF'): - result = 3 - else: - result = 0 - -proc containsShebang(s: string, i: int): bool = - if (s[i] == '#') and (s[i + 1] == '!'): +proc containsShebang(s: string, i: int): bool = + if i+1 < s.len and s[i] == '#' and s[i+1] == '!': var j = i + 2 - while s[j] in WhiteSpace: inc(j) + while j < s.len and s[j] in Whitespace: inc(j) result = s[j] == '/' + else: + result = false -proc parsePipe(filename: string, inputStream: PLLStream): PNode = - result = ast.emptyNode - var s = LLStreamOpen(filename, fmRead) - if s != nil: +proc parsePipe(filename: AbsoluteFile, inputStream: PLLStream; cache: IdentCache; + config: ConfigRef): PNode = + result = newNode(nkEmpty) + var s = llStreamOpen(filename, fmRead) + if s != nil: var line = newStringOfCap(80) - discard LLStreamReadLine(s, line) - var i = UTF8_Bom(line) + discard llStreamReadLine(s, line) + var i = utf8Bom(line) + var linenumber = 1 if containsShebang(line, i): - discard LLStreamReadLine(s, line) + discard llStreamReadLine(s, line) i = 0 - if line[i] == '#' and line[i+1] == '!': - inc(i, 2) - while line[i] in WhiteSpace: inc(i) - var q: TParser - OpenParser(q, filename, LLStreamOpen(substr(line, i))) - result = parser.parseAll(q) - CloseParser(q) - LLStreamClose(s) + inc linenumber + if i+1 < line.len and line[i] == '#' and line[i+1] == '?': + 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 IdentEq(ident, filterNames[i]): - return i +proc getFilter(ident: PIdent): FilterKind = result = filtNone - -proc getParser(ident: PIdent): TParserKind = - for i in countup(low(TParserKind), high(TParserKind)): - if IdentEq(ident, parserNames[i]): + for i in FilterKind: + if cmpIgnoreStyle(ident.s, $i) == 0: return i - rawMessage(errInvalidDirectiveX, ident.s) -proc getCallee(n: PNode): PIdent = - if n.kind in nkCallKinds and n.sons[0].kind == nkIdent: - result = n.sons[0].ident - elif n.kind == nkIdent: +proc getCallee(conf: ConfigRef; n: PNode): PIdent = + if n.kind in nkCallKinds and n[0].kind == nkIdent: + result = n[0].ident + elif n.kind == nkIdent: result = n.ident - else: - rawMessage(errXNotAllowedHere, renderTree(n)) - -proc applyFilter(p: var TParsers, n: PNode, filename: string, - stdin: PLLStream): PLLStream = - var ident = getCallee(n) - var f = getFilter(ident) - case f - of filtNone: - p.skin = getParser(ident) - result = stdin - of filtTemplate: - result = filterTmpl(stdin, filename, n) - of filtStrip: - result = filterStrip(stdin, filename, n) - of filtReplace: - result = filterReplace(stdin, filename, n) - if f != filtNone: - if gVerbosity >= 2: - rawMessage(hintCodeBegin, []) - MsgWriteln(result.s) - rawMessage(hintCodeEnd, []) + else: + result = nil + localError(conf, n.info, "invalid filter: " & renderTree(n)) -proc evalPipe(p: var TParsers, n: PNode, filename: string, - start: PLLStream): PLLStream = +proc applyFilter(p: var Parser, n: PNode, filename: AbsoluteFile, + stdin: PLLStream): PLLStream = + 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.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 Parser, n: PNode, filename: AbsoluteFile, + start: PLLStream): PLLStream = + assert p.lex.config != nil result = start - if n.kind == nkEmpty: return - if (n.kind == nkInfix) and (n.sons[0].kind == nkIdent) and - IdentEq(n.sons[0].ident, "|"): - for i in countup(1, 2): - if n.sons[i].kind == nkInfix: - result = evalPipe(p, n.sons[i], filename, result) - else: - result = applyFilter(p, n.sons[i], filename, result) - elif n.kind == nkStmtList: - result = evalPipe(p, n.sons[0], filename, result) - else: + if n.kind == nkEmpty: return + if n.kind == nkInfix and n[0].kind == nkIdent and n[0].ident.s == "|": + for i in 1..2: + if n[i].kind == nkInfix: + result = evalPipe(p, n[i], filename, result) + else: + result = applyFilter(p, n[i], filename, result) + elif n.kind == nkStmtList: + result = evalPipe(p, n[0], filename, result) + else: result = applyFilter(p, n, filename, result) - -proc openParsers(p: var TParsers, fileIdx: int32, inputstream: PLLStream) = - var s: PLLStream - p.skin = skinStandard - let filename = fileIdx.toFullPath - var pipe = parsePipe(filename, inputStream) - if pipe != nil: s = evalPipe(p, pipe, filename, inputStream) - else: s = inputStream - case p.skin - of skinStandard, skinBraces, skinEndX: - parser.openParser(p.parser, fileIdx, s) - -proc closeParsers(p: var TParsers) = - parser.closeParser(p.parser) + +proc openParser*(p: var Parser, fileIdx: FileIndex, inputstream: PLLStream; + cache: IdentCache; config: ConfigRef) = + assert config != nil + let filename = toFullPathConsiderDirty(config, fileIdx) + var pipe = parsePipe(filename, inputstream, cache, config) + p.lex.config = config + let s = if pipe != nil: evalPipe(p, pipe, filename, inputstream) + else: inputstream + parser.openParser(p, fileIdx, s, cache, config) + +proc setupParser*(p: var Parser; fileIdx: FileIndex; cache: IdentCache; + config: ConfigRef): bool = + let filename = toFullPathConsiderDirty(config, fileIdx) + 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 9ed6db8a1..9ee8516c4 100644 --- a/compiler/tccgen.nim +++ b/compiler/tccgen.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -8,14 +8,22 @@ # 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".} -proc tinyCErrorHandler(closure: pointer, msg: cstring) {.cdecl.} = - rawMessage(errGenerated, $msg) - -proc initTinyCState: PccState = +var + gConf: ConfigRef # ugly but can be cleaned up if this is revived + +proc tinyCErrorHandler(closure: pointer, msg: cstring) {.cdecl.} = + rawMessage(gConf, errGenerated, $msg) + +proc initTinyCState: PccState = result = openCCState() setErrorFunc(result, nil, tinyCErrorHandler) @@ -23,56 +31,59 @@ var gTinyC = initTinyCState() libIncluded = false -proc addFile(filename: string) = +proc addFile(filename: string) = if addFile(gTinyC, filename) != 0'i32: - rawMessage(errCannotOpenFile, filename) + rawMessage(gConf, errCannotOpenFile, filename) -proc setupEnvironment = +proc setupEnvironment = when defined(amd64): defineSymbol(gTinyC, "__x86_64__", nil) elif defined(i386): - defineSymbol(gTinyC, "__i386__", nil) + defineSymbol(gTinyC, "__i386__", nil) when defined(linux): defineSymbol(gTinyC, "__linux__", nil) defineSymbol(gTinyC, "__linux", nil) - var nimrodDir = getPrefixDir() - addIncludePath(gTinyC, libpath) - when defined(windows): - addSysincludePath(gTinyC, nimrodDir / "tinyc/win32/include") - addSysincludePath(gTinyC, nimrodDir / "tinyc/include") - when defined(windows): + var nimDir = getPrefixDir(gConf).string + var tinycRoot = nimDir / tinyPrefix + let libpath = nimDir / "lib" + + addIncludePath(gTinyC, cstring(libpath)) + when defined(windows): + 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") % ["nimrod", nimrodDir] - 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(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\dllcrt1.o") - #addFile(nimrodDir / r"tinyc\win32\dllmain.o") - addFile(nimrodDir / 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*() = - var a: array[0..1, cstring] - a[0] = "" - a[1] = "" - var err = tinyc.run(gTinyC, 0'i32, cast[cstringArray](addr(a))) != 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 a81457b39..8dd24e090 100644 --- a/compiler/transf.nim +++ b/compiler/transf.nim @@ -1,7 +1,7 @@ # # -# The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -12,221 +12,269 @@ # # * inlines iterators # * inlines constants -# * performes constant folding -# * converts "continue" to "break" +# * performs constant folding +# * converts "continue" to "break"; disambiguates "break" # * introduces method dispatchers # * performs lambda lifting for closure support +# * transforms 'defer' into a 'try finally' statement -import - intsets, strutils, lists, options, ast, astalgo, trees, treetab, msgs, os, - idents, renderer, types, passes, semfold, magicsys, cgmeth, rodread, - lambdalifting, sempass2 +import std / tables -const - genPrefix* = ":tmp" # prefix for generated names +import + options, ast, astalgo, trees, msgs, + idents, renderer, types, semfold, magicsys, cgmeth, + lowerings, liftlocals, + modulegraphs, lineinfos -# implementation +when defined(nimPreviewSlimSystem): + import std/assertions -type - PTransNode* = distinct PNode - - PTransCon = ref TTransCon - TTransCon{.final.} = object # part of TContext; stackable - mapping: TIdNodeTable # mapping from symbols to nodes +type + TransformFlag* = enum + useCache, keepOpenArrayConversions, force + TransformFlags* = set[TransformFlag] + +proc transformBody*(g: ModuleGraph; idgen: IdGenerator; prc: PSym; flags: TransformFlags): PNode + +import closureiters, lambdalifting + +type + PTransCon = ref 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 - yieldStmts: int # we count the number of yield statements, + 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' - inLoop: int # > 0 if we are in a loop - PTransf = ref TTransfContext + deferDetected, tooEarly: bool + isIntroducingNewLocalVars: bool # true if we are in `introducingNewLocalVars` (don't transform yields) + inAddr: bool + flags: TransformFlags + graph: ModuleGraph + 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.} = +proc newTransNode(kind: TNodeKind, info: TLineInfo, + 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.} = +proc newTransNode(kind: TNodeKind, n: PNode, + sons: int): PNode {.inline.} = var x = newNodeIT(kind, n.info, n.typ) newSeq(x.sons, sons) - x.typ = n.typ - result = x.PTransNode - -proc `[]=`(a: PTransNode, i: int, x: PTransNode) {.inline.} = - var n = PNode(a) - n.sons[i] = PNode(x) +# x.flags = n.flags + result = 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) - -proc newTransCon(owner: PSym): PTransCon = +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) = +proc pushTransCon(c: PTransf, t: PTransCon) = t.next = c.transCon c.transCon = t -proc popTransCon(c: PTransf) = - if (c.transCon == nil): InternalError("popTransCon") +proc popTransCon(c: PTransf) = + if (c.transCon == nil): internalError(c.graph.config, "popTransCon") c.transCon = c.transCon.next -proc getCurrOwner(c: PTransf): PSym = +proc getCurrOwner(c: PTransf): PSym = if c.transCon != nil: result = c.transCon.owner else: result = c.module - -proc newTemp(c: PTransf, typ: PType, info: TLineInfo): PSym = - result = newSym(skTemp, getIdent(genPrefix), getCurrOwner(c), info) - result.typ = skipTypes(typ, {tyGenericInst}) - incl(result.flags, sfFromGeneric) -proc transform(c: PTransf, n: PNode): PTransNode +proc newTemp(c: PTransf, typ: PType, info: TLineInfo): PNode = + let r = newSym(skTemp, getIdent(c.graph.cache, genPrefix), c.idgen, getCurrOwner(c), info) + r.typ = typ #skipTypes(typ, {tyGenericInst, tyAlias, tySink}) + incl(r.flags, sfFromGeneric) + let owner = getCurrOwner(c) + 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): 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]) + for i in 0..<n.len: + result[i] = transform(c, n[i]) -proc newAsgnStmt(c: PTransf, le: PNode, ri: PTransNode): PTransNode = - result = newTransNode(nkFastAsgn, PNode(ri).info, 2) - result[0] = PTransNode(le) +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 = - if n.sym.kind == skIterator and n.sym.typ.callConv == ccClosure: - return liftIterSym(n) + 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, 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, 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: var b: PNode var tc = c.transCon - if sfBorrow in n.sym.flags: + if sfBorrow in s.flags and s.kind in routineKinds: # simply exchange the symbol: - b = n.sym.getBody - if b.kind != nkSym: internalError(n.info, "wrong AST for borrowed symbol") - b = newSymNode(b.sym) - b.info = n.info - else: + 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) - if result != nil: return + while tc != nil: + result = getOrDefault(tc.mapping, b.sym.itemId) + if result != nil: + # this slightly convoluted way ensures the line info stays correct: + if result.kind == nkSym: + result = copyNode(result) + result.info = n.info + return 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 transformVarSection(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) - elif it.kind == nkIdentDefs: - if it.sons[0].kind != nkSym: InternalError(it.info, "transformVarSection") - InternalAssert(it.len == 3) - var newVar = copySym(it.sons[0].sym) - incl(newVar.flags, sfFromGeneric) - # fixes a strange bug for rodgen: - #include(it.sons[0].sym.flags, sfFromGeneric); - newVar.owner = getCurrOwner(c) - IdNodeTablePut(c.transCon.mapping, it.sons[0].sym, newSymNode(newVar)) - var defs = newTransNode(nkIdentDefs, it.info, 3) - if importantComments(): - # keep documentation information: - pnode(defs).comment = it.comment - defs[0] = newSymNode(newVar).PTransNode - defs[1] = it.sons[1].PTransNode - defs[2] = transform(c, it.sons[2]) - result[i] = defs - else: - if it.kind != nkVarTuple: - InternalError(it.info, "transformVarSection: not nkVarTuple") - var L = sonsLen(it) - var defs = newTransNode(it.kind, it.info, L) - for j in countup(0, L-3): - var newVar = copySym(it.sons[j].sym) - incl(newVar.flags, sfFromGeneric) - newVar.owner = getCurrOwner(c) - IdNodeTablePut(c.transCon.mapping, it.sons[j].sym, newSymNode(newVar)) - defs[j] = newSymNode(newVar).PTransNode - assert(it.sons[L-2].kind == nkEmpty) - defs[L-1] = transform(c, it.sons[L-1]) - result[i] = defs +proc freshVar(c: PTransf; v: PSym): PNode = + let owner = getCurrOwner(c) + 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, c.idgen) + incl(newVar.flags, sfFromGeneric) + newVar.owner = owner + result = newSymNode(newVar) -proc transformConstSection(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: + 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, vn.sym) + c.transCon.mapping[vn.sym.itemId] = x + var defs = newTransNode(nkIdentDefs, it.info, 3) + if importantComments(c.graph.config): + # keep documentation information: + 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 + # transform it: + result[i] = transform(c, it) else: - if it.kind != nkConstDef: InternalError(it.info, "transformConstSection") - if it.sons[0].kind != nkSym: - InternalError(it.info, "transformConstSection") - if sfFakeConst in it[0].sym.flags: - var b = newNodeI(nkConstDef, it.info) - addSon(b, it[0]) - addSon(b, ast.emptyNode) # no type description - addSon(b, transform(c, it[2]).pnode) - result[i] = PTransNode(b) + if it.kind != nkVarTuple: + internalError(c.graph.config, it.info, "transformVarSection: not nkVarTuple") + var defs = newTransNode(it.kind, it.info, it.len) + for j in 0..<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): 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: - result[i] = PTransNode(it) + 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") -proc hasContinue(n: PNode): bool = + result[i] = it + +proc hasContinue(n: PNode): bool = case n.kind - of nkEmpty..nkNilLit, nkForStmt, nkParForStmt, nkWhileStmt: nil + 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 + else: + result = false + for i in 0..<n.len: + if hasContinue(n[i]): return true proc newLabel(c: PTransf, n: PNode): PSym = - result = newSym(skLabel, nil, getCurrOwner(c), n.info) - result.name = getIdent(genPrefix & $result.id) + 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 - -proc transformBreak(c: PTransf, n: PNode): PTransNode = - if c.inLoop > 0 or n.sons[0].kind != nkEmpty: - result = n.ptransNode - else: - let labl = c.breakSyms[c.breakSyms.high] - result = transformSons(c, n) - result[0] = newSymNode(labl).PTransNode + result[0] = newSymNode(labl) -proc transformLoopBody(c: PTransf, n: PNode): PTransNode = - # What if it contains "continue" and "break"? "break" needs +proc transformLoopBody(c: PTransf, n: PNode): PNode = + # What if it contains "continue" and "break"? "break" needs # an explicit label too, but not the same! - + # We fix this here by making every 'break' belong to its enclosing loop # and changing all breaks that belong to a 'block' by annotating it with # a label (if it hasn't one already). @@ -235,500 +283,993 @@ 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: + else: result = transform(c, n) - -proc newTupleAccess(tup: PNode, i: int): PNode = - result = newNodeIT(nkBracketExpr, tup.info, tup.typ.sons[i]) - addSon(result, copyTree(tup)) - var lit = newNodeIT(nkIntLit, tup.info, getSysType(tyInt)) - lit.intVal = i - addSon(result, lit) - -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(n, i)))) - -proc introduceNewLocalVars(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) + + var body = newTransNode(n) + 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): PNode = + result = transformSons(c, n) + if n[0].kind == nkEmpty and c.breakSyms.len > 0: + let labl = c.breakSyms[c.breakSyms.high] + result[0] = newSymNode(labl) + +proc introduceNewLocalVars(c: PTransf, n: PNode): PNode = case n.kind - of nkSym: + of nkSym: result = transformSym(c, n) - of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit: + 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: + # 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[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]) + for i in 0..<n.len: + result[i] = introduceNewLocalVars(c, n[i]) -proc transformYield(c: PTransf, n: PNode): PTransNode = +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 skipTypes(e.typ, {tyGenericInst}).kind == tyTuple and - c.transCon.forStmt.len != 3: + if e.typ.isNil: return result # can happen in nimsuggest for unknown reasons + if c.transCon.forStmt.len != 3: e = skipConv(e) - if e.kind == nkPar: - for i in countup(0, sonsLen(e) - 1): - add(result, newAsgnStmt(c, c.transCon.forStmt.sons[i], - transform(c, e.sons[i]))) - else: - unpackTuple(c, e, result) - else: - var x = transform(c, e) - add(result, newAsgnStmt(c, c.transCon.forStmt.sons[0], x)) - + 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: + for i in 0..<c.transCon.forStmt.len - 2: + let lhs = c.transCon.forStmt[i] + let rhs = transform(c, newTupleAccess(c.graph, e, i)) + result.add(asgnTo(lhs, rhs)) + else: + if c.transCon.forStmt[0].kind == nkVarTuple: + 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) - else: + 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) - 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: + 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: + 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]) - -proc transformConv(c: PTransf, n: PNode): PTransNode = + result = n[0][0] + if n.typ.skipTypes(abstractVar).kind != tyOpenArray: + result.typ = n.typ + +proc generateThunk(c: PTransf; prc: PNode, dest: PType): PNode = + ## Converts 'prc' into '(thunk, nil)' so that it's compatible with + ## a closure. + + # we cannot generate a proper thunk here for GC-safety reasons + # (see internal documentation): + 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)) + conv.add(prc) + if prc.kind == nkClosure: + internalError(c.graph.config, prc.info, "closure to closure created") + result.add(conv) + result.add(newNodeIT(nkNilLit, prc.info, getSysType(c.graph, prc.info, tyNil))) + +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(n.typ) <= firstOrd(n.sons[1].typ) and - lastOrd(n.sons[1].typ) <= lastOrd(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) - else: + else: # generate a range check: - if dest.kind == tyInt64 or source.kind == tyInt64: + if dest.kind == tyInt64 or source.kind == tyInt64: result = newTransNode(nkChckRange64, n, 3) else: result = newTransNode(nkChckRange, n, 3) dest = skipTypes(n.typ, abstractVar) - result[0] = transform(c, n.sons[1]) - result[1] = newIntTypeNode(nkIntLit, firstOrd(dest), source).PTransNode - result[2] = newIntTypeNode(nkIntLit, lastOrd(dest), source).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: + 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]) - of tyCString: - if source.kind == tyString: + 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: + of tyString: + 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: + of tyRef, tyPtr: dest = skipTypes(dest, abstractPtrs) source = skipTypes(source, abstractPtrs) - if source.kind == tyObject: + if source.kind == tyObject: var diff = inheritanceDiff(dest, source) - if diff < 0: + if diff < 0: result = newTransNode(nkObjUpConv, n, 1) - result[0] = transform(c, n.sons[1]) - elif diff > 0: + 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]) - else: - result = transform(c, n.sons[1]) + result[0] = transform(c, n[1]) + else: + result = transform(c, n[1]) + result.typ = n.typ else: result = transformSons(c, n) - of tyObject: + of tyObject: var diff = inheritanceDiff(dest, source) - if diff < 0: + if diff < 0: result = newTransNode(nkObjUpConv, n, 1) - result[0] = transform(c, n.sons[1]) - elif diff > 0: + 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]) - else: - result = transform(c, n.sons[1]) - of tyGenericParam, tyOrdinal, tyTypeClass: - result = transform(c, n.sons[1]) + result[0] = transform(c, n[1]) + else: + result = transform(c, n[1]) + result.typ = n.typ + of tyGenericParam, tyOrdinal: + result = transform(c, n[1]) # happens sometimes for generated assignments, etc. - else: + of tyProc: result = transformSons(c, n) - -type - TPutArgInto = enum - paDirectMapping, paFastAsgn, paVarAsgn + if dest.callConv == ccClosure and source.callConv == ccNimCall: + result = generateThunk(c, result[1], dest) + else: + result = transformSons(c, n) + +type + TPutArgInto = enum + paDirectMapping, paFastAsgn, paFastAsgnTakeTypeFromArg + paVarAsgn, paComplexOpenarray, paViaIndirection -proc putArgInto(arg: PNode, formal: PType): TPutArgInto = +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}: - return paDirectMapping # XXX really correct? - # what if ``arg`` has side-effects? + case arg.kind + of nkStmtListExpr: + return paComplexOpenarray + of nkBracket: + return paFastAsgnTakeTypeFromArg + else: + # XXX incorrect, causes #13417 when `arg` has side effects. + return paDirectMapping case arg.kind - of nkEmpty..nkNilLit: + of nkEmpty..nkNilLit: + result = paDirectMapping + 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, nkCurly, nkBracket: - result = paFastAsgn - for i in countup(0, sonsLen(arg) - 1): - if putArgInto(arg.sons[i], formal) != paDirectMapping: return + 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 - else: - if skipTypes(formal, abstractInst).kind == tyVar: result = paVarAsgn + 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(x.info, "bah " & x.sym.name.s & " " & + 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]) - -proc transformFor(c: PTransf, n: PNode): PTransNode = + 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): PNode = # generate access statements for the parameters (unless they are constant) # put mapping from formal parameters to actual parameters - if n.kind != nkForStmt: InternalError(n.info, "transformFor") + if n.kind != nkForStmt: internalError(c.graph.config, n.info, "transformFor") + + var call = n[^2] - var length = sonsLen(n) - var call = n.sons[length - 2] - if call.kind notin nkCallKinds or call.sons[0].kind != nkSym or - call.sons[0].typ.callConv == ccClosure or - call.sons[0].sym.kind != skIterator: - n.sons[length-1] = transformLoopBody(c, n.sons[length-1]).pnode - return lambdalifting.liftForLoop(n).ptransNode - #InternalError(call.info, "transformFor") + let labl = newLabel(c, n) + result = newTransNode(nkBlockStmt, n.info, 2) + result[0] = newSymNode(labl) + if call.typ.isNil: + # see bug #3051 + result[1] = newNode(nkEmpty) + return result + c.breakSyms.add(labl) + 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 #echo "transforming: ", renderTree(n) - result = newTransNode(nkStmtList, n.info, 0) - var loopBody = transformLoopBody(c, n.sons[length-1]) + var stmtList = newTransNode(nkStmtList, n.info, 0) + result[1] = stmtList + + 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(result, 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 - if iter.kind != skIterator: InternalError(call.info, "transformFor") + # this can fail for 'nimsuggest' and 'check': + 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 - var formal = skipTypes(iter.typ, abstractInst).n.sons[i].sym - case putArgInto(arg, formal.typ) - of paDirectMapping: - IdNodeTablePut(newC.mapping, formal, arg) - of paFastAsgn: + 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[i].sym + let pa = putArgInto(arg, formal.typ) + case pa + of paDirectMapping: + 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) - addVar(v, newSymNode(temp)) - add(result, newAsgnStmt(c, newSymNode(temp), arg.ptransNode)) - IdNodeTablePut(newC.mapping, formal, newSymNode(temp)) + var temp = newTemp(c, t, formal.info) + #incl(temp.sym.flags, sfCursor) + addVar(v, 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! - var body = iter.getBody - pushInfoContext(n.info) + of paViaIndirection: + let t = formal.typ + let vt = makeVarType(t.owner, t, c.idgen) + vt.flags.incl tfVarIsPtr + var temp = newTemp(c, vt, formal.info) + addVar(v, temp) + var addrExp = newNodeIT(nkHiddenAddr, formal.info, makeVarType(t.owner, t, c.idgen, tyPtr)) + addrExp.add(arg) + stmtList.add(newAsgnStmt(c, nkFastAsgn, temp, addrExp, true)) + newC.mapping[formal.itemId] = newDeref(temp) + of paComplexOpenarray: + # arrays will deep copy here (pretty bad). + var temp = newTemp(c, arg.typ, formal.info) + addVar(v, temp) + stmtList.add(newAsgnStmt(c, nkFastAsgn, temp, arg, true)) + newC.mapping[formal.itemId] = temp + + let body = transformBody(c.graph, c.idgen, iter, {useCache}+c.flags) + pushInfoContext(c.graph.config, n.info) inc(c.inlining) - add(result, transform(c, body)) - #findWrongOwners(c, result.pnode) + stmtList.add(transform(c, body)) + #findWrongOwners(c, stmtList.PNode) dec(c.inlining) - popInfoContext() + popInfoContext(c.graph.config) popTransCon(c) - #echo "transformed: ", renderTree(n) - -proc getMagicOp(call: PNode): TMagic = - if call.sons[0].kind == nkSym and - call.sons[0].sym.kind in {skProc, skMethod, skConverter}: - result = call.sons[0].sym.magic - else: - result = mNone + # 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) - -proc transformArrayAccess(c: PTransf, n: PNode): PTransNode = + result.add(elseBranch) + +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])) - -proc getMergeOp(n: PNode): PSym = + 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.kind == skProc) and - (sfMerge in n.sons[0].sym.flags): - result = n.sons[0].sym - else: nil - -proc flattenTreeAux(d, a: PNode, op: PSym) = - var op2 = getMergeOp(a) + of nkCall, nkHiddenCallConv, nkCommand, nkInfix, nkPrefix, nkPostfix, + nkCallStrLit: + 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) - else: - addSon(d, copyTree(a)) - -proc flattenTree(root: PNode): PNode = - var op = getMergeOp(root) - if op != nil: + (op2.id == op.id or op.magic != mNone and op2.magic == op.magic): + for i in 1..<a.len: flattenTreeAux(d, a[i], op) + else: + 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: + else: result = root - -proc transformCall(c: PTransf, n: PNode): PTransNode = + +proc transformCall(c: PTransf, n: PNode): PNode = var n = flattenTree(n) - var op = getMergeOp(n) - if (op != nil) and (op.magic != mNone) and (sonsLen(n) >= 3): + 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 + if isConstExpr(a): + while (j < n.len): + let b = transform(c, n[j]) if not isConstExpr(b): break - a = evalOp(op.magic, n, a, b, nil) + 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 + 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: - result = methodCall(s).ptransNode + if s[0].kind == nkSym and s[0].sym.kind == skMethod: + when false: + let t = lastSon(s[0].sym.ast) + if t.kind != nkSym or sfDispatcher notin t.sym.flags: + methodDef(s[0].sym, false) + result = methodCall(s, c.graph.config) + else: + result = s + +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 = callCodegenProc(c.graph, "getCurrentException") + # -> (excType) + let convNode = newTransNode(nkHiddenSubConv, n[1].info, 2) + convNode[0] = newNodeI(nkEmpty, n.info) + convNode[1] = excCall + convNode.typ = excTypeNode.typ.toRef(c.idgen) + # -> let exc = ... + let identDefs = newTransNode(nkIdentDefs, n[1].info, 3) + 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] = transform(c, n[1]) + # Overwrite 'except' branch body with our stmtList. + result = newTransNode(nkExceptBranch, n[1].info, 2) + # Replace the `Exception as foobar` with just `Exception`. + result[0] = transform(c, n[0][1]) + result[1] = actions + else: + result = transformSons(c, n) + +proc commonOptimizations*(g: ModuleGraph; idgen: IdGenerator; c: PSym, n: PNode): PNode = + ## Merges adjacent constant expressions of the children of the `&` call into + ## a single constant expression. It also inlines constant expressions which are not + ## complex. + result = n + for i in 0..<n.safeLen: + result[i] = commonOptimizations(g, idgen, c, n[i]) + var op = getMergeOp(n) + if (op != nil) and (op.magic != mNone) and (n.len >= 3): + result = newNodeIT(nkCall, n.info, n.typ) + result.add(n[0]) + var args = newNode(nkArgList) + flattenTreeAux(args, n, op) + var j = 0 + while j < args.len: + var a = args[j] + inc(j) + if isConstExpr(a): + while j < args.len: + let b = args[j] + if not isConstExpr(b): break + a = evalOp(op.magic, result, a, b, nil, idgen, g) + inc(j) + result.add(a) + if result.len == 2: result = result[1] + else: + 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 = s.ptransNode + result = n -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, nkBracket} and - cnst.len != 0 +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): PTransNode = +proc transform(c: PTransf, n: PNode): PNode = + when false: + var oldDeferAnchor: PNode + if n.kind in {nkElifBranch, nkOfBranch, nkExceptBranch, nkElifExpr, + nkElseExpr, nkElse, nkForStmt, nkWhileStmt, nkFinally, + nkBlockStmt, nkBlockExpr}: + oldDeferAnchor = c.deferAnchor + c.deferAnchor = n case n.kind - of nkSym: + of nkSym: result = transformSym(c, n) - of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit: + 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: - when false: - if n.sons[genericParamsPos].kind == nkEmpty: - var s = n.sons[namePos].sym - n.sons[bodyPos] = PNode(transform(c, s.getBody)) - if s.ast.sons[bodyPos] != n.sons[bodyPos]: - # somehow this can happen ... :-/ - s.ast.sons[bodyPos] = n.sons[bodyPos] - #n.sons[bodyPos] = liftLambdas(s, n) - #if n.kind == nkMethodDef: methodDef(s, false) - result = PTransNode(n) + var s = n[namePos].sym + if n.typ != nil and s.typ.callConv == ccClosure: + result = transformSym(c, n[namePos]) + # use the same node as before if still a symbol: + if result.kind == nkSym: result = n + else: + 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) - of nkForStmt: - inc c.inLoop + result = n + of nkForStmt: result = transformFor(c, n) - dec c.inLoop of nkParForStmt: - inc c.inLoop result = transformSons(c, n) - dec c.inLoop - of nkCaseStmt: result = transformCase(c, n) + of nkCaseStmt: + result = transformCase(c, n) + of nkWhileStmt: result = transformWhile(c, n) + of nkBlockStmt, nkBlockExpr: + result = transformBlock(c, n) + of nkDefer: + c.deferDetected = true + result = transformSons(c, n) + when false: + let deferPart = newNodeI(nkFinally, n.info) + deferPart.add n[0] + let tryStmt = newNodeI(nkTryStmt, n.info) + if c.deferAnchor.isNil: + tryStmt.add c.root + c.root = tryStmt + result = tryStmt + else: + # modify the corresponding *action*, don't rely on nkStmtList: + tryStmt.add c.deferAnchor[^1] + c.deferAnchor[^1] = tryStmt + result = newTransNode(nkCommentStmt, n.info, 0) + 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 nkWhileStmt: - inc c.inLoop - result = newTransNode(n) - result[0] = transform(c, n.sons[0]) - result[1] = transformLoopBody(c, n.sons[1]) - dec c.inLoop - of nkCall, nkHiddenCallConv, nkCommand, nkInfix, nkPrefix, nkPostfix, - nkCallStrLit: + 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 nkHiddenStdConv, nkHiddenSubConv, nkConv: + 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: - 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: + 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: result = transformVarSection(c, n) else: result = transformSons(c, n) - of nkYieldStmt: - if c.inlining > 0: + of nkYieldStmt: + if c.inlining > 0 and not c.isIntroducingNewLocalVars: result = transformYield(c, n) - else: + else: result = transformSons(c, n) - of nkBlockStmt, nkBlockExpr: - result = transformBlock(c, n) + of nkAsgn: + result = transformAsgn(c, n) of nkIdentDefs, nkConstDef: - result = transformSons(c, n) + 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(): - pnode(result).comment = n.comment + if importantComments(c.graph.config): + 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: + 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) - var cnst = getConstExpr(c.module, PNode(result)) - # 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 + when false: + if oldDeferAnchor != nil: c.deferAnchor = oldDeferAnchor -proc processTransf(c: PTransf, n: PNode, owner: PSym): PNode = + # 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 # this step! We have to rely that the semantic pass transforms too errornous # nodes into an empty node. - if passes.skipCodegen(n) or c.fromCache or nfTransf in n.flags: return n + 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(module: PSym, filename: string): PTransf = - new(result) - result.contSyms = @[] - result.breakSyms = @[] - result.module = module +proc openTransf(g: ModuleGraph; module: PSym, filename: string; idgen: IdGenerator; flags: TransformFlags): PTransf = + result = PTransf(module: module, graph: g, idgen: idgen, flags: flags) -proc transformBody*(module: PSym, n: PNode, prc: PSym): PNode = - if nfTransf in n.flags or prc.kind in {skTemplate}: - result = n +proc flattenStmts(n: PNode) = + var goOn = true + while goOn: + goOn = false + var i = 0 + while i < n.len: + let it = n[i] + if it.kind in {nkStmtList, nkStmtListExpr}: + n.sons[i..i] = it.sons[0..<it.len] + goOn = true + inc i + +proc liftDeferAux(n: PNode) = + if n.kind in {nkStmtList, nkStmtListExpr}: + flattenStmts(n) + var goOn = true + while goOn: + goOn = false + let last = n.len-1 + for i in 0..last: + 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.add body + tryStmt.add deferPart + n[i] = tryStmt + n.sons.setLen(i+1) + n.typ = tryStmt.typ + goOn = true + break + for i in 0..n.safeLen-1: + liftDeferAux(n[i]) + +template liftDefer(c, root) = + if c.deferDetected: + liftDeferAux(root) + +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: - #when useEffectSystem: trackProc(prc, n) - var c = openTransf(module, "") - result = processTransf(c, n, prc) - if prc.kind != skMacro: - # XXX no closures yet for macros: - result = liftLambdas(prc, result) - if prc.kind == skIterator and prc.typ.callConv == ccClosure: - result = lambdalifting.liftIterator(prc, result) + 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 = liftLocalsIfRequested(prc, result, g.cache, g.config, c.idgen) + + if prc.isIterator: + result = g.transformClosureIterator(c.idgen, prc, result) + incl(result.flags, nfTransf) - when useEffectSystem: trackProc(prc, result) -proc transformStmt*(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(module, "") + var c = openTransf(g, module, "", idgen, flags) result = processTransf(c, n, module) - result = liftLambdasForTopLevel(module, result) + liftDefer(c, result) + #result = liftLambdasForTopLevel(module, result) incl(result.flags, nfTransf) -proc transformExpr*(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(module, "") + var c = openTransf(g, module, "", idgen, flags) result = processTransf(c, n, module) + liftDefer(c, result) + # expressions are not to be injected with destructor calls as that + # 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 ab5c97a19..41b54eb09 100644 --- a/compiler/trees.nim +++ b/compiler/trees.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -9,146 +9,178 @@ # tree helper routines -import - ast, astalgo, lexer, msgs, strutils, wordrecg +import + ast, wordrecg, idents -proc hasSon(father, son: PNode): bool = - for i in countup(0, sonsLen(father) - 1): - if father.sons[i] == son: - return true +proc cyclicTreeAux(n: PNode, visited: var seq[PNode]): bool = result = false - -proc cyclicTreeAux(n, s: PNode): bool = - if n == nil: - return false - if hasSon(s, n): - return true - var m = sonsLen(s) - addSon(s, n) - if not (n.kind in {nkEmpty..nkNilLit}): - for i in countup(0, sonsLen(n) - 1): - if cyclicTreeAux(n.sons[i], s): - return true - result = false - delSon(s, m) - -proc cyclicTree*(n: PNode): bool = - var s = newNodeI(nkEmpty, n.info) - result = cyclicTreeAux(n, s) - -proc ExprStructuralEquivalent*(a, b: PNode): bool = - result = false - if a == b: + if n == nil: return + for v in visited: + if v == n: return true + if not (n.kind in {nkEmpty..nkNilLit}): + visited.add(n) + for nSon in n.sons: + if cyclicTreeAux(nSon, visited): return true + discard visited.pop() + +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 - elif (a != nil) and (b != nil) and (a.kind == b.kind): + elif (a != nil) and (b != nil) and (a.kind == b.kind): case a.kind - of nkSym: - # don't go nuts here: same symbol as string is enough: - result = a.sym.name.id == b.sym.name.id + of nkSym: + if strictSymEquality: + result = a.sym == b.sym + else: + # don't go nuts here: same symbol as string is enough: + result = a.sym.name.id == b.sym.name.id of nkIdent: result = a.ident.id == b.ident.id - of nkCharLit..nkInt64Lit: result = a.intVal == b.intVal - of nkFloatLit..nkFloat64Lit: result = a.floatVal == b.floatVal + of nkCharLit..nkUInt64Lit: result = a.intVal == b.intVal + 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]): return + else: + if a.len == b.len: + for i in 0..<a.len: + if not exprStructuralEquivalent(a[i], b[i], + strictSymEquality): return result = true - -proc sameTree*(a, b: PNode): bool = + else: + result = false + else: + result = false + +proc sameTree*(a, b: PNode): bool = result = false - if a == b: + if a == b: result = true - elif (a != nil) and (b != nil) and (a.kind == b.kind): - if a.flags != b.flags: return - if a.info.line != b.info.line: return - if a.info.col != b.info.col: + elif a != nil and b != nil and a.kind == b.kind: + if a.flags != b.flags: return + if a.info.line != b.info.line: return + if a.info.col != b.info.col: return #if a.info.fileIndex <> b.info.fileIndex then exit; case a.kind - of nkSym: + of nkSym: # don't go nuts here: same symbol as string is enough: result = a.sym.name.id == b.sym.name.id of nkIdent: result = a.ident.id == b.ident.id - of nkCharLit..nkInt64Lit: result = a.intVal == b.intVal - of nkFloatLit..nkFloat64Lit: result = a.floatVal == b.floatVal + of nkCharLit..nkUInt64Lit: result = a.intVal == b.intVal + 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 + else: + if a.len == b.len: + for i in 0..<a.len: + if not sameTree(a[i], b[i]): return result = true - -proc getProcSym*(call: PNode): PSym = - result = call.sons[0].sym - -proc getOpSym*(op: PNode): PSym = - if not (op.kind in {nkCall, nkHiddenCallConv, nkCommand, nkCallStrLit}): - result = nil - else: - if (sonsLen(op) <= 0): InternalError(op.info, "getOpSym") - elif op.sons[0].Kind == nkSym: result = op.sons[0].sym - else: result = nil - -proc getMagic*(op: PNode): TMagic = + +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 - -proc TreeToSym*(t: PNode): PSym = - result = t.sym -proc isConstExpr*(n: PNode): bool = - result = (n.kind in - {nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, - nkFloatLit..nkFloat64Lit, nkNilLit}) or (nfAllConst in n.flags) +proc isConstExpr*(n: PNode): bool = + const atomKinds = {nkCharLit..nkNilLit} # Char, Int, UInt, Str, Float and Nil literals + n.kind in atomKinds or nfAllConst in n.flags -proc isDeepConstExpr*(n: PNode): bool = +proc isCaseObj*(n: PNode): bool = + result = false + if n.kind == nkRecCase: return true + for i in 0..<n.safeLen: + if n[i].isCaseObj: return true + +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]) - of nkCurly, nkBracket, nkPar, nkObjConstr, nkClosure: - for i in 0 .. <n.len: - if not isDeepConstExpr(n.sons[i]): return false - result = true - else: nil - -proc flattenTreeAux(d, a: PNode, op: TMagic) = - if (getMagic(a) == op): # a is a "leaf", so add it: - for i in countup(1, sonsLen(a) - 1): # BUGFIX - flattenTreeAux(d, a.sons[i], op) - else: - addSon(d, copyTree(a)) - -proc flattenTree*(root: PNode, op: TMagic): PNode = - result = copyNode(root) - if (getMagic(root) == op): - # BUGFIX: forget to copy prc - addSon(result, copyNode(root.sons[0])) - flattenTreeAux(result, root, op) - -proc SwapOperands*(op: PNode) = - var tmp = op.sons[1] - op.sons[1] = op.sons[2] - op.sons[2] = tmp - -proc IsRange*(n: PNode): bool {.inline.} = - if n.kind == nkInfix: - if n[0].kind == nkIdent and n[0].ident.id == ord(wDotDot) or - n[0].kind in {nkClosedSymChoice, nkOpenSymChoice} and - n[0][1].sym.name.id == ord(wDotDot): + 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[i], preventInheritance): return false + if n.typ.isNil: result = true + else: + 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: result = false + +proc isRange*(n: PNode): bool {.inline.} = + if n.kind in nkCallKinds: + let callee = n[0] + if (callee.kind == nkIdent and callee.ident.id == ord(wDotDot)) or + (callee.kind == nkSym and callee.sym.name.id == ord(wDotDot)) or + (callee.kind in {nkClosedSymChoice, nkOpenSymChoice} and + callee[1].sym.name.id == ord(wDotDot)): result = true - -proc whichPragma*(n: PNode): TSpecialWord = - let key = if n.kind == nkExprColonExpr: n.sons[0] else: n - if key.kind == nkIdent: result = whichKeyword(key.ident) + else: + result = false + else: + result = false + +proc whichPragma*(n: PNode): TSpecialWord = + let key = if n.kind in nkPragmaCallKinds and n.len > 0: n[0] else: n + case key.kind + of nkIdent: result = whichKeyword(key.ident) + of nkSym: result = whichKeyword(key.sym.name) + of nkCast: 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: @@ -157,12 +189,50 @@ proc unnestStmts(n, result: PNode) = result.add(n) proc flattenStmts*(n: PNode): PNode = - ## flattens a nested statement list; used for pattern matching 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 75e3fd20a..6685c4a89 100644 --- a/compiler/treetab.nim +++ b/compiler/treetab.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2012 Andreas Rumpf # # See the file "copying.txt", included in this @@ -9,35 +9,43 @@ # Implements a table from trees to trees. Does structural equivalence checking. -import - hashes, ast, astalgo, types +import ast, astalgo, types -proc hashTree(n: PNode): THash = - 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: - nil - of nkIdent: + of nkEmpty, nkNilLit, nkType: + discard + of nkIdent: result = result !& n.ident.h of nkSym: - result = result !& n.sym.name.h - of nkCharLit..nkUInt64Lit: - if (n.intVal >= low(int)) and (n.intVal <= high(int)): + result = result !& n.sym.id + of nkCharLit..nkUInt64Lit: + if (n.intVal >= low(int)) and (n.intVal <= high(int)): result = result !& int(n.intVal) of nkFloatLit..nkFloat64Lit: - if (n.floatVal >= - 1000000.0) and (n.floatVal <= 1000000.0): + if (n.floatVal >= - 1000000.0) and (n.floatVal <= 1000000.0): result = result !& toInt(n.floatVal) - of nkStrLit..nkTripleStrLit: + of nkStrLit..nkTripleStrLit: result = result !& hash(n.strVal) - else: - for i in countup(0, sonsLen(n) - 1): - result = result !& hashTree(n.sons[i]) - -proc TreesEquivalent(a, b: PNode): bool = - if a == b: + else: + 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: result = true - elif (a != nil) and (b != nil) and (a.kind == b.kind): + elif (a != nil) and (b != nil) and (a.kind == b.kind): case a.kind of nkEmpty, nkNilLit, nkType: result = true of nkSym: result = a.sym.id == b.sym.id @@ -45,66 +53,68 @@ proc TreesEquivalent(a, b: PNode): bool = of nkCharLit..nkUInt64Lit: result = a.intVal == b.intVal 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 + else: + 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) - -proc NodeTableRawGet(t: TNodeTable, k: THash, key: PNode): int = - var h: THash = k and high(t.data) - while t.data[h].key != nil: - if (t.data[h].h == k) and TreesEquivalent(t.data[h].key, key): + else: + result = false + +proc nodeTableRawGet(t: TNodeTable, k: Hash, key: PNode): int = + var h: Hash = k and high(t.data) + while t.data[h].key != nil: + if (t.data[h].h == k) and treesEquivalent(t.data[h].key, key): return h h = nextTry(h, high(t.data)) result = -1 -proc NodeTableGet*(t: TNodeTable, key: PNode): int = - var index = NodeTableRawGet(t, hashTree(key), key) +proc nodeTableGet*(t: TNodeTable, key: PNode): int = + var index = nodeTableRawGet(t, hashTree(key), key) if index >= 0: result = t.data[index].val else: result = low(int) - -proc NodeTableRawInsert(data: var TNodePairSeq, k: THash, key: PNode, - val: int) = - var h: THash = k and high(data) + +proc nodeTableRawInsert(data: var TNodePairSeq, k: Hash, key: PNode, + val: int) = + var h: Hash = k and high(data) while data[h].key != nil: h = nextTry(h, high(data)) assert(data[h].key == nil) data[h].h = k data[h].key = key data[h].val = val -proc NodeTablePut*(t: var TNodeTable, key: PNode, val: int) = - var n: TNodePairSeq - var k: THash = hashTree(key) - var index = NodeTableRawGet(t, k, key) - if index >= 0: +proc nodeTablePut*(t: var TNodeTable, key: PNode, val: int) = + 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 t.data[i].key != nil: - NodeTableRawInsert(n, t.data[i].h, t.data[i].key, t.data[i].val) - swap(t.data, n) - NodeTableRawInsert(t.data, k, key, val) + else: + 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) + 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: THash = hashTree(key) - var index = NodeTableRawGet(t, k, key) - if index >= 0: +proc nodeTableTestOrSet*(t: var TNodeTable, key: PNode, val: int): int = + 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 t.data[i].key != nil: - NodeTableRawInsert(n, t.data[i].h, t.data[i].key, t.data[i].val) - swap(t.data, n) - NodeTableRawInsert(t.data, k, key, val) + else: + 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) + 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 3096b73c8..a441b0ea2 100644 --- a/compiler/types.nim +++ b/compiler/types.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2013 Andreas Rumpf # # See the file "copying.txt", included in this @@ -9,31 +9,72 @@ # this module contains routines for accessing and iterating over types -import - intsets, ast, astalgo, trees, msgs, strutils, platform - -proc firstOrd*(t: PType): biggestInt -proc lastOrd*(t: PType): biggestInt -proc lengthOrd*(t: PType): biggestInt -type - TPreferedDesc* = enum - preferName, preferDesc, preferExported - -proc TypeToString*(typ: PType, prefer: TPreferedDesc = preferName): string -proc getProcHeader*(sym: PSym): string -proc base*(t: PType): PType - # ------------------- type iterator: ---------------------------------------- -type - TTypeIter* = proc (t: PType, closure: PObject): bool {.nimcall.} # true if iteration should stop - TTypeMutator* = proc (t: PType, closure: PObject): PType {.nimcall.} # copy t and mutate it +import + 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, # 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 + +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 TTypePredicate* = proc (t: PType): bool {.nimcall.} -proc IterOverType*(t: PType, iter: TTypeIter, closure: PObject): bool - # Returns result of `iter`. -proc mutateType*(t: PType, iter: TTypeMutator, closure: PObject): PType +proc iterOverType*(t: PType, iter: TTypeIter, closure: RootRef): bool # Returns result of `iter`. -type +type TParamsEquality* = enum # they are equal, but their # identifiers or their return # type differ (i.e. they cannot be @@ -45,569 +86,924 @@ type proc equalParams*(a, b: PNode): TParamsEquality # returns whether the parameter lists of the procs a, b are exactly the same -proc isOrdinalType*(t: PType): bool -proc enumHasHoles*(t: PType): bool -const + +const + # TODO: Remove tyTypeDesc from each abstractX and (where necessary) + # replace with typedescX abstractPtrs* = {tyVar, tyPtr, tyRef, tyGenericInst, tyDistinct, tyOrdinal, - tyConst, tyMutable, tyTypeDesc} - abstractVar* = {tyVar, tyGenericInst, tyDistinct, tyOrdinal, - tyConst, tyMutable, tyTypeDesc} - abstractRange* = {tyGenericInst, tyRange, tyDistinct, tyOrdinal, - tyConst, tyMutable, tyTypeDesc} - abstractVarRange* = {tyGenericInst, tyRange, tyVar, tyDistinct, tyOrdinal, - tyConst, tyMutable, tyTypeDesc} - abstractInst* = {tyGenericInst, tyDistinct, tyConst, tyMutable, tyOrdinal, - tyTypeDesc} - - skipPtrs* = {tyVar, tyPtr, tyRef, tyGenericInst, tyConst, tyMutable, - tyTypeDesc} + tyTypeDesc, tyAlias, tyInferred, tySink, tyLent, tyOwned} + abstractVar* = {tyVar, tyGenericInst, tyDistinct, tyOrdinal, tyTypeDesc, + tyAlias, tyInferred, tySink, tyLent, tyOwned} + abstractRange* = {tyGenericInst, tyRange, tyDistinct, tyOrdinal, tyTypeDesc, + tyAlias, tyInferred, tySink, tyOwned} + abstractInstOwned* = abstractInst + {tyOwned} + skipPtrs* = {tyVar, tyPtr, tyRef, tyGenericInst, tyTypeDesc, tyAlias, + tyInferred, tySink, tyLent, tyOwned} + # typedescX is used if we're sure tyTypeDesc should be included (or skipped) typedescPtrs* = abstractPtrs + {tyTypeDesc} - typedescInst* = abstractInst + {tyTypeDesc} - -proc skipTypes*(t: PType, kinds: TTypeKinds): PType -proc containsObject*(t: PType): bool -proc containsGarbageCollectedRef*(typ: PType): bool -proc containsHiddenPointer*(typ: PType): bool -proc canFormAcycle*(typ: PType): bool -proc isCompatibleToCString*(a: PType): bool -proc getOrdValue*(n: PNode): biggestInt -proc computeSize*(typ: PType): biggestInt -proc getSize*(typ: PType): biggestInt -proc isPureObject*(typ: PType): bool -proc InvalidGenericInst*(f: PType): bool - # for debugging -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 + typedescInst* = abstractInst + {tyTypeDesc, tyOwned, tyUserTypeClass} -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. -proc typeAllowed*(t: PType, kind: TSymKind): bool -# implementation +proc invalidGenericInst*(f: PType): bool = + result = f.kind == tyGenericInst and skipModifier(f) == nil -proc InvalidGenericInst(f: PType): bool = - result = (f.kind == tyGenericInst) and (lastSon(f) == nil) - -proc isPureObject(typ: PType): bool = +proc isPureObject*(typ: PType): bool = var t = typ - while t.kind == tyObject and t.sons[0] != nil: t = t.sons[0] + 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..nkInt64Lit: 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) - result = 0 + 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 -proc isCompatibleToCString(a: PType): bool = - if a.kind == tyArray: - if (firstOrd(a.sons[0]) == 0) and - (skipTypes(a.sons[0], {tyRange, tyConst, - tyMutable, tyGenericInst}).kind in - {tyInt..tyInt64, tyUInt..tyUInt64}) and - (a.sons[1].kind == tyChar): - result = true - -proc getProcHeader(sym: PSym): string = - result = sym.owner.name.s & '.' & sym.name.s & '(' - var n = sym.typ.n - for i in countup(1, sonsLen(n) - 1): - var p = n.sons[i] - if p.kind == nkSym: - add(result, p.sym.name.s) - add(result, ": ") - add(result, typeToString(p.sym.typ)) - if i != sonsLen(n)-1: add(result, ", ") - else: - InternalError("getProcHeader") - add(result, ')') - if n.sons[0].typ != nil: result.add(": " & typeToString(n.sons[0].typ)) - -proc elemType*(t: PType): PType = +proc isFloatLit*(t: PType): bool {.inline.} = + result = t.kind == tyFloat and t.n != nil and t.n.kind == nkFloatLit + +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: result = elemType(lastSon(t)) - of tyArray, tyArrayConstr: result = t.sons[1] - else: result = t.sons[0] + 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 skipGeneric(t: PType): PType = - result = t - while result.kind == tyGenericInst: result = lastSon(result) - -proc skipTypes(t: PType, kinds: TTypeKinds): PType = - result = t - while result.kind in kinds: result = lastSon(result) - -proc isOrdinalType(t: PType): bool = +proc enumHasHoles*(t: PType): bool = + 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) - # caution: uint, uint64 are no ordinal types! - result = t.Kind in {tyChar,tyInt..tyInt64,tyUInt8..tyUInt32,tyBool,tyEnum} or - (t.Kind in {tyRange, tyOrdinal, tyConst, tyMutable, tyGenericInst}) and - isOrdinalType(t.sons[0]) - -proc enumHasHoles(t: PType): bool = - var b = t - while b.kind in {tyConst, tyMutable, tyRange, tyGenericInst}: b = b.sons[0] - result = b.Kind == tyEnum and tfEnumHasHoles in b.flags - -proc iterOverTypeAux(marker: var TIntSet, t: PType, iter: TTypeIter, - closure: PObject): bool -proc iterOverNode(marker: var TIntSet, n: PNode, iter: TTypeIter, - closure: PObject): bool = - if n != 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, + closure: RootRef): bool = + if n != nil: case n.kind - of nkNone..nkNilLit: + of nkNone..nkNilLit: # 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) - if result: return - -proc iterOverTypeAux(marker: var TIntSet, t: PType, iter: TTypeIter, - closure: PObject): bool = + else: + result = iterOverTypeAux(marker, n.typ, iter, closure) + if result: return + for i in 0..<n.len: + result = iterOverNode(marker, n[i], iter, closure) + if result: return + else: + result = false + +proc iterOverTypeAux(marker: var IntSet, t: PType, iter: TTypeIter, + closure: RootRef): bool = result = false - if t == nil: return + if t == nil: return result = iter(t, closure) - if result: return - if not ContainsOrIncl(marker, t.id): + if result: return + if not containsOrIncl(marker, t.id): case t.kind - of tyGenericInst, tyGenericBody: - result = iterOverTypeAux(marker, lastSon(t), iter, closure) - else: - for i in countup(0, sonsLen(t) - 1): - result = iterOverTypeAux(marker, t.sons[i], iter, closure) - if result: return - if t.n != nil: result = iterOverNode(marker, t.n, iter, closure) - -proc IterOverType(t: PType, iter: TTypeIter, closure: PObject): bool = - var marker = InitIntSet() + 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 a in t.kids: + result = iterOverTypeAux(marker, a, iter, closure) + if result: return + if t.n != nil and t.kind != tyProc: result = iterOverNode(marker, t.n, iter, closure) + +proc iterOverType(t: PType, iter: TTypeIter, closure: RootRef): bool = + var marker = initIntSet() result = iterOverTypeAux(marker, t, iter, closure) -proc searchTypeForAux(t: PType, predicate: TTypePredicate, - marker: var TIntSet): bool +proc searchTypeForAux(t: PType, predicate: TTypePredicate, + marker: var IntSet): bool -proc searchTypeNodeForAux(n: PNode, p: TTypePredicate, - marker: var TIntSet): bool = +proc searchTypeNodeForAux(n: PNode, p: TTypePredicate, + marker: var IntSet): bool = result = false case n.kind - of nkRecList: - for i in countup(0, sonsLen(n) - 1): - result = searchTypeNodeForAux(n.sons[i], p, marker) - if result: return - of nkRecCase: - assert(n.sons[0].kind == nkSym) - result = searchTypeNodeForAux(n.sons[0], p, marker) - if result: return - for i in countup(1, sonsLen(n) - 1): - case n.sons[i].kind - of nkOfBranch, nkElse: - result = searchTypeNodeForAux(lastSon(n.sons[i]), p, marker) - if result: return - else: internalError("searchTypeNodeForAux(record case branch)") - of nkSym: + of nkRecList: + for i in 0..<n.len: + result = searchTypeNodeForAux(n[i], p, marker) + if result: return + of nkRecCase: + assert(n[0].kind == nkSym) + result = searchTypeNodeForAux(n[0], p, marker) + if result: return + for i in 1..<n.len: + case n[i].kind + of nkOfBranch, nkElse: + result = searchTypeNodeForAux(lastSon(n[i]), p, marker) + if result: return + else: discard + of nkSym: result = searchTypeForAux(n.sym.typ, p, marker) - else: internalError(n.info, "searchTypeNodeForAux()") - -proc searchTypeForAux(t: PType, predicate: TTypePredicate, - marker: var TIntSet): bool = + else: discard + +proc searchTypeForAux(t: PType, predicate: TTypePredicate, + marker: var IntSet): bool = # iterates over VALUE types! result = false - if t == nil: return - if ContainsOrIncl(marker, t.id): return - result = Predicate(t) - if result: return + if t == nil: return + if containsOrIncl(marker, t.id): return + result = predicate(t) + if result: return case t.kind - of tyObject: - result = searchTypeForAux(t.sons[0], predicate, marker) + of tyObject: + if t.baseClass != nil: + result = searchTypeForAux(t.baseClass.skipTypes(skipPtrs), predicate, marker) if not result: result = searchTypeNodeForAux(t.n, predicate, marker) - of tyGenericInst, tyDistinct: - result = searchTypeForAux(lastSon(t), predicate, marker) - of tyArray, tyArrayConstr, tySet, tyTuple: - for i in countup(0, sonsLen(t) - 1): - result = searchTypeForAux(t.sons[i], predicate, marker) - if result: return - else: - nil - -proc searchTypeFor(t: PType, predicate: TTypePredicate): bool = - var marker = InitIntSet() + of tyGenericInst, tyDistinct, tyAlias, tySink: + result = searchTypeForAux(skipModifier(t), predicate, marker) + of tyArray, tySet, tyTuple: + for a in t.kids: + result = searchTypeForAux(a, predicate, marker) + if result: return + else: + discard + +proc searchTypeFor*(t: PType, predicate: TTypePredicate): bool = + var marker = initIntSet() result = searchTypeForAux(t, predicate, marker) -proc isObjectPredicate(t: PType): bool = +proc isObjectPredicate(t: PType): bool = result = t.kind == tyObject -proc containsObject(t: PType): bool = +proc containsObject*(t: PType): bool = result = searchTypeFor(t, isObjectPredicate) -proc isObjectWithTypeFieldPredicate(t: PType): bool = - result = t.kind == tyObject and t.sons[0] == nil and - not (t.sym != nil and sfPure in t.sym.flags) and +proc isObjectWithTypeFieldPredicate(t: PType): bool = + result = t.kind == tyObject and t.baseClass == nil and + not (t.sym != nil and {sfPure, sfInfixCall} * t.sym.flags != {}) and tfFinal notin t.flags -proc analyseObjectWithTypeFieldAux(t: PType, - marker: var TIntSet): TTypeFieldResult = - var res: TTypeFieldResult +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 = result = frNone - if t == nil: return + if t == nil: return case t.kind - of tyObject: - if (t.n != nil): - if searchTypeNodeForAux(t.n, isObjectWithTypeFieldPredicate, marker): - return frEmbedded - for i in countup(0, sonsLen(t) - 1): - res = analyseObjectWithTypeFieldAux(t.sons[i], marker) - if res == frEmbedded: + of tyObject: + if t.n != nil: + if searchTypeNodeForAux(t.n, isObjectWithTypeFieldPredicate, marker): return frEmbedded - if res == frHeader: result = frHeader - if result == frNone: + 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, tyConst, tyMutable: - result = analyseObjectWithTypeFieldAux(lastSon(t), marker) - of tyArray, tyArrayConstr, tyTuple: - for i in countup(0, sonsLen(t) - 1): - res = analyseObjectWithTypeFieldAux(t.sons[i], marker) - if res != frNone: + of tyGenericInst, tyDistinct, tyAlias, tySink: + result = analyseObjectWithTypeFieldAux(skipModifier(t), marker) + of tyArray, tyTuple: + for a in t.kids: + let res = analyseObjectWithTypeFieldAux(a, marker) + if res != frNone: return frEmbedded - else: - nil + else: + discard -proc analyseObjectWithTypeField(t: PType): TTypeFieldResult = - var marker = InitIntSet() +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 = +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) -proc containsTyRef*(typ: PType): bool = +proc containsTyRef*(typ: PType): bool = # returns true if typ contains a 'ref' result = searchTypeFor(typ, isTyRef) -proc isHiddenPointer(t: PType): bool = - result = t.kind in {tyString, tySequence} +proc isHiddenPointer(t: PType): bool = + result = t.kind in {tyString, tySequence, tyOpenArray, tyVarargs} -proc containsHiddenPointer(typ: PType): bool = +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 TIntSet, typ: PType, startId: int): bool -proc canFormAcycleNode(marker: var TIntSet, 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: - nil - else: - for i in countup(0, sonsLen(n) - 1): - result = canFormAcycleNode(marker, n.sons[i], startId) - if result: return - -proc canFormAcycleAux(marker: var TIntSet, typ: PType, startId: int): bool = + if n != nil: + 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 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}) - if tfAcyclic in t.flags: return + if typ == nil: return + if tfAcyclic in typ.flags: return + var t = skipTypes(typ, abstractInst+{tyOwned}-{tyTypeDesc}) + if tfAcyclic in t.flags: return case t.kind - of tyTuple, tyObject, tyRef, tySequence, tyArray, tyArrayConstr, tyOpenArray, - tyVarargs: - if not ContainsOrIncl(marker, t.id): - for i in countup(0, sonsLen(t) - 1): - result = canFormAcycleAux(marker, t.sons[i], startId) - if result: return - if t.n != nil: result = canFormAcycleNode(marker, t.n, startId) - else: - result = t.id == 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(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! - #if t.kind == tyObject and tfFinal notin t.flags: - # # damn inheritance may introduce cycles: - # result = true + # er but we use it also for the write barrier ... + 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: nil + else: discard -proc canFormAcycle(typ: PType): bool = - var marker = InitIntSet() - result = canFormAcycleAux(marker, typ, typ.id) +proc isFinal*(t: PType): bool = + let t = t.skipTypes(abstractInst) + result = t.kind != tyObject or tfFinal in t.flags or isPureObject(t) -proc mutateTypeAux(marker: var TIntSet, t: PType, iter: TTypeMutator, - closure: PObject): PType -proc mutateNode(marker: var TIntSet, n: PNode, iter: TTypeMutator, - closure: PObject): 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 - else: - for i in countup(0, sonsLen(n) - 1): - addSon(result, mutateNode(marker, n.sons[i], iter, closure)) - -proc mutateTypeAux(marker: var TIntSet, t: PType, iter: TTypeMutator, - closure: PObject): 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 mutateType(t: PType, iter: TTypeMutator, closure: PObject): PType = - var marker = InitIntSet() - result = mutateTypeAux(marker, t, iter, closure) +proc canFormAcycle*(g: ModuleGraph, typ: PType): bool = + var marker = initIntSet() + let t = skipTypes(typ, abstractInst+{tyOwned}-{tyTypeDesc}) + result = canFormAcycleAux(g, marker, t, t, false, false) -proc ValueToString(a: PNode): string = +proc valueToString(a: PNode): string = case a.kind - of nkCharLit..nkUInt64Lit: result = $(a.intVal) - of nkFloatLit..nkFloat128Lit: result = $(a.floatVal) + 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 = +proc rangeToStr(n: PNode): string = assert(n.kind == nkRange) - result = ValueToString(n.sons[0]) & ".." & ValueToString(n.sons[1]) - -const - typeToStr: array[TTypeKind, string] = ["None", "bool", "Char", "empty", - "Array Constructor [$1]", "nil", "expr", "stmt", "typeDesc", - "GenericInvokation", "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", + result = valueToString(n[0]) & ".." & valueToString(n[1]) + +const + 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", "int", "int8", "int16", "int32", "int64", "float", "float32", "float64", "float128", "uint", "uint8", "uint16", "uint32", "uint64", - "bignum", "const ", - "!", "varargs[$1]", "iter[$1]", "Error Type", "TypeClass"] - -proc consToStr(t: PType): string = - if t.len > 0: result = t.typeToString - else: result = typeToStr[t.kind].strip - -proc constraintsToStr(t: PType): string = - let sep = if tfAny in t.flags: " or " else: " and " - result = "" - for i in countup(0, t.len - 1): - if i > 0: result.add(sep) - result.add(t.sons[i].consToStr) + "owned", "sink", + "lent ", "varargs[$1]", "UncheckedArray[$1]", "Error Type", + "BuiltInTypeClass", "UserTypeClass", + "UserTypeClassInst", "CompositeTypeClass", "inferred", + "and", "or", "not", "any", "static", "TypeFromExpr", "concept", # xxx bugfix + "void", "iterable"] + +const preferToResolveSymbols = {preferName, preferTypeName, preferModuleInfo, + preferGenericArg, preferResolved, preferMixed, preferInlayHint, preferInferredEffects} + +template bindConcreteTypeToUserTypeClass*(tc, concrete: PType) = + 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 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. +template isResolvedUserTypeClass*(t: PType): bool = + tfResolved in t.flags + +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 = + let preferToplevel = prefer + proc getPrefer(prefer: TPreferedDesc): TPreferedDesc = + if preferToplevel in {preferResolved, preferMixed}: + preferToplevel # sticky option + else: + 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) + result = typeToString(typ, prefer) -proc TypeToString(typ: PType, prefer: TPreferedDesc = preferName): string = - var t = typ - result = "" - if t == nil: return - if prefer == preferName and t.sym != nil and sfAnon notin t.sym.flags: - if t.kind == tyInt and isIntLit(t): - return t.sym.Name.s & " literal(" & $t.n.intVal & ")" - return t.sym.Name.s - case t.Kind +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] + 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 = "int literal(" & $t.n.intVal & ")" - of tyGenericBody, tyGenericInst, tyGenericInvokation: - result = typeToString(t.sons[0]) & '[' - for i in countup(1, sonsLen(t) -1 -ord(t.kind != tyGenericInvokation)): - if i > 1: add(result, ", ") - add(result, typeToString(t.sons[i])) - add(result, ']') - of tyTypeDesc: - if t.len == 0: result = "typedesc" - else: result = "typedesc[" & constraintsToStr(t) & "]" - of tyTypeClass: - case t.len - of 0: result = "typeclass[]" - of 1: result = "typeclass[" & consToStr(t.sons[0]) & "]" - else: result = constraintsToStr(t) - of tyExpr: - if t.len == 0: result = "expr" - else: result = "expr[" & constraintsToStr(t) & "]" - of tyArray: - if t.sons[0].kind == tyRange: - result = "array[" & rangeToStr(t.sons[0].n) & ", " & - typeToString(t.sons[1]) & ']' - else: - result = "array[" & typeToString(t.sons[0]) & ", " & - typeToString(t.sons[1]) & ']' - of tyArrayConstr: - result = "Array constructor[" & rangeToStr(t.sons[0].n) & ", " & - typeToString(t.sons[1]) & ']' - of tySequence: - result = "seq[" & typeToString(t.sons[0]) & ']' - 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], preferName) - of tyTuple: - # we iterate over t.sons here, because t.n may be nil - result = "tuple[" - 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) - add(result, t.n.sons[i].sym.name.s & ": " & typeToString(t.sons[i])) - if i < sonsLen(t.n) - 1: add(result, ", ") - else: - 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, tyMutable, tyConst: - result = typeToStr[t.kind] & typeToString(t.sons[0]) + 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: + 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: + if t.hasElementType: result = firstOrd(conf, skipModifier(t)) + else: + result = Zero + fatal(conf, unknownLineInfo, "invalid kind for firstOrd(" & $t.kind & ')') + of tyUncheckedArray, tyCstring: + result = Zero + else: + result = Zero + fatal(conf, unknownLineInfo, "invalid kind for firstOrd(" & $t.kind & ')') + +proc firstFloat*(t: PType): BiggestFloat = + case t.kind + of tyFloat..tyFloat128: -Inf of tyRange: - result = "range " & rangeToStr(t.n) - if prefer != preferExported: - result.add("(" & typeToString(t.sons[0]) & ")") - of tyProc: - result = if tfIterator in t.flags: "iterator (" else: "proc (" - for i in countup(1, sonsLen(t) - 1): - add(result, typeToString(t.sons[i])) - if i < sonsLen(t) - 1: add(result, ", ") - add(result, ')') - if t.sons[0] != nil: add(result, ": " & TypeToString(t.sons[0])) - var prag: string - if t.callConv != ccDefault: prag = CallingConvToStr[t.callConv] - else: prag = "" - if tfNoSideEffect in t.flags: - addSep(prag) - add(prag, "noSideEffect") - if tfThread in t.flags: - addSep(prag) - add(prag, "thread") - if len(prag) != 0: add(result, "{." & prag & ".}") - of tyVarargs, tyIter: - result = typeToStr[t.kind] % typeToString(t.sons[0]) - else: - result = typeToStr[t.kind] - if tfShared in t.flags: result = "shared " & result - if tfNotNil in t.flags: result.add(" not nil") - -proc resultType(t: PType): PType = - assert(t.kind == tyProc) - result = t.sons[0] # nil is allowed - -proc base(t: PType): PType = - result = t.sons[0] + assert(t.n != nil) # range directly given: + assert(t.n.kind == nkRange) + 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: + result = conf.targetSizeSignedToKind() + of tyUInt: + result = conf.targetSizeUnsignedToKind() + else: + result = k -proc firstOrd(t: PType): biggestInt = +proc lastOrd*(conf: ConfigRef; t: PType): Int128 = case t.kind - of tyBool, tyChar, tySequence, tyOpenArray, tyString, tyVarargs, tyProxy: - result = 0 - of tySet, tyVar: result = firstOrd(t.sons[0]) - of tyArray, tyArrayConstr: result = firstOrd(t.sons[0]) - of tyRange: + 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[0]) - of tyInt: - if platform.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(t.sons[0]) - else: - assert(t.n.sons[0].kind == nkSym) - result = t.n.sons[0].sym.position - of tyGenericInst, tyDistinct, tyConst, tyMutable, tyTypeDesc: - result = firstOrd(lastSon(t)) - else: - InternalError("invalid kind for first(" & $t.kind & ')') - result = 0 - -proc lastOrd(t: PType): biggestInt = + result = getOrdValue(t.n[1]) + of tyInt: + 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 = toInt128(0xFFFFFFFF) + else: + result = toInt128(0xFFFFFFFFFFFFFFFF'u64) + of tyUInt8: result = toInt128(0xFF) + of tyUInt16: result = toInt128(0xFFFF) + of tyUInt32: result = toInt128(0xFFFFFFFF) + of tyUInt64: + result = toInt128(0xFFFFFFFFFFFFFFFF'u64) + of tyEnum: + 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.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 tyBool: result = 1 - of tyChar: result = 255 - of tySet, tyVar: result = lastOrd(t.sons[0]) - of tyArray, tyArrayConstr: result = lastOrd(t.sons[0]) - of tyRange: + of tyFloat..tyFloat128: Inf + of tyVar: lastFloat(t.elementType) + of tyRange: assert(t.n != nil) # range directly given: assert(t.n.kind == nkRange) - result = getOrdValue(t.n.sons[1]) - of tyInt: - if platform.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 - of tyUInt: - if platform.intSize == 4: result = 0xFFFFFFFF - else: result = 0x7FFFFFFFFFFFFFFF'i64 - of tyUInt8: result = 0xFF - of tyUInt16: result = 0xFFFF - of tyUInt32: result = 0xFFFFFFFF - of tyUInt64: result = 0x7FFFFFFFFFFFFFFF'i64 - 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, tyConst, tyMutable, tyTypeDesc: - result = lastOrd(lastSon(t)) - of tyProxy: result = 0 - else: - InternalError("invalid kind for last(" & $t.kind & ')') - result = 0 - -proc lengthOrd(t: PType): biggestInt = + getFloatValue(t.n[1]) + of tyGenericInst, tyDistinct, tyTypeDesc, tyAlias, tySink, + tyStatic, tyInferred: + lastFloat(skipModifier(t)) + of tyUserTypeClasses: + lastFloat(last(t)) + else: + internalError(newPartialConfigRef(), "invalid kind for lastFloat(" & $t.kind & ')') + NaN + +proc floatRangeCheck*(x: BiggestFloat, t: PType): bool = case t.kind - of tyInt64, tyInt32, tyInt: result = lastOrd(t) - of tyDistinct, tyConst, tyMutable: result = lengthOrd(t.sons[0]) - else: result = lastOrd(t) - firstOrd(t) + 1 + # 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) + result = last - first + One # -------------- type equality ----------------------------------------------- type TDistinctCompare* = enum ## how distinct types are to be compared dcEq, ## a and b should be the same type - dcEqIgnoreDistinct, ## compare symetrically: (distinct a) == b, a == b + dcEqIgnoreDistinct, ## compare symmetrically: (distinct a) == b, a == b ## or a == (distinct b) dcEqOrDistinctOf ## a equals b or a is distinct of b TTypeCmpFlag* = enum - IgnoreTupleFields, - TypeDescExactMatch, + IgnoreTupleFields ## NOTE: Only set this flag for backends! + IgnoreCC + ExactTypeDescValues + ExactGenericParams + 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 @@ -616,137 +1012,141 @@ type proc initSameTypeClosure: TSameTypeClosure = # we do the initialization lazily for performance (avoids memory allocations) - nil + 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 -proc SameTypeOrNilAux(a, b: PType, c: var TSameTypeClosure): bool = +proc sameTypeAux(x, y: PType, c: var TSameTypeClosure): bool +proc sameTypeOrNilAux(a, b: PType, c: var TSameTypeClosure): bool = if a == b: result = true else: if a == nil or b == nil: result = false - else: result = SameTypeAux(a, b, c) + else: result = sameTypeAux(a, b, c) + +proc sameType*(a, b: PType, flags: TTypeCmpFlags = {}): bool = + var c = initSameTypeClosure() + c.flags = flags + result = sameTypeAux(a, b, c) -proc SameTypeOrNil*(a, b: PType, flags: TTypeCmpFlags = {}): bool = +proc sameTypeOrNil*(a, b: PType, flags: TTypeCmpFlags = {}): bool = if a == b: result = true - else: + else: if a == nil or b == nil: result = false - else: - var c = initSameTypeClosure() - c.flags = flags - result = SameTypeAux(a, b, c) - -proc equalParam(a, b: PSym): TParamsEquality = - if SameTypeOrNil(a.typ, b.typ, {TypeDescExactMatch}) and - ExprStructuralEquivalent(a.constraint, b.constraint): - if a.ast == b.ast: + else: result = sameType(a, b, flags) + +proc equalParam(a, b: PSym): TParamsEquality = + if sameTypeOrNil(a.typ, b.typ, {ExactTypeDescValues}) and + exprStructuralEquivalent(a.constraint, b.constraint): + if a.ast == b.ast: result = paramsEqual - elif a.ast != nil and b.ast != nil: - if ExprStructuralEquivalent(a.ast, b.ast): result = paramsEqual + elif a.ast != nil and b.ast != nil: + if exprStructuralEquivalent(a.ast, b.ast): result = paramsEqual else: result = paramsIncompatible - elif a.ast != nil: + elif a.ast != nil: result = paramsEqual - elif b.ast != nil: + elif b.ast != nil: result = paramsIncompatible + else: + result = paramsNotEqual else: result = paramsNotEqual - -proc equalParams(a, b: PNode): TParamsEquality = + +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: + if not exprStructuralEquivalent(a[i].sym.constraint, + b[i].sym.constraint): + return false + return true + +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 + else: + 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: + of paramsNotEqual: return paramsNotEqual - of paramsEqual: - nil - of paramsIncompatible: + of paramsEqual: + 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 # it stays incompatible - if not SameTypeOrNil(a.sons[0].typ, b.sons[0].typ, {TypeDescExactMatch}): - if (a.sons[0].typ == nil) or (b.sons[0].typ == nil): + if not sameTypeOrNil(a.typ, b.typ, {ExactTypeDescValues}): + if (a.typ == nil) or (b.typ == nil): result = paramsNotEqual # one proc has a result, the other not is OK - else: + else: result = paramsIncompatible # overloading by different # result types does not work - -proc SameLiteral(x, y: PNode): bool = - if x.kind == y.kind: - case x.kind - of nkCharLit..nkInt64Lit: result = x.intVal == y.intVal - of nkFloatLit..nkFloat64Lit: result = x.floatVal == y.floatVal - of nkNilLit: result = true - else: assert(false) - -proc SameRanges(a, b: PNode): bool = - result = SameLiteral(a.sons[0], b.sons[0]) and - SameLiteral(a.sons[1], b.sons[1]) -proc sameTuple(a, b: PType, c: var TSameTypeClosure): bool = +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}) - y = skipTypes(y, {tyRange}) - - result = SameTypeAux(x, y, c) - if not result: return + x = skipTypes(x, {tyRange, tyGenericInst, tyAlias}) + y = skipTypes(y, {tyRange, tyGenericInst, tyAlias}) + + 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): - # 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 + for i in 0..<a.n.len: + # check field names: + 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: InternalError(a.n.info, "sameTuple") + 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: stmt) {.immediate.} = +template ifFastObjectTypeCheckFailed(a, b: PType, body: untyped) = if tfFromGeneric notin a.flags + b.flags: # fast case: id comparison suffices: result = a.id == b.id else: # expensive structural equality test; however due to the way generic and # objects work, if one of the types does **not** contain tfFromGeneric, - # they cannot be equal. The check ``a.sym.Id == b.sym.Id`` checks - # for the same origin and is essential because we don't want "pure" + # they cannot be equal. The check ``a.sym.id == b.sym.id`` checks + # for the same origin and is essential because we don't want "pure" # structural type equivalence: # # type # TA[T] = object # TB[T] = object # --> TA[int] != TB[int] - if tfFromGeneric in a.flags * b.flags and a.sym.Id == b.sym.Id: + 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) - IfFastObjectTypeCheckFailed(a, b): + ifFastObjectTypeCheckFailed(a, b): var c = initSameTypeClosure() result = sameTypeAux(a, b, c) @@ -756,11 +1156,16 @@ proc sameDistinctTypes*(a, b: PType): bool {.inline.} = proc sameEnumTypes*(a, b: PType): bool {.inline.} = result = a.id == b.id -proc SameObjectTree(a, b: PNode, c: var TSameTypeClosure): bool = +proc sameObjectTree(a, b: PNode, c: var TSameTypeClosure): bool = if a == b: result = true - elif (a != nil) and (b != nil) and (a.kind == b.kind): - if sameTypeOrNilAux(a.typ, b.typ, c): + elif a != nil and b != nil and a.kind == b.kind: + var x = a.typ + var y = b.typ + if IgnoreTupleFields in c.flags: + if x != nil: x = skipTypes(x, {tyRange, tyGenericInst, tyAlias}) + if y != nil: y = skipTypes(y, {tyRange, tyGenericInst, tyAlias}) + if sameTypeOrNilAux(x, y, c): case a.kind of nkSym: # same symbol as string is enough: @@ -771,109 +1176,231 @@ 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) - if not result: return + 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.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.skipModifier else: t -proc SameTypeAux(x, y: PType, c: var TSameTypeClosure): bool = - template CycleCheck() = +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 # again: Since the recursion check is only to not get caught in an endless - # recursion, we use a counter and only if it's value is over some + # recursion, we use a counter and only if it's value is over some # threshold we perform the expensive exact cycle check: if c.recCheck < 3: 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 - proc sameFlags(a, b: PType): bool {.inline.} = - result = eqTypeFlags*a.flags == eqTypeFlags*b.flags - if x == y: return true - var a = skipTypes(x, {tyGenericInst}) - var b = skipTypes(y, {tyGenericInst}) + 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 a.Kind - of tyEmpty, tyChar, tyBool, tyNil, tyPointer, tyString, tyCString, - tyInt..tyBigNum, tyStmt: + 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 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 or rhs.kidsLen != lhs.kidsLen: + 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, tyTyped, tyUntyped, tyVoid: result = sameFlags(a, b) - of tyExpr: - result = ExprStructuralEquivalent(a.n, b.n) and 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 sameTupleLengths(a, b) and a.hasElementType: + cycleCheck() + 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: result = sameDistinctTypes(a, b) and sameFlags(a, b) - else: result = sameTypeAux(a.sons[0], b.sons[0], c) and sameFlags(a, b) - of tyEnum, tyForward, tyProxy: + cycleCheck() + if c.cmp == dcEq: + if sameFlags(a, b): + ifFastObjectTypeCheckFailed(a, b): + result = sameTypeAux(a.elementType, b.elementType, c) + else: + 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) - of tyGenericInst: - result = sameTypeAux(lastSon(a), lastSon(b), c) + withoutShallowFlags: + cycleCheck() + result = sameTuple(a, b, c) and sameFlags(a, b) of tyTypeDesc: if c.cmp == dcEqIgnoreDistinct: result = false - elif TypeDescExactMatch in c.flags: - CycleCheck() + elif ExactTypeDescValues in c.flags: + cycleCheck() result = sameChildrenAux(x, y, c) and sameFlags(a, b) else: result = sameFlags(a, b) - of tyGenericParam, tyGenericInvokation, tyGenericBody, tySequence, - tyOpenArray, tySet, tyRef, tyPtr, tyVar, tyArrayConstr, - tyArray, tyProc, tyConst, tyMutable, tyVarargs, tyIter, - tyOrdinal, tyTypeClass: - CycleCheck() + of tyGenericParam: result = sameChildrenAux(a, b, c) and sameFlags(a, b) - if result and (a.kind == tyProc): - result = a.callConv == b.callConv + if result and {ExactGenericParams, ExactTypeDescValues} * c.flags != {}: + result = a.sym.position == b.sym.position + 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 + withoutShallowFlags: + result = sameChildrenAux(a, b, c) + if result and IgnoreFlags notin c.flags: + if IgnoreTupleFields in c.flags: + result = a.flags * {tfVarIsPtr, tfIsOutParam} == b.flags * {tfVarIsPtr, tfIsOutParam} + else: + result = sameFlags(a, b) + if result and ExactGcSafety in c.flags: + result = a.flags * {tfThread} == b.flags * {tfThread} + if result and a.kind == tyProc: + result = ((IgnoreCC in c.flags) or a.callConv == b.callConv) and + ((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]) + cycleCheck() + 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.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 tyConcept: + result = exprStructuralEquivalent(a.n, b.n) -proc sameType*(x, y: PType): bool = +proc sameBackendType*(x, y: PType): bool = var c = initSameTypeClosure() + c.flags.incl IgnoreTupleFields + c.cmp = dcEqIgnoreDistinct result = sameTypeAux(x, y, c) -proc sameBackendType*(x, y: PType): bool = +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 = @@ -881,32 +1408,36 @@ proc compareTypes*(x, y: PType, var c = initSameTypeClosure() c.cmp = cmp c.flags = flags - result = sameTypeAux(x, y, c) - -proc inheritanceDiff*(a, b: PType): int = + if x == y: result = true + elif x.isNil or y.isNil: result = false + else: result = sameTypeAux(x, y, c) + +proc inheritanceDiff*(a, b: PType): int = # | returns: 0 iff `a` == `b` # | returns: -x iff `a` is the x'th direct superclass of `b` # | returns: +x iff `a` is the x'th direct subclass of `b` # | returns: `maxint` iff `a` and `b` are not compatible at all - assert a.kind == tyObject - assert b.kind == tyObject + if a == b or a.kind == tyError or b.kind == tyError: return 0 + 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] + if sameObjectTypes(x, b): return + 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] + if sameObjectTypes(y, a): return + 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 @@ -919,333 +1450,92 @@ 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 y = skipTypes(y, skipPtrs) - if ancestors.contains(y.id): return y - y = y.sons[0] + if ancestors.contains(y.id): + # bug #7818, defer the previous skipTypes + if t.kind != tyGenericInst: t = y + return t + y = y.baseClass -proc typeAllowedAux(marker: var TIntSet, typ: PType, kind: TSymKind): bool -proc typeAllowedNode(marker: var TIntSet, n: PNode, kind: TSymKind): bool = - result = true - if n != nil: - result = typeAllowedAux(marker, n.typ, kind) - #if not result: debug(n.typ) - if result: - case n.kind - of nkNone..nkNilLit: - nil - else: - for i in countup(0, sonsLen(n) - 1): - result = typeAllowedNode(marker, n.sons[i], kind) - if not result: break +proc lacksMTypeField*(typ: PType): bool {.inline.} = + (typ.sym != nil and sfPure in typ.sym.flags) or tfFinal in typ.flags -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 +include sizealignoffsetimpl -proc isGenericAlias*(t: PType): bool = - return t.kind == tyGenericInst and t.lastSon.kind == tyGenericInst +proc computeSize*(conf: ConfigRef; typ: PType): BiggestInt = + computeSizeAlign(conf, typ) + result = typ.size -proc skipGenericAlias*(t: PType): PType = - return if t.isGenericAlias: t.lastSon else: t - -proc matchTypeClass*(bindings: var TIdTable, typeClass, t: PType): bool = - for i in countup(0, typeClass.sonsLen - 1): - let req = typeClass.sons[i] - var match = req.kind == skipTypes(t, {tyRange, tyGenericInst}).kind - - if not match: - case req.kind - of tyGenericBody: - if t.kind == tyGenericInst and t.sons[0] == req: - match = true - IdTablePut(bindings, typeClass, t) - of tyTypeClass: - match = matchTypeClass(bindings, req, t) - else: nil - elif t.kind in {tyObject} and req.len != 0: - # empty 'object' is fine as constraint in a type class - match = sameType(t, req) - - if tfAny in typeClass.flags: - if match: return true - else: - if not match: return false +proc getReturnType*(s: PSym): PType = + # Obtains the return type of a iterator/proc/macro/template + assert s.kind in skProcKinds + result = s.typ.returnType - # if the loop finished without returning, either all constraints matched - # or none of them matched. - result = if tfAny in typeClass.flags: false else: true +proc getAlign*(conf: ConfigRef; typ: PType): BiggestInt = + computeSizeAlign(conf, typ) + result = typ.align -proc matchTypeClass*(typeClass, typ: PType): bool = - var bindings: TIdTable - initIdTable(bindings) - result = matchTypeClass(bindings, typeClass, typ) +proc getSize*(conf: ConfigRef; typ: PType): BiggestInt = + computeSizeAlign(conf, typ) + result = typ.size -proc typeAllowedAux(marker: var TIntSet, typ: PType, kind: TSymKind): bool = - assert(kind in {skVar, skLet, skConst, skParam, skResult}) - # if we have already checked the type, return true, because we stop the - # evaluation if something is wrong: - result = true - if typ == nil: return - if ContainsOrIncl(marker, typ.id): return - var t = skipTypes(typ, abstractInst-{tyTypeDesc}) +proc containsGenericTypeIter(t: PType, closure: RootRef): bool = case t.kind - of tyVar: - if kind == skConst: return false - var t2 = skipTypes(t.sons[0], abstractInst-{tyTypeDesc}) - case t2.kind - of tyVar: - result = false # ``var var`` is always an invalid type: - of tyOpenArray: - result = kind == skParam and typeAllowedAux(marker, t2, kind) - else: - result = kind in {skParam, skResult} and typeAllowedAux(marker, t2, kind) - of tyProc: - for i in countup(1, sonsLen(t) - 1): - result = typeAllowedAux(marker, t.sons[i], skParam) - if not result: break - if result and t.sons[0] != nil: - result = typeAllowedAux(marker, t.sons[0], skResult) - of tyExpr, tyStmt, tyTypeDesc: - result = true - # XXX er ... no? these should not be allowed! - of tyTypeClass: - result = true - of tyGenericBody, tyGenericParam, tyForward, tyNone, tyGenericInvokation: - result = false - of tyEmpty, tyNil: - result = kind == skConst - of tyString, tyBool, tyChar, tyEnum, tyInt..tyBigNum, tyCString, tyPointer: - result = true - of tyOrdinal: - result = kind == skParam - of tyGenericInst, tyDistinct: - result = typeAllowedAux(marker, lastSon(t), kind) - of tyRange: - result = skipTypes(t.sons[0], abstractInst-{tyTypeDesc}).kind in - {tyChar, tyEnum, tyInt..tyFloat128} - of tyOpenArray, tyVarargs: - result = (kind == skParam) and typeAllowedAux(marker, t.sons[0], skVar) - of tySequence: - result = t.sons[0].kind == tyEmpty or - typeAllowedAux(marker, t.sons[0], skVar) - of tyArray: - result = t.sons[1].kind == tyEmpty or - typeAllowedAux(marker, t.sons[1], skVar) - of tyRef: - if kind == skConst: return false - result = typeAllowedAux(marker, t.sons[0], skVar) - of tyPtr: - result = typeAllowedAux(marker, t.sons[0], skVar) - of tyArrayConstr, tyTuple, tySet, tyConst, tyMutable, tyIter: - for i in countup(0, sonsLen(t) - 1): - result = typeAllowedAux(marker, t.sons[i], kind) - if not result: break - of tyObject: - if kind == skConst: return false - for i in countup(0, sonsLen(t) - 1): - result = typeAllowedAux(marker, t.sons[i], kind) - if not result: break - if result and t.n != nil: result = typeAllowedNode(marker, t.n, kind) - of tyProxy: - # for now same as error node; we say it's a valid type as it should - # prevent cascading errors: - result = true - -proc typeAllowed(t: PType, kind: TSymKind): bool = - var marker = InitIntSet() - result = typeAllowedAux(marker, t, kind) - -proc align(address, alignment: biggestInt): biggestInt = - result = (address + (alignment - 1)) and not (alignment - 1) - -proc computeSizeAux(typ: PType, a: var biggestInt): biggestInt -proc computeRecSizeAux(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(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(lastSon(n.sons[i]), b, currOffset) - if res < 0: return res - maxSize = max(maxSize, res) - maxAlign = max(maxAlign, b) - else: internalError("computeRecSizeAux(record case branch)") - 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(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(n.sym.typ, a) - n.sym.offset = int(currOffset) - else: - InternalError("computeRecSizeAux()") - a = 1 - result = - 1 - -proc computeSizeAux(typ: PType, a: var biggestInt): biggestInt = - var res, maxAlign, length, currOffset: biggestInt - if typ.size == - 2: - # we are already computing the size of the type - # --> illegal recursion in type - return - 2 - if typ.size >= 0: - # size already computed - result = typ.size - a = typ.align - return - typ.size = - 2 # mark as being computed - case typ.kind - of tyInt, tyUInt: - result = 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 = floatSize - a = result - of tyProc: - if typ.callConv == ccClosure: result = 2 * ptrSize - else: result = ptrSize - a = ptrSize - of tyNil, tyCString, tyString, tySequence, tyPtr, tyRef, tyVar, tyOpenArray, - tyBigNum: - result = ptrSize - a = result - of tyArray, tyArrayConstr: - result = lengthOrd(typ.sons[0]) * computeSizeAux(typ.sons[1], a) - of tyEnum: - if firstOrd(typ) < 0: - result = 4 # use signed int32 - else: - length = lastOrd(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: - length = lengthOrd(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(typ.sons[0], a) - of tyTuple: - result = 0 - maxAlign = 1 - for i in countup(0, sonsLen(typ) - 1): - res = computeSizeAux(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(typ.sons[0], a) - if result < 0: return - maxAlign = a - elif isObjectWithTypeFieldPredicate(typ): - result = intSize - maxAlign = result - else: - result = 0 - maxAlign = 1 - currOffset = result - result = computeRecSizeAux(typ.n, a, currOffset) - if result < 0: return - if a < maxAlign: a = maxAlign - result = align(result, a) - of tyGenericInst, tyDistinct, tyGenericBody, tyMutable, tyConst, tyIter: - result = computeSizeAux(lastSon(typ), a) + of tyStatic: + return t.n == nil of tyTypeDesc: - result = (if typ.len == 1: computeSizeAux(typ.sons[0], a) else: -1) - of tyProxy: result = 1 + if t.base.kind == tyNone: return true + if containsGenericTypeIter(t.base, closure): return true + return false + of GenericTypes + tyTypeClasses + {tyFromExpr}: + return true else: - #internalError("computeSizeAux()") - result = - 1 - typ.size = result - typ.align = int(a) - -proc computeSize(typ: PType): biggestInt = - var a: biggestInt = 1 - result = computeSizeAux(typ, a) - -proc getReturnType*(s: PSym): PType = - # Obtains the return type of a iterator/proc/macro/template - assert s.kind in {skProc, skTemplate, skMacro, skIterator} - result = s.typ.sons[0] + return false -proc getSize(typ: PType): biggestInt = - result = computeSize(typ) - if result < 0: InternalError("getSize: " & $typ.kind) +proc containsGenericType*(t: PType): bool = + result = iterOverType(t, containsGenericTypeIter, nil) - -proc containsGenericTypeIter(t: PType, closure: PObject): bool = - result = t.kind in GenericTypes +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 containsGenericType*(t: PType): bool = - result = iterOverType(t, containsGenericTypeIter, nil) +proc containsUnresolvedType*(t: PType): bool = + result = iterOverType(t, containsUnresolvedTypeIter, nil) -proc baseOfDistinct*(t: PType): PType = +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.sons[0] - if it.kind == tyDistinct: - internalAssert parent != nil - parent.sons[0] = it.sons[0] + it = it.elementType + if it.kind == tyDistinct and parent != nil: + parent[0] = it[0] proc safeInheritanceDiff*(a, b: PType): int = # same as inheritanceDiff but checks for tyError: - if a.kind == tyError or b.kind == tyError: + if a.kind == tyError or b.kind == tyError: result = -1 else: - result = inheritanceDiff(a, b) + result = inheritanceDiff(a.skipTypes(skipPtrs), b.skipTypes(skipPtrs)) proc compatibleEffectsAux(se, re: PNode): bool = if re.isNil: return false @@ -1257,41 +1547,391 @@ proc compatibleEffectsAux(se, re: PNode): bool = return false result = true -proc compatibleEffects*(formal, actual: PType): bool = +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 + efRaisesDiffer + efRaisesUnknown + efTagsDiffer + efTagsUnknown + efEffectsDelayed + efTagsIllegal + +proc compatibleEffects*(formal, actual: PType): EffectsCompat = # for proc type compatibility checking: assert formal.kind == tyProc and actual.kind == tyProc - InternalAssert formal.n.sons[0].kind == nkEffectList - InternalAssert actual.n.sons[0].kind == nkEffectList - - var spec = formal.n.sons[0] + #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[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: + 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 false - result = compatibleEffectsAux(se, real.sons[exceptionEffects]) - if not result: return + if real.len == 0: return efRaisesUnknown + 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 false - result = compatibleEffectsAux(st, real.sons[tagEffects]) - if not result: return - result = true + if real.len == 0: return efTagsUnknown + 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, tyExpr} + 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]): + 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 + +proc classify*(t: PType): OrdinalType = + ## for convenient type checking: + if t == nil: + result = NoneLike + else: + case skipTypes(t, abstractVarRange).kind + of tyFloat..tyFloat128: result = FloatLike + of tyInt..tyInt64, tyUInt..tyUInt64, tyBool, tyChar, tyEnum: + result = IntLike + else: result = NoneLike + +proc skipConv*(n: PNode): PNode = + result = n + case n.kind + of nkObjUpConv, nkObjDownConv, nkChckRange, nkChckRangeF, nkChckRange64: + # only skip the conversion if it doesn't lose too important information + # (see bug #1334) + if n[0].typ.classify == n.typ.classify: + result = n[0] + of nkHiddenStdConv, nkHiddenSubConv, nkConv: + if n[1].typ.classify == n.typ.classify: + result = n[1] + else: discard + +proc skipHidden*(n: PNode): PNode = + result = n + while true: + case result.kind + of nkHiddenStdConv, nkHiddenSubConv: + if result[1].typ.classify == result.typ.classify: + result = result[1] + else: break + of nkHiddenDeref, nkHiddenAddr: + result = result[0] + else: break + +proc skipConvTakeType*(n: PNode): PNode = + result = n.skipConv + result.typ = n.typ + +proc isEmptyContainer*(t: PType): bool = + case t.kind + 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; g: ModuleGraph; idgen: IdGenerator): PType = + # param: openArray[string] = [] + # [] is an array constructor of length 0 of type string! + if arg.kind == tyNil: + # and not (formal.kind == tyProc and formal.callConv == ccClosure): + result = formal + elif formal.kind in {tyOpenArray, tyVarargs, tySequence} and + arg.isEmptyContainer: + 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; 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[1] + let arg = result.typ + 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: + result = copyTree(result) + result.typ = dest + else: + result = n + +proc getProcConvMismatch*(c: ConfigRef, f, a: PType, rel = isNone): (set[ProcConvMismatch], TTypeRelation) = + ## Returns a set of the reason of mismatch, and the relation for conversion. + result[1] = rel + if tfNoSideEffect in f.flags and tfNoSideEffect notin a.flags: + # Formal is pure, but actual is not + result[0].incl pcmNoSideEffect + result[1] = isNone + + if tfThread in f.flags and a.flags * {tfThread, tfNoSideEffect} == {} and + optThreadAnalysis in c.globalOptions: + # noSideEffect implies ``tfThread``! + result[0].incl pcmNotGcSafe + result[1] = isNone + + if f.flags * {tfIterator} != a.flags * {tfIterator}: + # One of them is an iterator so not convertible + result[0].incl pcmNotIterator + result[1] = isNone + + if f.callConv != a.callConv: + # valid to pass a 'nimcall' thingie to 'closure': + if f.callConv == ccClosure and a.callConv == ccNimCall: + case result[1] + of isInferred: result[1] = isInferredConvertible + of isBothMetaConvertible: result[1] = isBothMetaConvertible + elif result[1] != isNone: result[1] = isConvertible + else: result[0].incl pcmDifferentCallConv + else: + result[1] = isNone + result[0].incl pcmDifferentCallConv + +proc addPragmaAndCallConvMismatch*(message: var string, formal, actual: PType, conf: ConfigRef) = + assert formal.kind == tyProc and actual.kind == tyProc + let (convMismatch, _) = getProcConvMismatch(conf, formal, actual) + var + gotPragmas = "" + expectedPragmas = "" + for reason in convMismatch: + case reason + of pcmDifferentCallConv: + message.add "\n Calling convention mismatch: got '{.$1.}', but expected '{.$2.}'." % [$actual.callConv, $formal.callConv] + of pcmNoSideEffect: + expectedPragmas.add "noSideEffect, " + of pcmNotGcSafe: + expectedPragmas.add "gcsafe, " + of pcmNotIterator: discard + + if expectedPragmas.len > 0: + gotPragmas.setLen(max(0, gotPragmas.len - 2)) # Remove ", " + expectedPragmas.setLen(max(0, expectedPragmas.len - 2)) # Remove ", " + message.add "\n Pragma mismatch: got '{.$1.}', but expected '{.$2.}'." % [gotPragmas, expectedPragmas] + +proc processPragmaAndCallConvMismatch(msg: var string, formal, actual: PType, conf: ConfigRef) = + if formal.kind == tyProc and actual.kind == tyProc: + msg.addPragmaAndCallConvMismatch(formal, actual, conf) + case compatibleEffects(formal, actual) + of efCompat: discard + of efRaisesDiffer: + msg.add "\n.raise effects differ" + of efRaisesUnknown: + msg.add "\n.raise effect is 'can raise any'" + of efTagsDiffer: + msg.add "\n.tag effects differ" + of efTagsUnknown: + msg.add "\n.tag effect is 'any tag allowed'" + of efEffectsDelayed: + msg.add "\n.effectsOf annotations differ" + of efTagsIllegal: + msg.add "\n.notTag catched an illegal effect" + +proc typeNameAndDesc*(t: PType): string = + result = typeToString(t) + let desc = typeToString(t, preferDesc) + if result != desc: + result.add(" = ") + result.add(desc) + +proc typeMismatch*(conf: ConfigRef; info: TLineInfo, formal, actual: PType, n: PNode) = + if formal.kind != tyError and actual.kind != tyError: + let actualStr = typeToString(actual) + let formalStr = typeToString(formal) + let desc = typeToString(formal, preferDesc) + let x = if formalStr == desc: formalStr else: formalStr & " = " & desc + let verbose = actualStr == formalStr or optDeclaredLocs in conf.globalOptions + var msg = "type mismatch:" + if verbose: msg.add "\n" + if conf.isDefined("nimLegacyTypeMismatch"): + msg.add " got <$1>" % actualStr + else: + msg.add " got '$1' for '$2'" % [actualStr, n.renderTree] + if verbose: + msg.addDeclaredLoc(conf, actual) + msg.add "\n" + msg.add " but expected '$1'" % x + if verbose: msg.addDeclaredLoc(conf, formal) + 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 new file mode 100644 index 000000000..72bcddb05 --- /dev/null +++ b/compiler/typesrenderer.nim @@ -0,0 +1,160 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +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. + ## + ## Use this on documentation name nodes to extract the *raw* symbol name, + ## without decorations, parameters, or anything. That can be used as the base + ## for the HTML hyperlinks. + case n.kind + of nkPostfix, nkAccQuoted: + result = renderPlainSymbolName(n[^1]) + of nkIdent: + result = n.ident.s + of nkSym: + result = n.sym.renderDefinitionName(noQuotes = true) + of nkPragmaExpr: + result = renderPlainSymbolName(n[0]) + else: + result = "" + #internalError(n.info, "renderPlainSymbolName() with " & $n.kind) + +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 = mayNormalize(n.ident.s) + of nkSym: result = mayNormalize(typeToString(n.sym.typ)) + of nkVarTy: + if n.len == 1: + result = renderType(n[0], toNormalize) + else: + result = "var" + of nkRefTy: + if n.len == 1: + result = "ref." & renderType(n[0], toNormalize) + else: + result = "ref" + of nkPtrTy: + if n.len == 1: + result = "ptr." & renderType(n[0], toNormalize) + else: + result = "ptr" + of nkProcTy: + assert n.len != 1 + if n.len > 1 and n[0].kind == nkFormalParams: + let params = n[0] + assert params.len > 0 + result = "proc(" + for i in 1..<params.len: result.add(renderType(params[i], toNormalize) & ',') + result[^1] = ')' + else: + result = "proc" + of nkIdentDefs: + assert n.len >= 3 + let typePos = n.len - 2 + let typeStr = renderType(n[typePos], toNormalize) + result = typeStr + for i in 1..<typePos: + assert n[i].kind in {nkSym, nkIdent} + result.add(',' & typeStr) + of nkTupleTy: + result = "tuple[" + for i in 0..<n.len: result.add(renderType(n[i], toNormalize) & ',') + result[^1] = ']' + of nkBracketExpr: + 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 = "" + + +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 `doc` + ## generator does include the information. + case n.kind + of nkFormalParams: + for i in 1..<n.len: renderParamTypes(found, n[i], toNormalize) + of nkIdentDefs: + # These are parameter names + type + default value node. + let typePos = n.len - 2 + assert typePos > 0 + var typeStr = renderType(n[typePos], 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: + found.add(typeStr) + else: + found.add($n) + #internalError(n.info, "renderParamTypes(found,n) with " & $n.kind) + +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 + ## string output is meant for the HTML renderer. If there are no parameters, + ## the empty string is returned. The parameters will be joined by `sep` but + ## other characters may appear too, like ``[]`` or ``|``. + result = "" + var found: seq[string] = @[] + 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 new file mode 100644 index 000000000..161b025a6 --- /dev/null +++ b/compiler/vm.nim @@ -0,0 +1,2536 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## This file implements the new evaluation engine for Nim code. +## An instruction is 1-3 int32s in memory, it is a register based VM. + +import semmacrosanity +import + 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 + +const + traceCode = defined(nimVMDebug) + +when hasFFI: + import evalffi + + +proc stackTraceAux(c: PCtx; x: PStackFrame; pc: int; recursionLimit=100) = + if x != nil: + if recursionLimit == 0: + var calls = 0 + var x = x + while x != nil: + inc calls + x = x.next + msgWriteln(c.config, $calls & " calls omitted\n", {msgNoUnitSep}) + return + stackTraceAux(c, x.next, x.comesFrom, recursionLimit-1) + var info = c.debug[pc] + # we now use a format similar to the one in lib/system/excpt.nim + var s = "" + # todo: factor with quotedFilename + if optExcessiveStackTrace in c.config.globalOptions: + s = toFullPath(c.config, info) + else: + s = toFilename(c.config, info) + var line = toLinenumber(info) + var col = toColumn(info) + if line > 0: + s.add('(') + s.add($line) + s.add(", ") + s.add($(col + ColOffset)) + s.add(')') + if x.prc != nil: + for k in 1..max(1, 25-s.len): s.add(' ') + s.add(x.prc.name.s) + msgWriteln(c.config, s, {msgNoUnitSep}) + +proc stackTraceImpl(c: PCtx, tos: PStackFrame, pc: int, + msg: string, lineInfo: TLineInfo, infoOrigin: InstantiationInfo) {.noinline.} = + # noinline to avoid code bloat + msgWriteln(c.config, "stack trace: (most recent call last)", {msgNoUnitSep}) + stackTraceAux(c, tos, pc) + let action = if c.mode == emRepl: doRaise else: doNothing + # XXX test if we want 'globalError' for every mode + let lineInfo = if lineInfo == TLineInfo.default: c.debug[pc] else: lineInfo + liMessage(c.config, lineInfo, errGenerated, msg, action, infoOrigin) + +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[3].skipColon.strVal & + " [" & c.currentExceptionA[2].skipColon.strVal & "]") + +when not defined(nimComputedGoto): + {.pragma: computedGoto.} + +proc ensureKind(n: var TFullReg, k: TRegisterKind) {.inline.} = + if n.kind != k: + n = TFullReg(kind: k) + +template ensureKind(k: untyped) {.dirty.} = + ensureKind(regs[ra], k) + +template decodeB(k: untyped) {.dirty.} = + let rb = instr.regB + ensureKind(k) + +template decodeBC(k: untyped) {.dirty.} = + let rb = instr.regB + let rc = instr.regC + ensureKind(k) + +template declBC() {.dirty.} = + let rb = instr.regB + let rc = instr.regC + +template decodeBImm(k: untyped) {.dirty.} = + let rb = instr.regB + let imm = instr.regC - byteExcess + ensureKind(k) + +template decodeBx(k: untyped) {.dirty.} = + let rbx = instr.regBx - wordExcess + ensureKind(k) + +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: + x.node = newNode(nkStrLit) + elif x.node.kind == nkNilLit and keepNode: + when defined(useNodeIds): + let id = x.node.id + x.node[] = TNode(kind: nkStrLit) + when defined(useNodeIds): + x.node.id = id + elif x.node.kind notin {nkStrLit..nkTripleStrLit} or + nfAllConst in x.node.flags: + # XXX this is hacky; tests/txmlgen triggers it: + 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 definitions (var foo = e) and variable updates (foo = e). + +include vmhooks + +template createStr(x) = + x.node = newNode(nkStrLit) + +template createSet(x) = + x.node = newNode(nkCurly) + +proc moveConst(x: var TFullReg, y: TFullReg) = + x.ensureKind(y.kind) + case x.kind + of rkNone: discard + 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 + +# this seems to be the best way to model the reference semantics +# of system.NimNode: +template asgnRef(x, y: untyped) = moveConst(x, y) + +proc copyValue(src: PNode): PNode = + if src == nil or nfIsRef in src.flags: + return src + 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 nkFloatLit..nkFloat128Lit: 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, src.len) + for i in 0..<src.len: + result[i] = copyValue(src[i]) + +proc asgnComplex(x: var TFullReg, y: TFullReg) = + x.ensureKind(y.kind) + case x.kind + of rkNone: discard + of rkInt: x.intVal = y.intVal + of rkFloat: x.floatVal = y.floatVal + of rkNode: x.node = copyValue(y.node) + of rkRegisterAddr: x.regAddr = y.regAddr + of rkNodeAddr: x.nodeAddr = y.nodeAddr + +proc fastAsgnComplex(x: var TFullReg, y: TFullReg) = + x.ensureKind(y.kind) + case x.kind + of rkNone: discard + 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: 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 = 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 = TFullReg(kind: rkFloat, floatVal: n.floatVal) + else: + dest = TFullReg(kind: rkNode, node: n) + +proc regToNode(x: TFullReg): PNode = + case x.kind + of rkNone: result = newNode(nkEmpty) + of rkInt: result = newNode(nkIntLit); result.intVal = x.intVal + of rkFloat: result = newNode(nkFloatLit); result.floatVal = x.floatVal + of rkNode: result = x.node + of rkRegisterAddr: result = regToNode(x.regAddr[]) + of rkNodeAddr: result = x.nodeAddr[] + +template getstr(a: untyped): untyped = + (if a.kind == rkNode: a.node.strVal else: $chr(int(a.intVal))) + +proc pushSafePoint(f: PStackFrame; pc: int) = + f.safePoints.add(pc) + +proc popSafePoint(f: PStackFrame) = + 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 = + # 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 += c.code[pc].regBx - wordExcess + if c.code[pc].opcode == opcFinally: + 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: + 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[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[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 + dest.node.strVal = styp.sym.name.s & " " & $x + of tyInt..tyInt64: + dest.node.strVal = $src.intVal + of tyUInt..tyUInt64: + dest.node.strVal = $uint64(src.intVal) + of tyBool: + dest.node.strVal = if src.intVal == 0: "false" else: "true" + of tyFloat..tyFloat128: + dest.node.strVal = $src.floatVal + of tyString: + dest.node.strVal = src.node.strVal + of tyCstring: + if src.node.kind == nkBracket: + # Array of chars + var strVal = "" + for son in src.node.sons: + let c = char(son.intVal) + if c == '\0': break + strVal.add(c) + dest.node.strVal = strVal + else: + dest.node.strVal = src.node.strVal + of tyChar: + dest.node.strVal = $chr(src.intVal) + else: + internalError(c.config, "cannot convert to string " & desttyp.typeToString) + else: + let desttyp = skipTypes(desttyp, abstractVarRange) + case desttyp.kind + of tyInt..tyInt64: + dest.ensureKind(rkInt) + case skipTypes(srctyp, abstractRange).kind + of tyFloat..tyFloat64: + dest.intVal = int(src.floatVal) + else: + dest.intVal = src.intVal + if toInt128(dest.intVal) < firstOrd(c.config, desttyp) or toInt128(dest.intVal) > lastOrd(c.config, desttyp): + return true + of tyUInt..tyUInt64: + 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 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: + 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) + +proc compile(c: PCtx, s: PSym): int = + result = vmgen.genProc(c, s) + when debugEchoCode: c.echoCode result + #c.echoCode + +template handleJmpBack() {.dirty.} = + if c.loopIterations <= 0: + if allowInfiniteLoops in c.features: + c.loopIterations = c.config.maxLoopIterationsVM + else: + msgWriteln(c.config, "stack trace: (most recent call last)", {msgNoUnitSep}) + stackTraceAux(c, tos, pc) + globalError(c.config, c.debug[pc], errTooManyIterations % $c.config.maxLoopIterationsVM) + dec(c.loopIterations) + +proc recSetFlagIsRef(arg: PNode) = + 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) = + let typ = node.typ.skipTypes(abstractInst+{tyRange}-{tyTypeDesc}) + let oldLen = node.len + setLen(node.sons, newLen) + if oldLen < newLen: + for i in oldLen..<newLen: + node[i] = getNullValue(c, typ.elementType, info, c.config) + +const + 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, 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 + # 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 + + 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: + 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) + 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 opcNodeToReg: + let ra = instr.regA + let rb = instr.regB + # 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 + if nb == nil: + stackTrace(c, tos, pc, errNilAccess) + else: + 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, formatErrorIndexBound(regs[rc].intVal, high(int))) + let idx = regs[rc].intVal.int + let src = regs[rb].node + 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, formatErrorIndexBound(idx, src.strVal.len-1)) + elif src.kind notin {nkEmpty..nkFloat128Lit} and idx <% src.len: + regs[ra].node = src[idx] + else: + stackTrace(c, tos, pc, formatErrorIndexBound(idx, src.safeLen-1)) + 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 {.cursor.} = regs[rb].node.strVal + if idx <% s.len: + regs[ra].intVal = s[idx].ord + else: + 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 + 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, formatErrorIndexBound(idx, arr.strVal.len-1)) + elif idx <% arr.len: + writeField(arr[idx], regs[rc]) + else: + stackTrace(c, tos, pc, formatErrorIndexBound(idx, arr.safeLen-1)) + of opcLdObj: + # a = b.c + decodeBC(rkNode) + 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[shiftedRb].kind == nkExprColonExpr: + writeField(dest[shiftedRb][1], regs[rc]) + dest[shiftedRb][1].flags.incl nfSkipFieldChecking + else: + writeField(dest[shiftedRb], regs[rc]) + dest[shiftedRb].flags.incl nfSkipFieldChecking + of opcWrStrIdx: + decodeBC(rkNode) + let idx = regs[rb].intVal.int + if idx <% regs[ra].node.strVal.len: + regs[ra].node.strVal[idx] = chr(regs[rc].intVal) + else: + stackTrace(c, tos, pc, formatErrorIndexBound(idx, regs[ra].node.strVal.len-1)) + of opcAddrReg: + decodeB(rkRegisterAddr) + regs[ra].regAddr = addr(regs[rb]) + of opcAddrNode: + decodeB(rkNodeAddr) + 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', got kind: " & $regs[rb].kind) + of opcLdDeref: + # a = b[] + let ra = instr.regA + let rb = instr.regB + case regs[rb].kind + of rkNodeAddr: + ensureKind(rkNode) + regs[ra].node = regs[rb].nodeAddr[] + of rkRegisterAddr: + ensureKind(regs[rb].regAddr.kind) + regs[ra] = regs[rb].regAddr[] + of rkNode: + if regs[rb].node.kind == nkRefTy: + 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 & " kind: " & $regs[rb].kind) + of opcWrDeref: + # a[] = c; b unused + let ra = instr.regA + let rc = instr.regC + case regs[ra].kind + 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: + # 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) + let + bVal = regs[rb].intVal + cVal = regs[rc].intVal + sum = bVal +% cVal + if (sum xor bVal) >= 0 or (sum xor cVal) >= 0: + regs[ra].intVal = sum + else: + stackTrace(c, tos, pc, errOverOrUnderflow) + of opcAddImmInt: + decodeBImm(rkInt) + #message(c.config, c.debug[pc], warnUser, "came here") + #debug regs[rb].node + let + bVal = regs[rb].intVal + cVal = imm + sum = bVal +% cVal + if (sum xor bVal) >= 0 or (sum xor cVal) >= 0: + regs[ra].intVal = sum + else: + stackTrace(c, tos, pc, errOverOrUnderflow) + of opcSubInt: + decodeBC(rkInt) + let + bVal = regs[rb].intVal + cVal = regs[rc].intVal + diff = bVal -% cVal + if (diff xor bVal) >= 0 or (diff xor not cVal) >= 0: + regs[ra].intVal = diff + else: + stackTrace(c, tos, pc, errOverOrUnderflow) + of opcSubImmInt: + decodeBImm(rkInt) + let + bVal = regs[rb].intVal + cVal = imm + diff = bVal -% cVal + if (diff xor bVal) >= 0 or (diff xor not cVal) >= 0: + regs[ra].intVal = diff + else: + stackTrace(c, tos, pc, errOverOrUnderflow) + of opcLenSeq: + decodeBImm(rkInt) + #assert regs[rb].kind == nkBracket + 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: + 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): + regs[ra].node.add copyTree(b) + of opcInclRange: + decodeBC(rkNode) + var r = newNode(nkRange) + r.add regs[rb].regToNode + r.add regs[rc].regToNode + regs[ra].node.add r.copyTree + of opcExcl: + decodeB(rkNode) + var b = newNodeIT(nkCurly, regs[ra].node.info, regs[ra].node.typ) + b.add regs[rb].regToNode + var r = diffSets(c.config, regs[ra].node, b) + discardSons(regs[ra].node) + 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) + of opcMulInt: + decodeBC(rkInt) + let + bVal = regs[rb].intVal + cVal = regs[rc].intVal + product = bVal *% cVal + floatProd = toBiggestFloat(bVal) * toBiggestFloat(cVal) + resAsFloat = toBiggestFloat(product) + if resAsFloat == floatProd: + regs[ra].intVal = product + elif 32.0 * abs(resAsFloat - floatProd) <= abs(floatProd): + regs[ra].intVal = product + else: + stackTrace(c, tos, pc, errOverOrUnderflow) + of opcDivInt: + decodeBC(rkInt) + if regs[rc].intVal == 0: stackTrace(c, tos, pc, errConstantDivisionByZero) + else: regs[ra].intVal = regs[rb].intVal div regs[rc].intVal + of opcModInt: + decodeBC(rkInt) + if regs[rc].intVal == 0: stackTrace(c, tos, pc, errConstantDivisionByZero) + else: regs[ra].intVal = regs[rb].intVal mod regs[rc].intVal + of opcAddFloat: + decodeBC(rkFloat) + regs[ra].floatVal = regs[rb].floatVal + regs[rc].floatVal + of opcSubFloat: + decodeBC(rkFloat) + regs[ra].floatVal = regs[rb].floatVal - regs[rc].floatVal + of opcMulFloat: + decodeBC(rkFloat) + regs[ra].floatVal = regs[rb].floatVal * regs[rc].floatVal + of opcDivFloat: + decodeBC(rkFloat) + regs[ra].floatVal = regs[rb].floatVal / regs[rc].floatVal + of opcShrInt: + decodeBC(rkInt) + 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 + of opcBitorInt: + decodeBC(rkInt) + regs[ra].intVal = regs[rb].intVal or regs[rc].intVal + of opcBitxorInt: + decodeBC(rkInt) + regs[ra].intVal = regs[rb].intVal xor regs[rc].intVal + of opcAddu: + decodeBC(rkInt) + regs[ra].intVal = regs[rb].intVal +% regs[rc].intVal + of opcSubu: + decodeBC(rkInt) + regs[ra].intVal = regs[rb].intVal -% regs[rc].intVal + of opcMulu: + decodeBC(rkInt) + regs[ra].intVal = regs[rb].intVal *% regs[rc].intVal + of opcDivu: + decodeBC(rkInt) + regs[ra].intVal = regs[rb].intVal /% regs[rc].intVal + of opcModu: + decodeBC(rkInt) + regs[ra].intVal = regs[rb].intVal %% regs[rc].intVal + of opcEqInt: + decodeBC(rkInt) + regs[ra].intVal = ord(regs[rb].intVal == regs[rc].intVal) + of opcLeInt: + decodeBC(rkInt) + regs[ra].intVal = ord(regs[rb].intVal <= regs[rc].intVal) + of opcLtInt: + decodeBC(rkInt) + regs[ra].intVal = ord(regs[rb].intVal < regs[rc].intVal) + of opcEqFloat: + decodeBC(rkInt) + regs[ra].intVal = ord(regs[rb].floatVal == regs[rc].floatVal) + of opcLeFloat: + decodeBC(rkInt) + regs[ra].intVal = ord(regs[rb].floatVal <= regs[rc].floatVal) + of opcLtFloat: + decodeBC(rkInt) + regs[ra].intVal = ord(regs[rb].floatVal < regs[rc].floatVal) + of opcLeu: + decodeBC(rkInt) + regs[ra].intVal = ord(regs[rb].intVal <=% regs[rc].intVal) + of opcLtu: + decodeBC(rkInt) + regs[ra].intVal = ord(regs[rb].intVal <% regs[rc].intVal) + of opcEqRef: + var ret = false + decodeBC(rkInt) + template getTyp(n): untyped = + n.typ.skipTypes(abstractInst) + template skipRegisterAddr(n: TFullReg): TFullReg = + var tmp = n + while tmp.kind == rkRegisterAddr: + tmp = tmp.regAddr[] + tmp + + proc ptrEquality(n1: ptr PNode, n2: PNode): bool = + ## true if n2.intVal represents a ptr equal to n1 + let p1 = cast[int](n1) + 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: + ret = ptrEquality(rbReg.nodeAddr, rcReg.node) + elif rcReg.kind == rkNodeAddr: + ret = ptrEquality(rcReg.nodeAddr, rbReg.node) + else: + 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, {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) + of opcNot: + decodeB(rkInt) + assert regs[rb].kind == rkInt + regs[ra].intVal = 1 - regs[rb].intVal + of opcUnaryMinusInt: + decodeB(rkInt) + assert regs[rb].kind == rkInt + let val = regs[rb].intVal + if val != int64.low: + regs[ra].intVal = -val + else: + stackTrace(c, tos, pc, errOverOrUnderflow) + of opcUnaryMinusFloat: + decodeB(rkFloat) + assert regs[rb].kind == rkFloat + regs[ra].floatVal = -regs[rb].floatVal + of opcBitnotInt: + decodeB(rkInt) + assert regs[rb].kind == rkInt + regs[ra].intVal = not regs[rb].intVal + 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) + of opcLtStr: + decodeBC(rkInt) + regs[ra].intVal = ord(regs[rb].node.strVal < regs[rc].node.strVal) + of opcLeSet: + decodeBC(rkInt) + regs[ra].intVal = ord(containsSets(c.config, regs[rb].node, regs[rc].node)) + of opcEqSet: + decodeBC(rkInt) + regs[ra].intVal = ord(equalSets(c.config, regs[rb].node, regs[rc].node)) + of opcLtSet: + decodeBC(rkInt) + let a = regs[rb].node + let b = regs[rc].node + regs[ra].intVal = ord(containsSets(c.config, a, b) and not equalSets(c.config, a, b)) + of opcMulSet: + decodeBC(rkNode) + createSet(regs[ra]) + move(regs[ra].node.sons, + nimsets.intersectSets(c.config, regs[rb].node, regs[rc].node).sons) + of opcPlusSet: + decodeBC(rkNode) + createSet(regs[ra]) + move(regs[ra].node.sons, + nimsets.unionSets(c.config, regs[rb].node, regs[rc].node).sons) + of opcMinusSet: + decodeBC(rkNode) + createSet(regs[ra]) + move(regs[ra].node.sons, + nimsets.diffSets(c.config, regs[rb].node, regs[rc].node).sons) + of opcConcatStr: + decodeBC(rkNode) + createStr regs[ra] + regs[ra].node.strVal = getstr(regs[rb]) + for i in rb+1..rb+rc-1: + regs[ra].node.strVal.add getstr(regs[i]) + of opcAddStrCh: + decodeB(rkNode) + regs[ra].node.strVal.add(regs[rb].intVal.chr) + of opcAddStrStr: + decodeB(rkNode) + regs[ra].node.strVal.add(regs[rb].node.strVal) + of opcAddSeqElem: + decodeB(rkNode) + if regs[ra].node.kind == nkBracket: + regs[ra].node.add(copyValue(regs[rb].regToNode)) + else: + stackTrace(c, tos, pc, errNilAccess) + of opcGetImpl: + decodeB(rkNode) + 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 + 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) + fn(outp) + of opcContainsSet: + decodeBC(rkInt) + regs[ra].intVal = ord(inSet(regs[rb].node, regs[rc].regToNode)) + of opcParseFloat: + decodeBC(rkInt) + var rcAddr = addr(regs[rc]) + if rcAddr.kind == rkRegisterAddr: rcAddr = rcAddr.regAddr + elif regs[rc].kind != rkFloat: + 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 + if not (leValueConv(regs[rb].regToNode, regs[ra].regToNode) and + leValueConv(regs[ra].regToNode, regs[rc].regToNode)): + stackTrace(c, tos, pc, + errIllegalConvFromXtoY % [ + $regs[ra].regToNode, "[" & $regs[rb].regToNode & ".." & $regs[rc].regToNode & "]"]) + of opcIndCall, opcIndCallAsgn: + # dest = call regStart, n; where regStart = fn, arg1, ... + let rb = instr.regB + let rc = instr.regC + let bb = regs[rb].node + if bb.kind == nkNilLit: + stackTrace(c, tos, pc, "attempt to call nil closure") + let isClosure = bb.kind == nkTupleConstr + if isClosure and bb[0].kind == nkNilLit: + stackTrace(c, tos, pc, "attempt to call nil closure") + let prc = if not isClosure: bb.sym else: bb[0].sym + if prc.offset < -1: + # it's a callback: + c.callbacks[-prc.offset-2]( + 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: + 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) + 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 + putIntoReg(regs[ra], newValue) + else: + globalError(c.config, c.debug[pc], "VM not built with FFI support") + elif prc.kind != skTemplate: + let newPc = compile(c, prc) + # tricky: a recursion is also a jump back, so we use the same + # logic as for loops: + if newPc < pc: handleJmpBack() + #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.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] = TFullReg(kind: rkNode, node: regs[rb].node[1]) + tos = newFrame + updateRegsAlias + # -1 for the following 'inc pc' + pc = newPc-1 + else: + # for 'getAst' support we need to support template expansion here: + let genSymOwner = if tos.next != nil and tos.next.prc != nil: + tos.next.prc + else: + c.module + var macroCall = newNodeI(nkCall, c.debug[pc]) + macroCall.add(newSymNode(prc)) + for i in 1..rc-1: + let node = regs[rb+i].regToNode + node.info = c.debug[pc] + if prc.typ[i].kind notin {tyTyped, tyUntyped}: + node.annotateType(prc.typ[i], c.config) + + macroCall.add(node) + var a = evalTemplate(macroCall, prc, genSymOwner, c.config, c.cache, c.templInstCounter, c.idgen) + if a.kind == nkStmtList and a.len == 1: a = a[0] + a.recSetFlagIsRef + ensureKind(rkNode) + regs[ra].node = a + of opcTJmp: + # jump Bx if A != 0 + let rbx = instr.regBx - wordExcess - 1 # -1 for the following 'inc pc' + if regs[ra].intVal != 0: + inc pc, rbx + of opcFJmp: + # jump Bx if A == 0 + let rbx = instr.regBx - wordExcess - 1 # -1 for the following 'inc pc' + if regs[ra].intVal == 0: + inc pc, rbx + of opcJmp: + # jump Bx + let rbx = instr.regBx - wordExcess - 1 # -1 for the following 'inc pc' + inc pc, rbx + of opcJmpBack: + let rbx = instr.regBx - wordExcess - 1 # -1 for the following 'inc pc' + inc pc, rbx + handleJmpBack() + of opcBranch: + # we know the next instruction is a 'fjmp': + let branch = c.constants[instr.regBx-wordExcess] + var cond = false + for j in 0..<branch.len - 1: + if overlap(regs[ra].regToNode, branch[j]): + cond = true + break + assert c.code[pc+1].opcode == opcFJmp + inc pc + # we skip this instruction so that the final 'inc(pc)' skips + # the following jump + if not cond: + let instr2 = c.code[pc] + let rbx = instr2.regBx - wordExcess - 1 # -1 for the following 'inc pc' + inc pc, rbx + of opcTry: + let rbx = instr.regBx - wordExcess + tos.pushSafePoint(pc + rbx) + assert c.code[pc+rbx].opcode in {opcExcept, opcFinally} + of opcExcept: + # This opcode is never executed, it only holds information for the + # exception handling routines. + raiseAssert "unreachable" + of opcFinally: + # Pop the last safepoint introduced by a opcTry. This opcode is only + # executed _iff_ no exception was raised in the body of the `try` + # statement hence the need to pop the safepoint here. + doAssert(savedPC < 0) + tos.popSafePoint() + of opcFinallyEnd: + # 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 = + # 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 + + 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) + of opcNew: + ensureKind(rkNode) + let typ = c.types[instr.regBx - wordExcess] + 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] + inc pc + ensureKind(rkNode) + let instr2 = c.code[pc] + let count = regs[instr2.regA].intVal.int + 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[i] = getNullValue(c, typ.elementType, c.debug[pc], c.config) + of opcNewStr: + decodeB(rkNode) + regs[ra].node = newNodeI(nkStrLit, c.debug[pc]) + regs[ra].node.strVal = newString(regs[rb].intVal.int) + of opcLdImmInt: + # dest = immediate value + decodeBx(rkInt) + regs[ra].intVal = rbx + of opcLdNull: + ensureKind(rkNode) + let typ = c.types[instr.regBx - wordExcess] + regs[ra].node = getNullValue(c, typ, c.debug[pc], c.config) + # opcLdNull really is the gist of the VM's problems: should it load + # a fresh null to regs[ra].node or to regs[ra].node[]? This really + # depends on whether regs[ra] represents the variable itself or whether + # 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'. + of opcLdNullReg: + let typ = c.types[instr.regBx - wordExcess] + if typ.skipTypes(abstractInst+{tyRange}-{tyTypeDesc}).kind in { + tyFloat..tyFloat128}: + ensureKind(rkFloat) + regs[ra].floatVal = 0.0 + else: + ensureKind(rkInt) + regs[ra].intVal = 0 + of opcLdConst: + let rb = instr.regBx - wordExcess + let cnst = c.constants[rb] + if fitsRegister(cnst.typ): + 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[rb] + if fitsRegister(cnst.typ): + putIntoReg(regs[ra], cnst) + else: + ensureKind(rkNode) + regs[ra].node = cnst.copyTree + of opcLdGlobal: + let rb = instr.regBx - wordExcess - 1 + ensureKind(rkNode) + 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[rb]) + of opcRepr: + decodeB(rkNode) + createStr regs[ra] + 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(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] + regs[ra].node.strVal.setLen(regs[rb].intVal.int) + of opcOf: + decodeBC(rkInt) + let typ = c.types[regs[rc].intVal.int] + regs[ra].intVal = ord(inheritanceDiff(regs[rb].node.typ, typ) <= 0) + of opcIs: + decodeBC(rkInt) + let t1 = regs[rb].node.typ.skipTypes({tyTypeDesc}) + let t2 = c.types[regs[rc].intVal.int] + # XXX: This should use the standard isOpImpl + let match = if t2.kind == tyUserTypeClass: true + else: sameType(t1, t2) + regs[ra].intVal = ord(match) + of opcSetLenSeq: + decodeB(rkNode) + 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 opcNarrowS: + decodeB(rkInt) + let min = -(1.BiggestInt shl (rb-1)) + let max = (1.BiggestInt shl (rb-1))-1 + if regs[ra].intVal < min or regs[ra].intVal > max: + stackTrace(c, tos, pc, "unhandled exception: value out of range") + of opcNarrowU: + decodeB(rkInt) + regs[ra].intVal = regs[ra].intVal and ((1'i64 shl rb)-1) + 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( + # 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[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 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: + regs[ra].node = src[idx] + of opcNSetChild: + decodeBC(rkNode) + let idx = regs[rb].intVal.int + var dest = regs[ra].node + if nfSem in dest.flags and allowSemcheckedAstModification notin c.config.legacyFeatures: + stackTrace(c, tos, pc, "typechecked nodes may not be modified") + 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: + dest[idx] = regs[rc].node + of opcNAdd: + decodeBC(rkNode) + var u = regs[rb].node + if nfSem in u.flags and allowSemcheckedAstModification notin c.config.legacyFeatures: + stackTrace(c, tos, pc, "typechecked nodes may not be modified") + elif u.kind in {nkEmpty..nkNilLit}: + stackTrace(c, tos, pc, "cannot add to node kind: n" & $u.kind) + else: + u.add(regs[rc].node) + regs[ra].node = u + of opcNAddMultiple: + decodeBC(rkNode) + let x = regs[rc].node + var u = regs[rb].node + if nfSem in u.flags and allowSemcheckedAstModification notin c.config.legacyFeatures: + stackTrace(c, tos, pc, "typechecked nodes may not be modified") + elif u.kind in {nkEmpty..nkNilLit}: + stackTrace(c, tos, pc, "cannot add to node kind: n" & $u.kind) + else: + for i in 0..<x.len: u.add(x[i]) + regs[ra].node = u + of opcNKind: + decodeB(rkInt) + regs[ra].intVal = ord(regs[rb].node.kind) + c.comesFromHeuristic = regs[rb].node.info + of opcNSymKind: + decodeB(rkInt) + let a = regs[rb].node + if a.kind == nkSym: + regs[ra].intVal = ord(a.sym.kind) + else: + stackTrace(c, tos, pc, "node is not a symbol") + c.comesFromHeuristic = regs[rb].node.info + of opcNIntVal: + decodeB(rkInt) + let a = regs[rb].node + 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 + case a.kind + of nkFloatLit..nkFloat64Lit: regs[ra].floatVal = a.floatVal + else: stackTrace(c, tos, pc, errFieldXNotFound & "floatVal") + of opcNSymbol: + decodeB(rkNode) + let a = regs[rb].node + if a.kind == nkSym: + regs[ra].node = copyNode(a) + else: + stackTrace(c, tos, pc, errFieldXNotFound & "symbol") + of opcNIdent: + decodeB(rkNode) + let a = regs[rb].node + if a.kind == nkIdent: + 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 + 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], 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: + # typeKind opcode: + 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], 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], 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: + regs[ra].node.strVal = a.strVal + of nkCommentStmt: + regs[ra].node.strVal = a.comment + of nkIdent: + regs[ra].node.strVal = a.ident.s + of nkSym: + 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: + 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: + 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 + 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: + decodeBC(rkNode) + var error: string = "" + let ast = parseString(regs[rb].node.strVal, c.cache, c.config, + regs[rc].node.strVal, 0, + proc (conf: ConfigRef; info: TLineInfo; msg: TMsgKind; arg: string) = + if error.len == 0 and msg <= errMax: + error = formatMsg(conf, info, msg, arg)) + + regs[ra].node = newNode(nkEmpty) + if error.len > 0: + c.errorFlag = error + elif ast.len != 1: + c.errorFlag = formatMsg(c.config, c.debug[pc], errGenerated, + "expected expression, but got multiple statements") + else: + regs[ra].node = ast[0] + of opcParseStmtToAst: + decodeBC(rkNode) + var error: string = "" + let ast = parseString(regs[rb].node.strVal, c.cache, c.config, + regs[rc].node.strVal, 0, + proc (conf: ConfigRef; info: TLineInfo; msg: TMsgKind; arg: string) = + if error.len == 0 and msg <= errMax: + error = formatMsg(conf, info, msg, arg)) + if error.len > 0: + c.errorFlag = error + regs[ra].node = newNode(nkEmpty) + else: + regs[ra].node = ast + of opcQueryErrorFlag: + createStr regs[ra] + regs[ra].node.strVal = c.errorFlag + c.errorFlag.setLen 0 + of opcCallSite: + ensureKind(rkNode) + if c.callsite != nil: regs[ra].node = c.callsite + else: stackTrace(c, tos, pc, errFieldXNotFound & "callsite") + of opcNGetLineInfo: + decodeBImm(rkNode) + let n = regs[rb].node + 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 opcNCopyLineInfo: + decodeB(rkNode) + regs[ra].node.info = regs[rb].node.info + of opcNSetLineInfoLine: + decodeB(rkNode) + regs[ra].node.info.line = regs[rb].intVal.uint16 + of opcNSetLineInfoColumn: + decodeB(rkNode) + regs[ra].node.info.col = regs[rb].intVal.int16 + of opcNSetLineInfoFile: + decodeB(rkNode) + regs[ra].node.info.fileIndex = + fileInfoIdx(c.config, RelativeFile regs[rb].node.strVal) + of opcEqIdent: + decodeBC(rkInt) + # aliases for shorter and easier to understand code below + 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: + aStrVal = aNode.strVal.cstring + of nkIdent: + aStrVal = aNode.ident.s.cstring + of nkSym: + aStrVal = aNode.sym.name.s.cstring + of nkOpenSymChoice, nkClosedSymChoice: + aStrVal = aNode[0].sym.name.s.cstring + else: + discard + # extract strVal from argument ``b`` + case bNode.kind + of nkStrLit..nkTripleStrLit: + bStrVal = bNode.strVal.cstring + of nkIdent: + bStrVal = bNode.ident.s.cstring + of nkSym: + bStrVal = bNode.sym.name.s.cstring + of nkOpenSymChoice, nkClosedSymChoice: + bStrVal = bNode[0].sym.name.s.cstring + else: + discard + regs[ra].intVal = + if aStrVal != nil and bStrVal != nil: + ord(idents.cmpIgnoreStyle(aStrVal, bStrVal, high(int)) == 0) + else: + 0 + + of opcStrToIdent: + decodeB(rkNode) + if regs[rb].node.kind notin {nkStrLit..nkTripleStrLit}: + stackTrace(c, tos, pc, errFieldXNotFound & "strVal") + 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: + 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 + let desttyp = c.types[c.code[pc].regBx - wordExcess] + inc pc + let srctyp = c.types[c.code[pc].regBx - wordExcess] + + if opConv(c, regs[ra], regs[rb], desttyp, srctyp): + stackTrace(c, tos, pc, + errIllegalConvFromXtoY % [ + typeToString(srctyp), typeToString(desttyp)]) + of opcCast: + let rb = instr.regB + inc pc + let desttyp = c.types[c.code[pc].regBx - wordExcess] + inc pc + let srctyp = c.types[c.code[pc].regBx - wordExcess] + + when hasFFI: + 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: + decodeB(rkNode) + var dest = regs[ra].node + 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: + decodeB(rkNode) + var dest = regs[ra].node + if dest.kind in {nkFloatLit..nkFloat64Lit} and + regs[rb].kind in {rkFloat}: + dest.floatVal = regs[rb].floatVal + else: + stackTrace(c, tos, pc, errFieldXNotFound & "floatVal") + of opcNSetSymbol: + decodeB(rkNode) + var dest = regs[ra].node + if dest.kind == nkSym and regs[rb].node.kind == nkSym: + dest.sym = regs[rb].node.sym + else: + stackTrace(c, tos, pc, errFieldXNotFound & "symbol") + of opcNSetIdent: + decodeB(rkNode) + var dest = regs[ra].node + if dest.kind == nkIdent and regs[rb].node.kind == nkIdent: + dest.ident = regs[rb].node.ident + else: + stackTrace(c, tos, pc, errFieldXNotFound & "ident") + of opcNSetStrVal: + decodeB(rkNode) + var dest = regs[ra].node + if dest.kind in {nkStrLit..nkTripleStrLit} and + regs[rb].kind in {rkNode}: + dest.strVal = regs[rb].node.strVal + elif dest.kind == nkCommentStmt and regs[rb].kind in {rkNode}: + dest.comment = regs[rb].node.strVal + else: + stackTrace(c, tos, pc, errFieldXNotFound & "strVal") + of opcNNewNimNode: + decodeBC(rkNode) + var k = regs[rb].intVal + if k < 0 or k > ord(high(TNodeKind)): + internalError(c.config, c.debug[pc], + "request to create a NimNode of invalid kind") + let cc = regs[rc].node + + let x = newNodeI(TNodeKind(int(k)), + if cc.kind != nkNilLit: + cc.info + elif c.comesFromHeuristic.line != 0'u16: + c.comesFromHeuristic + elif c.callsite != nil and c.callsite.safeLen > 1: + c.callsite[1].info + else: + c.debug[pc]) + x.flags.incl nfIsRef + # prevent crashes in the compiler resulting from wrong macros: + if x.kind == nkIdent: x.ident = c.cache.emptyIdent + regs[ra].node = x + of opcNCopyNimNode: + decodeB(rkNode) + regs[ra].node = copyNode(regs[rb].node) + of opcNCopyNimTree: + decodeB(rkNode) + regs[ra].node = copyTree(regs[rb].node) + of opcNDel: + decodeBC(rkNode) + let bb = regs[rb].intVal.int + for i in 0..<regs[rc].intVal.int: + delSon(regs[ra].node, bb) + of opcGenSym: + decodeBC(rkNode) + let k = regs[rb].intVal + let name = if regs[rc].node.strVal.len == 0: ":tmp" + 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.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 {.cursor.} = regs[rb].node.strVal + regs[ra].intVal = getOrDefault(c.graph.cacheCounters, destKey) + of opcNccInc: + let g = c.graph + 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 + 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: + g.cacheSeqs[destKey].add val + recordAdd(c, c.debug[pc], destKey, val) + of opcNcsIncl: + let g = c.graph + 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: + block search: + for existing in g.cacheSeqs[destKey]: + if exprStructuralEquivalent(existing, val, strictSymEquality=true): + break search + g.cacheSeqs[destKey].add val + recordIncl(c, c.debug[pc], destKey, val) + of opcNcsLen: + let g = c.graph + decodeB(rkInt) + 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 {.cursor.} = regs[rb].node.strVal + if contains(g.cacheSeqs, destKey) and idx <% g.cacheSeqs[destKey].len: + regs[ra].node = g.cacheSeqs[destKey][idx.int] + else: + stackTrace(c, tos, pc, formatErrorIndexBound(idx, g.cacheSeqs[destKey].len-1)) + of opcNctPut: + let g = c.graph + let destKey {.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]() + if not contains(g.cacheTables[destKey], key): + g.cacheTables[destKey].add(key, val) + recordPut(c, c.debug[pc], destKey, key, val) + else: + stackTrace(c, tos, pc, "key already exists: " & key) + of opcNctLen: + let g = c.graph + decodeB(rkInt) + 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 {.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) + else: + stackTrace(c, tos, pc, "key does not exist: " & key) + else: + stackTrace(c, tos, pc, "key does not exist: " & destKey) + of opcNctHasNext: + let g = c.graph + decodeBC(rkInt) + 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)) + else: + 0 + of opcNctNext: + let g = c.graph + decodeBC(rkNode) + 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) + regs[ra].node = newTree(nkTupleConstr, newStrNode(k, c.debug[pc]), v, + newIntNode(nkIntLit, nextIndex)) + else: + stackTrace(c, tos, pc, "key does not exist: " & destKey) + + of opcTypeTrait: + # XXX only supports 'name' for now; we can use regC to encode the + # type trait operation + decodeB(rkNode) + var typ = regs[rb].node.typ + internalAssert c.config, typ != nil + while typ.kind == tyTypeDesc and typ.hasElementType: typ = typ.skipModifier + createStr regs[ra] + regs[ra].node.strVal = typ.typeToString(preferExported) + + 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.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.paramsLen != args.len: + result = nil + localError(c.config, sym.info, + "NimScript: expected $# arguments, but got $#" % [ + $(sym.typ.paramsLen), $args.len]) + else: + let start = genProc(c, sym) + + var tos = PStackFrame(prc: sym, comesFrom: 0, next: nil) + let maxSlots = sym.offset + newSeq(tos.slots, maxSlots) + + # setup parameters: + 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 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.idgen, c.module, n) + let start = genStmt(c, n) + # execute new instructions; this redundant opcEof check saves us lots + # of allocations in 'execute': + if c.code[start].opcode != opcEof: + discard execute(c, start) + +proc evalExpr*(c: PCtx, n: PNode): PNode = + # 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[s.position-1] + +proc setGlobalValue*(c: PCtx; s: PSym, val: PNode) = + ## Does not do type checking so ensure the `val` matches the `s.typ` + internalAssert c.config, s.kind in {skLet, skVar} and sfGlobal in s.flags + c.globals[s.position-1] = val + +include vmops + +proc setupGlobalCtx*(module: PSym; graph: ModuleGraph; idgen: IdGenerator) = + if graph.vm.isNil: + graph.vm = newCtx(module, graph.cache, graph, idgen) + registerAdditionalOps(PCtx graph.vm) + else: + refresh(PCtx graph.vm, module, idgen) + +proc setupEvalGen*(graph: ModuleGraph; module: PSym; idgen: IdGenerator): PPassContext = + #var c = newEvalContext(module, emRepl) + #c.features = {allowCast, allowInfiniteLoops} + #pushStackFrame(c, newStackFrame()) + + # XXX produce a new 'globals' environment here: + setupGlobalCtx(module, graph, idgen) + result = PCtx graph.vm + +proc interpreterCode*(c: PPassContext, n: PNode): PNode = + let c = PCtx(c) + # don't eval errornous code: + if c.oldErrorCount == c.config.errorCounter: + evalStmt(c, n) + result = newNodeI(nkEmpty, n.info) + else: + result = n + c.oldErrorCount = c.config.errorCounter + +proc evalConstExprAux(module: PSym; idgen: IdGenerator; + g: ModuleGraph; prc: PSym, n: PNode, + mode: TEvalMode): PNode = + when defined(nimsuggest): + if g.config.expandDone(): + return n + #if g.config.errorCounter > 0: return n + let n = transformExpr(g, idgen, module, n) + setupGlobalCtx(module, g, idgen) + var c = PCtx g.vm + let oldMode = c.mode + 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.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 prepareVMValue(arg: PNode): PNode = + ## strip nkExprColonExpr from tuple values recursively. That is how + ## they are expected to be stored in the VM. + + # Early abort without copy. No transformation takes place. + if arg.kind in nkLiterals: + return arg + + if arg.kind == nkExprColonExpr and arg[0].typ != nil and + arg[0].typ.sym != nil and arg[0].typ.sym.magic == mPNimrodNode: + # Poor mans way of protecting static NimNodes + # XXX: Maybe we need a nkNimNode? + return arg + + result = copyNode(arg) + if arg.kind == nkTupleConstr: + for child in arg: + 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: + result = TFullReg(kind: rkNone) + putIntoReg(result, prepareVMValue(x)) + else: + var n = x + if n.kind in {nkHiddenSubConv, nkHiddenStdConv}: n = n[1] + n.flags.incl nfIsRef + n.typ = x.typ + 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: + let genericParam = gp[i].sym + let posInCall = macroSym.typ.signatureLen + i + if posInCall < call.len: + yield (genericParam, call[posInCall]) + +# to prevent endless recursion in macro instantiation +const evalMacroLimit = 1000 + +#proc errorNode(idgen: IdGenerator; owner: PSym, n: PNode): PNode = +# result = newNodeI(nkEmpty, n.info) +# result.typ = newType(tyError, 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: + globalError(g.config, n.info, "macro instantiation too nested") + + # immediate macros can bypass any type and arity checking so we check the + # arity here too: + 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.paramsLen)]) + + 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) + let maxSlots = sym.offset + newSeq(tos.slots, maxSlots) + # setup arguments: + var L = n.safeLen + if L == 0: L = 1 + # This is wrong for tests/reject/tind1.nim where the passed 'else' part + # doesn't end up in the parameter: + #InternalAssert tos.slots.len >= L + + # return value: + tos.slots[0] = TFullReg(kind: rkNode, node: newNodeI(nkEmpty, n.info)) + + # setup parameters: + for i, param in paramTypes(sym.typ): + tos.slots[i-FirstParamAt+1] = setupMacroParam(n[i-FirstParamAt+1], param) + + let gp = sym.ast[genericParamsPos] + for i in 0..<gp.len: + let idx = sym.typ.signatureLen + i + if idx < n.len: + tos.slots[idx] = setupMacroParam(n[idx], gp[i].sym.typ) + else: + dec(g.config.evalMacroCounter) + c.callsite = nil + localError(c.config, n.info, "expected " & $gp.len & + " generic parameter(s)") + # temporary storage: + #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 new file mode 100644 index 000000000..bdb0aeed1 --- /dev/null +++ b/compiler/vmdef.nim @@ -0,0 +1,335 @@ +# +# +# The Nim Compiler +# (c) Copyright 2013 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## This module contains the type definitions for the new evaluation engine. +## An instruction is 1-3 int32s in memory, it is a register based VM. + +import std/[tables, strutils] + +import ast, idents, options, modulegraphs, lineinfos + +type TInstrType* = uint64 + +const + regOBits = 8 # Opcode + regABits = 16 + regBBits = 16 + regCBits = 16 + regBxBits = 24 + + byteExcess* = 128 # we use excess-K for immediates + +# 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..regAMask.int] + TDest* = range[-1..regAMask.int] + TInstr* = distinct TInstrType + + TOpcode* = enum + opcEof, # end of code + opcRet, # return + opcYldYoid, # yield with no value + opcYldVal, # yield with a value + + opcAsgnInt, + opcAsgnFloat, + opcAsgnRef, + opcAsgnComplex, + 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, + opcLdDeref, + opcWrDeref, + opcWrStrIdx, + opcLdStrIdx, # a = b[c] + opcLdStrIdxAddr, # a = addr(b[c]) + opcSlice, # toOpenArray(collection, left, right) + + opcAddInt, + opcAddImmInt, + opcSubInt, + opcSubImmInt, + opcLenSeq, + opcLenStr, + opcLenCstring, + + opcIncl, opcInclRange, opcExcl, opcCard, opcMulInt, opcDivInt, opcModInt, + opcAddFloat, opcSubFloat, opcMulFloat, opcDivFloat, + opcShrInt, opcShlInt, opcAshrInt, + opcBitandInt, opcBitorInt, opcBitxorInt, opcAddu, opcSubu, opcMulu, + opcDivu, opcModu, opcEqInt, opcLeInt, opcLtInt, opcEqFloat, + opcLeFloat, opcLtFloat, opcLeu, opcLtu, + opcEqRef, opcEqNimNode, opcSameNodeType, + opcXor, opcNot, opcUnaryMinusInt, opcUnaryMinusFloat, opcBitnotInt, + opcEqStr, opcEqCString, opcLeStr, opcLtStr, opcEqSet, opcLeSet, opcLtSet, + opcMulSet, opcPlusSet, opcMinusSet, opcConcatStr, + opcContainsSet, opcRepr, opcSetLenStr, opcSetLenSeq, + opcIsNil, opcOf, opcIs, + opcParseFloat, opcConv, opcCast, + opcQuit, opcInvalidField, + opcNarrowS, opcNarrowU, + opcSignExtend, + + opcAddStrCh, + opcAddStrStr, + opcAddSeqElem, + opcRangeChck, + + opcNAdd, + opcNAddMultiple, + opcNKind, + opcNSymKind, + opcNIntVal, + opcNFloatVal, + opcNSymbol, + opcNIdent, + opcNGetType, + opcNStrVal, + opcNSigHash, + opcNGetSize, + + opcNSetIntVal, + opcNSetFloatVal, opcNSetSymbol, opcNSetIdent, opcNSetStrVal, + opcNNewNimNode, opcNCopyNimNode, opcNCopyNimTree, opcNDel, opcGenSym, + + opcNccValue, opcNccInc, opcNcsAdd, opcNcsIncl, opcNcsLen, opcNcsAt, + opcNctPut, opcNctLen, opcNctGet, opcNctHasNext, opcNctNext, opcNodeId, + + opcSlurp, + opcGorge, + opcParseExprToAst, + opcParseStmtToAst, + opcQueryErrorFlag, + opcNError, + opcNWarning, + opcNHint, + opcNGetLineInfo, opcNCopyLineInfo, opcNSetLineInfoLine, + opcNSetLineInfoColumn, opcNSetLineInfoFile + opcEqIdent, + opcStrToIdent, + opcGetImpl, + opcGetImplTransf + + opcEcho, + opcIndCall, # dest = call regStart, n; where regStart = fn, arg1, ... + opcIndCallAsgn, # dest = call regStart, n; where regStart = fn, arg1, ... + + opcRaise, + opcNChild, + opcNSetChild, + opcCallSite, + opcNewStr, + + opcTJmp, # jump Bx if A != 0 + opcFJmp, # jump Bx if A == 0 + opcJmp, # jump Bx + opcJmpBack, # jump Bx; resulting from a while loop + opcBranch, # branch for 'case' + opcTry, + opcExcept, + opcFinally, + opcFinallyEnd, + opcNew, + opcNewSeq, + opcLdNull, # dest = nullvalue(types[Bx]) + opcLdNullReg, + opcLdConst, # dest = constants[Bx] + 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, opcNDynBindSym, + opcSetType, # dest.typ = types[Bx] + opcTypeTrait, + opcSymOwner, + opcSymIsInstantiationOf + + TBlock* = object + label*: PSym + fixups*: seq[TPosition] + + TEvalMode* = enum ## reason for evaluation + emRepl, ## evaluate because in REPL mode + emConst, ## evaluate for 'const' according to spec + emOptimize, ## evaluate for optimization purposes (same as + ## emConst?) + emStaticExpr, ## evaluate for enforced compile time eval + ## ('static' context) + emStaticStmt ## 'static' as an expression + + TSandboxFlag* = enum ## what the evaluation engine should allow + allowCast, ## allow unsafe language feature: 'cast' + allowInfiniteLoops ## allow endless loops + TSandboxFlags* = set[TSandboxFlag] + + TSlotKind* = enum # We try to re-use slots in a smart way to + # minimize allocations; however the VM supports arbitrary + # temporary slot usage. This is required for the parameter + # passing implementation. + slotEmpty, # slot is unused + slotFixedVar, # slot is used for a fixed var/result (requires copy then) + slotFixedLet, # slot is used for a fixed param/let + slotTempUnknown, # slot but type unknown (argument of proc call) + slotTempInt, # some temporary int + slotTempFloat, # some temporary float + slotTempStr, # some temporary string + 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 + regInfo*: seq[tuple[inUse: bool, kind: TSlotKind]] + + VmArgs* = object + ra*, rb*, rc*: Natural + slots*: ptr UncheckedArray[TFullReg] + currentException*: PNode + currentLineInfo*: TLineInfo + VmCallback* = proc (args: VmArgs) {.closure.} + + PCtx* = ref TCtx + 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 + globals*: PNode # + constants*: PNode # constant data + types*: seq[PType] # some instructions reference types (e.g. 'except') + currentExceptionA*, currentExceptionB*: PNode + exceptionInstr*: int # index of instruction that raised the exception + prc*: PProc + module*: PSym + callsite*: PNode + mode*: TEvalMode + features*: TSandboxFlags + traceActive*: bool + loopIterations*: int + comesFromHeuristic*: TLineInfo # Heuristic for better macro stack traces + 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; idgen: IdGenerator): PCtx = + PCtx(code: @[], debug: @[], + globals: newNode(nkStmtListExpr), constants: newNode(nkStmtList), types: @[], + 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; idgen: IdGenerator) = + c.module = module + c.prc = PProc(blocks: @[]) + 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: + 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.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 new file mode 100644 index 000000000..294aaaa79 --- /dev/null +++ b/compiler/vmdeps.nim @@ -0,0 +1,334 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +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).string + result = readFile(filename) + # we produce a fake include statement for every slurped filename, so that + # the module dependencies are accurate: + 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; + idgen: IdGenerator): PNode = + let sym = newSym(skType, getIdent(cache, name), idgen, t.owner, info) + sym.magic = m + sym.typ = t + result = newSymNode(sym) + result.typ = t + +proc atomicTypeX(s: PSym; info: TLineInfo): PNode = + result = newSymNode(s) + result.info = info + +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, 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, a, info, idgen, inst) + +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, 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], 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, idgen) + template atomicType(s): untyped = atomicTypeX(s, info) + template mapTypeToAst(t, info): untyped = mapTypeToAstX(cache, t, info, idgen, inst) + template mapTypeToAstR(t, info): untyped = mapTypeToAstX(cache, t, info, idgen, inst, true) + template mapTypeToAst(t, i, info): untyped = + 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, idgen, inst) + template newNodeX(kind): untyped = + newNodeIT(kind, if t.n.isNil: info else: t.n.info, t) + template newIdentDefs(n,t): untyped = + var id = newNodeX(nkIdentDefs) + id.add n # name + id.add mapTypeToAst(t, info) # type + id.add newNodeI(nkEmpty, info) # no assigned value + id + template newIdentDefs(s): untyped = newIdentDefs(s, s.typ) + + 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 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.indexType.kind == tyRange: + var rng = newNodeX(nkInfix) + rng.add newIdentNode(getIdent(cache, ".."), info) + rng.add t.indexType.n[0].copyTree + rng.add t.indexType.n[1].copyTree + result.add rng + else: + 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) + result.add atomicType("typeDesc", mTypeDesc) + result.add mapTypeToAst(t.base, info) + else: + result = atomicType("typeDesc", mTypeDesc) + of tyGenericInvocation: + result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) + for a in t.kids: + result.add mapTypeToAst(a, info) + of tyGenericInst: + if inst: + if allowRecursion: + 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.last, info) + result.add mapTypeToAst(t.genericHead, info) + for _, a in t.genericInstParams: + result.add mapTypeToAst(a, info) + else: + 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.typeBodyImpl, info) + else: + result = mapTypeToAst(t.typeBodyImpl, info) + of tyAlias: + result = mapTypeToAstX(cache, t.skipModifier, info, idgen, inst, allowRecursion) + of tyOrdinal: + result = mapTypeToAst(t.skipModifier, info) + of tyDistinct: + if inst: + result = newNodeX(nkDistinctTy) + result.add mapTypeToAst(t.skipModifier, info) + else: + if allowRecursion or t.sym == nil: + result = mapTypeToBracket("distinct", mDistinct, t, info) + else: + result = atomicType(t.sym) + of tyGenericParam, tyForward: + result = atomicType(t.sym) + of tyObject: + if inst: + result = newNodeX(nkObjectTy) + 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.baseClass, info) + result.add nn + if t.n.len > 0: + 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.baseClass == nil: + result.add newNodeI(nkEmpty, info) + else: + result.add mapTypeToAst(t.baseClass, info) + result.add copyTree(t.n) + else: + result = atomicType(t.sym) + of tyEnum: + result = newNodeIT(nkEnumTy, if t.n.isNil: info else: t.n.info, t) + result.add newNodeI(nkEmpty, info) # pragma node, currently always empty for enum + for c in t.n.sons: + result.add copyTree(c) + of tyTuple: + if inst: + # only named tuples have a node, unnamed tuples don't + if t.n.isNil: + result = newNodeX(nkTupleConstr) + for subType in t.kids: + result.add mapTypeToAst(subType, info) + else: + result = newNodeX(nkTupleTy) + for s in t.n.sons: + result.add newIdentDefs(s) + else: + result = mapTypeToBracket("tuple", mTuple, t, info) + of tySet: result = mapTypeToBracket("set", mSet, t, info) + of tyPtr: + if inst: + result = newNodeX(nkPtrTy) + result.add mapTypeToAst(t.elementType, info) + else: + result = mapTypeToBracket("ptr", mPtr, t, info) + of tyRef: + if inst: + result = newNodeX(nkRefTy) + result.add mapTypeToAst(t.elementType, info) + else: + result = mapTypeToBracket("ref", mRef, t, info) + of tyVar: + if inst: + result = newNodeX(nkVarTy) + 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 tyProc: + if inst: + result = newNodeX(if tfIterator in t.flags: nkIteratorTy else: nkProcTy) + var fp = newNodeX(nkFormalParams) + if t.returnType == nil: + fp.add newNodeI(nkEmpty, info) + else: + 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 + 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) + 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 tyInt: result = atomicType("int", mInt) + of tyInt8: result = atomicType("int8", mInt8) + of tyInt16: result = atomicType("int16", mInt16) + of tyInt32: result = atomicType("int32", mInt32) + of tyInt64: result = atomicType("int64", mInt64) + of tyFloat: result = atomicType("float", mFloat) + 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 tyVarargs: result = mapTypeToBracket("varargs", mVarargs, t, info) + of tyError: result = atomicType("error", mNone) + of tyBuiltInTypeClass: + result = mapTypeToBracket("builtinTypeClass", mNone, t, info) + of tyUserTypeClass, tyUserTypeClassInst: + if t.isResolvedUserTypeClass: + result = mapTypeToAst(t.last, info) + else: + result = mapTypeToBracket("concept", mNone, t, info) + result.add t.n.copyTree + of tyCompositeTypeClass: + result = mapTypeToBracket("compositeTypeClass", mNone, t, info) + 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: result = mapTypeToAstX(cache, t.skipModifier, info, idgen, inst, allowRecursion) + of tyStatic, tyFromExpr: + if inst: + if t.n != nil: result = t.n.copyTree + else: result = atomicType("void", mVoid) + else: + result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) + result.add atomicType("static", mNone) + if t.n != nil: + result.add t.n.copyTree + 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; 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; 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; idgen: IdGenerator): PNode = + result = mapTypeToAstX(cache, t, info, idgen, inst=true, allowRecursionX=true) diff --git a/compiler/vmgen.nim b/compiler/vmgen.nim new file mode 100644 index 000000000..0c7a49984 --- /dev/null +++ b/compiler/vmgen.nim @@ -0,0 +1,2445 @@ +# +# +# 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 code generator for the VM. + +# Important things to remember: +# - The VM does not distinguish between definitions ('var x = y') and +# assignments ('x = y'). For simple data types that fit into a register +# 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: +# ```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 +# wrong! We need to produce opcAsgn (the copy) for the *store*. This also +# 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 + 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 + 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 = 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) + for i in start..last: + let x = c.code[i] + if x.opcode in relativeJumps: + jumpTargets.incl(i+x.regBx-wordExcess) + + 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) + let x = c.code[i] + + result.add($i) + let opc = opcode(x) + 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.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.toStr, x.regA, + x.regB, x.regC) + 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.toStr, x.regA, + c.constants[idx].renderTree, $idx) + else: + 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: 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.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() + echo "generating ", opc + ctx.code.add(ins) + 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`, 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.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: + localError(c.config, n.info, + "VM: immediate value does not fit into an int8") + +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 [regBxMin, regBxMax] + when false: + if c.code.len == 43: + writeStackTrace() + echo "generating ", opc + + 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 regBx") + +proc xjmp(c: PCtx; n: PNode; opc: TOpcode; a: TRegister = 0): TPosition = + #assert opc in {opcJmp, opcFJmp, opcTJmp} + result = TPosition(c.code.len) + gABx(c, n, opc, a, 0) + +proc genLabel(c: PCtx): TPosition = + result = TPosition(c.code.len) + #c.jumpTargets.incl(c.code.len) + +proc jmpBack(c: PCtx, n: PNode, p = TPosition(0)) = + let dist = p.int - c.code.len + internalAssert(c.config, regBxMin < dist and dist < regBxMax) + gABx(c, n, opcJmpBack, 0, dist) + +proc patch(c: PCtx, p: TPosition) = + # patch with current index + let p = p.int + let diff = c.code.len - p + #c.jumpTargets.incl(c.code.len) + internalAssert(c.config, regBxMin < diff and diff < regBxMax) + let oldInstr = c.code[p] + # opcode and regA stay the same: + 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: + slotTempStr + of tyFloat..tyFloat128: + slotTempFloat + else: + slotTempComplex + +const + HighRegisterPressure = 40 + +proc bestEffort(c: PCtx): TLineInfo = + if c.prc != nil and c.prc.sym != nil: + c.prc.sym.info + else: + c.module.info + +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]: + 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.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.regInfo.len >= high(TRegister): + globalError(cc.config, cc.bestEffort, "VM problem: too many registers required") + 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 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 + # 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.regInfo[j].inUse: break search + result = TRegister(i) + for k in result..result+n-1: c.regInfo[k] = (inUse: true, kind: kind) + return + if c.regInfo.len+n >= high(TRegister): + globalError(cc.config, cc.bestEffort, "VM problem: too many registers required") + 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)) + +template withTemp(tmp, typ, body: untyped) {.dirty.} = + var tmp = getTemp(c, typ) + body + c.freeTemp(tmp) + +proc popBlock(c: PCtx; oldLen: int) = + for f in c.prc.blocks[oldLen].fixups: + c.patch(f) + c.prc.blocks.setLen(oldLen) + +template withBlock(labl: PSym; body: untyped) {.dirty.} = + var oldLen {.gensym.} = c.prc.blocks.len + c.prc.blocks.add TBlock(label: labl, fixups: @[]) + body + popBlock(c, oldLen) + +proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) +proc gen(c: PCtx; n: PNode; dest: TRegister; flags: TGenFlags = {}) = + var d: TDest = dest + gen(c, n, d, flags) + #internalAssert c.config, d == dest # issue #7407 + +proc gen(c: PCtx; n: PNode; flags: TGenFlags = {}) = + var tmp: TDest = -1 + gen(c, n, tmp, flags) + 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 + gen(c, n, tmp, flags) + #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. + # So we only set dest to -1 if 'void': + if dest >= 0 and (n.typ.isNil or n.typ.kind == tyVoid): + c.freeTemp(dest) + dest = -1 + +proc isNotOpr(n: PNode): bool = + n.kind in nkCallKinds and n[0].kind == nkSym and + n[0].sym.magic == mNot + +proc genWhile(c: PCtx; n: PNode) = + # lab1: + # cond, tmp + # fjmp tmp, lab2 + # body + # jmp lab1 + # lab2: + let lab1 = c.genLabel + withBlock(nil): + 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[1]) + c.jmpBack(n, lab1) + c.patch(lab2) + else: + var tmp = c.genx(n[0]) + let lab2 = c.xjmp(n, opcFJmp, tmp) + c.freeTemp(tmp) + c.gen(n[1]) + c.jmpBack(n, lab1) + c.patch(lab2) + +proc genBlock(c: PCtx; n: PNode; dest: var TDest) = + 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 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[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 lab1 + +proc genIf(c: PCtx, n: PNode; dest: var TDest) = + # if (!expr1) goto lab1; + # thenPart + # goto LEnd + # lab1: + # if (!expr2) goto lab2; + # thenPart2 + # goto LEnd + # lab2: + # elsePart + # Lend: + if dest < 0 and not isEmptyType(n.typ): dest = getTemp(c, n.typ) + var endings: seq[TPosition] = @[] + for i in 0..<n.len: + var it = n[i] + if it.len == 2: + withTemp(tmp, it[0].typ): + var elsePos: TPosition + if isNotOpr(it[0]): + c.gen(it[0][1], tmp) + elsePos = c.xjmp(it[0][1], opcTJmp, tmp) # if true + else: + c.gen(it[0], tmp) + elsePos = c.xjmp(it[0], opcFJmp, tmp) # if false + c.clearDest(n, dest) + 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) + 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 lab1 + # asgn dest, b + # 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 + n.flags.excl nfIsRef + c.constants.add n + internalAssert c.config, result < regBxMax + +proc sameConstant*(a, b: PNode): bool = + result = false + if a == b: + result = true + elif a != nil and b != nil and a.kind == b.kind: + case a.kind + 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 = 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 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: + if sameConstant(c.constants[i], n): return i + result = rawGenLiteral(c, n) + +proc unused(c: PCtx; n: PNode; x: TDest) {.inline.} = + if x >= 0: + #debug(n) + globalError(c.config, n.info, "not unused") + +proc genCase(c: PCtx; n: PNode; dest: var TDest) = + # if (!expr1) goto lab1; + # thenPart + # goto LEnd + # lab1: + # if (!expr2) goto lab2; + # thenPart2 + # goto LEnd + # lab2: + # elsePart + # Lend: + if not isEmptyType(n.typ): + if dest < 0: dest = getTemp(c, n.typ) + else: + unused(c, n, dest) + var endings: seq[TPosition] = @[] + withTemp(tmp, n[0].typ): + c.gen(n[0], tmp) + # branch tmp, codeIdx + # fjmp elseLabel + for i in 1..<n.len: + let it = n[i] + if it.len == 1: + # else stmt: + 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 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) + +proc genType(c: PCtx; typ: PType): int = + for i, t in c.types: + if sameType(t, typ): return i + result = c.types.len + c.types.add(typ) + 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 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) + # 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: + # first opcExcept contains the end label of the 'except' block: + let endExcept = c.xjmp(it, opcExcept, 0) + 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 it.len == 1: + # general except section: + c.gABx(it, opcExcept, 0, 0) + let body = it.lastSon + if isEmptyType(body.typ): # maybe noreturn call, don't touch `dest` + c.gen(body) + else: + c.gen(body, dest) + c.clearDest(n, dest) + if i < n.len: + endings.add(c.xjmp(it, opcJmp, 0)) + c.patch(endExcept) + let fin = lastSon(n) + # we always generate an 'opcFinally' as that pops the safepoint + # 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[0]) + c.clearDest(n, dest) + c.gABx(fin, opcFinallyEnd, 0, 0) + +proc genRaise(c: PCtx; n: PNode) = + let dest = genx(c, n[0]) + c.gABC(n, opcRaise, dest) + c.freeTemp(dest) + +proc genReturn(c: PCtx; n: PNode) = + if n[0].kind != nkEmpty: + gen(c, n[0]) + c.gABC(n, opcRet) + + +proc genLit(c: PCtx; n: PNode; dest: var TDest) = + # opcLdConst is now always valid. We produce the necessary copy in the + # assignments now: + #var opc = opcLdConst + if dest < 0: dest = c.getTemp(n.typ) + #elif c.prc.regInfo[dest].kind == slotFixedVar: opc = opcAsgnConst + let lit = genLiteral(c, n) + c.gABx(n, opcLdConst, dest, lit) + +proc genCall(c: PCtx; n: PNode; dest: var TDest) = + # it can happen that due to inlining we have a 'n' that should be + # treated as a constant (see issue #537). + #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[0].typ, abstractInst) + for i in 0..<n.len: + var r: TRegister = x+i + if i >= fntyp.signatureLen: + c.gen(n[i], r, {gfIsParam}) + internalAssert c.config, tfVarargs in fntyp.flags + c.gABx(n, opcSetType, r, c.genType(n[i].typ)) + else: + if fntyp[i] != nil and fntyp[i].kind == tySink and + fntyp[i].skipTypes({tySink}).kind in {tyObject, tyString, tySequence}: + c.gen(n[i], r, {gfIsSinkParam}) + else: + c.gen(n[i], r, {gfIsParam}) + + if dest < 0: + c.gABC(n, opcIndCall, 0, x, n.len) + else: + c.gABC(n, opcIndCallAsgn, dest, x, n.len) + c.freeTempRange(x, n.len) + +template isGlobal(s: PSym): bool = sfGlobal in s.flags and s.kind != skForVar +proc isGlobal(n: PNode): bool = n.kind == nkSym and isGlobal(n.sym) + +proc needsAsgnPatch(n: PNode): bool = + n.kind in {nkBracketExpr, nkDotExpr, nkCheckedFieldExpr, + nkDerefExpr, nkHiddenDeref} or (n.kind == nkSym and n.sym.isGlobal) + +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(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 != 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, 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[0], {gfNode}) + idx = c.genIndex(le[1], le[0].typ) + collTyp = le[0].typ.skipTypes(abstractVarRange-{tyTypeDesc}) + + case collTyp.kind + of tyString, tyCstring: + c.gABC(le, opcWrStrIdx, dest, idx, value) + of tyTuple: + c.gABC(le, opcWrObj, dest, int le[1].intVal, value) + else: + c.gABC(le, opcWrArr, dest, idx, value) + + c.freeTemp(dest) + c.freeTemp(idx) + of nkCheckedFieldExpr: + 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[0], {gfNode}) + c.gABC(le, opcWrDeref, dest, 0, value) + c.freeTemp(dest) + of nkSym: + if le.sym.isGlobal: + 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[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[1].typ.skipTypes(abstractVar-{tyTypeDesc})[0])) + c.genAsgnPatch(n[1], dest) + c.freeTemp(dest) + +proc genNewSeq(c: PCtx; n: PNode) = + 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[1], dest) + c.freeTemp(dest) + +proc genNewSeqOfCap(c: PCtx; n: PNode; dest: var TDest) = + let t = n.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( + abstractVar-{tyTypeDesc}))) + c.gABx(n, opcNewSeq, tmp, 0) + c.freeTemp(tmp) + +proc genUnaryABC(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode) = + 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[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[1]) + tmp2 = c.genx(n[2]) + if dest < 0: dest = c.getTemp(n.typ) + c.gABC(n, opc, dest, tmp, tmp2) + c.freeTemp(tmp) + c.freeTemp(tmp2) + +proc genBinaryABCD(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode) = + let + 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) + c.freeTemp(tmp) + 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: + 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 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) + genNarrow(c, n, dest) + +proc genBinaryABCnarrowU(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode) = + genBinaryABC(c, n, dest, opc) + genNarrowU(c, n, dest) + +proc genSetType(c: PCtx; n: PNode; dest: TRegister) = + let t = skipTypes(n.typ, abstractInst-{tyTypeDesc}) + if t.kind == tySet: + c.gABx(n, opcSetType, dest, c.genType(t)) + +proc genBinarySet(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode) = + let + tmp = c.genx(n[1]) + tmp2 = c.genx(n[2]) + if dest < 0: dest = c.getTemp(n.typ) + 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[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[1] + if x.kind in {nkAddr, nkHiddenAddr}: x = x[0] + let + dest = c.genx(x) + tmp = c.genx(n[2]) + c.gABC(n, opc, dest, tmp, 0) + #c.genAsgnPatch(n[1], dest) + c.freeTemp(tmp) + c.freeTemp(dest) + +proc genUnaryStmt(c: PCtx; n: PNode; opc: TOpcode) = + 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: + var r: TRegister = x+i-1 + c.gen(n[i], r) + c.gABC(n, opc, dest, x, n.len-1) + c.freeTempRange(x, n.len-1) + +proc isInt8Lit(n: PNode): bool = + if n.kind in {nkCharLit..nkUInt64Lit}: + result = n.intVal >= low(int8) and n.intVal <= high(int8) + else: + result = false + +proc isInt16Lit(n: PNode): bool = + if n.kind in {nkCharLit..nkUInt64Lit}: + result = n.intVal >= low(int16) and n.intVal <= high(int16) + else: + result = false + +proc genAddSubInt(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode) = + if n[2].isInt8Lit: + let tmp = c.genx(n[1]) + if dest < 0: dest = c.getTemp(n.typ) + 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, 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) + c.gABx(n, opc, 0, genType(c, n.typ.skipTypes({tyStatic}))) + c.gABx(n, opc, 0, genType(c, arg.typ.skipTypes({tyStatic}))) + c.freeTemp(tmp) + +proc genCard(c: PCtx; n: PNode; dest: var TDest) = + let tmp = c.genx(n[1]) + if dest < 0: dest = c.getTemp(n.typ) + c.genSetType(n[1], tmp) + c.gABC(n, opcCard, dest, tmp) + c.freeTemp(tmp) + +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) + 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, opcCastIntToFloat64, dest, tmp) + c.freeTemp(tmp) + + 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: + # 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) + var + tmp1 = c.genx(n[1]) + tmp2 = c.genx(n[2]) + tmp3 = c.genx(n[3]) + c.gABC(n, opcode, tmp1, tmp2, tmp3) + c.freeTemp(tmp1) + c.freeTemp(tmp2) + c.freeTemp(tmp3) + +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 mPred, mSubI: + c.genAddSubInt(n, dest, opcSubInt) + of mSucc, mAddI: + c.genAddSubInt(n, dest, opcAddInt) + of mInc, mDec: + unused(c, n, dest) + 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[2]) + c.gABC(n, opc, d, d, tmp) + c.freeTemp(tmp) + c.genNarrow(n[1], d) + c.genAsgnPatch(n[1], d) + c.freeTemp(d) + 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) + of mNewSeq: + unused(c, n, dest) + c.genNewSeq(n) + of mNewSeqOfCap: c.genNewSeqOfCap(n, dest) + of mNewString: + genUnaryABC(c, n, dest, opcNewStr) + # XXX buggy + of mNewStringOfCap: + # we ignore the 'cap' argument and translate it as 'newString(0)'. + # 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: + genUnaryABI(c, n, dest, opcLenSeq) + 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[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) + of mCard: genCard(c, n, dest) + of mMulI: genBinaryABCnarrow(c, n, dest, opcMulInt) + of mDivI: genBinaryABCnarrow(c, n, dest, opcDivInt) + of mModI: genBinaryABCnarrow(c, n, dest, opcModInt) + of mAddF64: genBinaryABC(c, n, dest, opcAddFloat) + of mSubF64: genBinaryABC(c, n, dest, opcSubFloat) + of mMulF64: genBinaryABC(c, n, dest, opcMulFloat) + of mDivF64: genBinaryABC(c, n, dest, opcDivFloat) + of mShrI: + # 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: + 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) + of mDivU: genBinaryABCnarrowU(c, n, dest, opcDivu) + of mModU: genBinaryABCnarrowU(c, n, dest, opcModu) + of mEqI, mEqB, mEqEnum, mEqCh: + genBinaryABC(c, n, dest, opcEqInt) + of mLeI, mLeEnum, mLeCh, mLeB: + genBinaryABC(c, n, dest, opcLeInt) + of mLtI, mLtEnum, mLtCh, mLtB: + genBinaryABC(c, n, dest, opcLtInt) + of mEqF64: genBinaryABC(c, n, dest, opcEqFloat) + of mLeF64: genBinaryABC(c, n, dest, opcLeFloat) + of mLtF64: genBinaryABC(c, n, dest, opcLtFloat) + 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: 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[1], dest) + of mBitnotI: + genUnaryABC(c, n, dest, opcBitnotInt) + #genNarrowU modified, do not narrow signed types + 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)) + 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) + of mLeSet: genBinarySet(c, n, dest, opcLeSet) + of mLtSet: genBinarySet(c, n, dest, opcLtSet) + of mMulSet: genBinarySet(c, n, dest, opcMulSet) + of mPlusSet: genBinarySet(c, n, dest, opcPlusSet) + of mMinusSet: genBinarySet(c, n, dest, opcMinusSet) + 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[1]) + c.gABC(n, opcQuit, tmp) + c.freeTemp(tmp) + of mSetLengthStr, mSetLengthSeq: + unused(c, n, dest) + 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[1], d) + c.freeTemp(tmp) + c.freeTemp(d) + of mSwap: + unused(c, n, dest) + 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 mParseBiggestFloat: + if dest < 0: dest = c.getTemp(n.typ) + var d2: TRegister + # skip 'nkHiddenAddr': + 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[1]) + c.gABC(n, opcParseFloat, dest, tmp1, d2) + c.freeTemp(tmp1) + c.genAsgnPatch(d2AsNode, d2) + c.freeTemp(d2) + 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[1]) + var idx = c.getTemp(getSysType(c.graph, n.info, tyInt)) + 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 mHigh: + if dest < 0: dest = c.getTemp(n.typ) + 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 + 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) + of mAppendStrStr: + unused(c, n, dest) + genBinaryStmtVar(c, n, opcAddStrStr) + of mAppendSeqElem: + unused(c, n, dest) + genBinaryStmtVar(c, n, opcAddSeqElem) + of mParseExprToAst: + genBinaryABC(c, n, dest, opcParseExprToAst) + of mParseStmtToAst: + genBinaryABC(c, n, dest, opcParseStmtToAst) + of mTypeTrait: + let tmp = c.genx(n[1]) + if dest < 0: dest = c.getTemp(n.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) + of mNAdd: genBinaryABC(c, n, dest, opcNAdd) + of mNAddMultiple: genBinaryABC(c, n, dest, opcNAddMultiple) + of mNKind: genUnaryABC(c, n, dest, opcNKind) + of mNSymKind: genUnaryABC(c, n, dest, opcNSymKind) + + of mNccValue: genUnaryABC(c, n, dest, opcNccValue) + of mNccInc: genBinaryABC(c, n, dest, opcNccInc) + of mNcsAdd: genBinaryABC(c, n, dest, opcNcsAdd) + of mNcsIncl: genBinaryABC(c, n, dest, opcNcsIncl) + of mNcsLen: genUnaryABC(c, n, dest, opcNcsLen) + of mNcsAt: genBinaryABC(c, n, dest, opcNcsAt) + of mNctPut: genVoidABC(c, n, dest, opcNctPut) + of mNctLen: genUnaryABC(c, n, dest, opcNctLen) + of mNctGet: genBinaryABC(c, n, dest, opcNctGet) + of mNctHasNext: genBinaryABC(c, n, dest, opcNctHasNext) + of mNctNext: genBinaryABC(c, n, dest, opcNctNext) + + of mNIntVal: genUnaryABC(c, n, dest, opcNIntVal) + of mNFloatVal: genUnaryABC(c, n, dest, opcNFloatVal) + of mNSymbol: genUnaryABC(c, n, dest, opcNSymbol) + of mNIdent: genUnaryABC(c, n, dest, opcNIdent) + of mNGetType: + 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 + of "typeKind": 1 + of "getTypeInst": 2 + else: 3 # "getTypeImpl" + 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) + of mNSetFloatVal: + unused(c, n, dest) + genBinaryStmt(c, n, opcNSetFloatVal) + of mNSetSymbol: + unused(c, n, dest) + genBinaryStmt(c, n, opcNSetSymbol) + of mNSetIdent: + unused(c, n, dest) + genBinaryStmt(c, n, opcNSetIdent) + 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: genBindSym(c, n, dest) + of mStrToIdent: genUnaryABC(c, n, dest, opcStrToIdent) + of mEqIdent: genBinaryABC(c, n, dest, opcEqIdent) + of mEqNimrodNode: genBinaryABC(c, n, dest, opcEqNimNode) + of mSameNodeType: genBinaryABC(c, n, dest, opcSameNodeType) + of mNLineInfo: + case n[0].sym.name.s + 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) + genBinaryStmt(c, n, opcNHint) + of mNWarning: + unused(c, n, dest) + genBinaryStmt(c, n, opcNWarning) + of mNError: + if n.len <= 1: + # query error condition: + c.gABC(n, opcQueryErrorFlag, dest) + else: + # setter + unused(c, n, dest) + genBinaryStmt(c, n, opcNError) + of mNCallSite: + if dest < 0: dest = c.getTemp(n.typ) + c.gABC(n, opcCallSite, dest) + of mNGenSym: genBinaryABC(c, n, dest, opcGenSym) + 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[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" + if dest < 0: dest = c.getTemp(n.typ) + c.genCall(arg, dest) + # do not call clearDest(n, dest) here as getAst has a meta-type as such + # produces a value + else: + globalError(c.config, n.info, "expandToAst requires a call expression") + 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 unneededIndirection(n: PNode): bool = + n.typ.skipTypes(abstractInstOwned-{tyTypeDesc}).kind == tyRef + +proc canElimAddr(n: PNode; idgen: IdGenerator): PNode = + result = nil + case n[0].kind + of nkObjUpConv, nkObjDownConv, nkChckRange, nkChckRangeF, nkChckRange64: + var m = n[0][0] + if m.kind in {nkDerefExpr, nkHiddenDeref}: + # addr ( nkConv ( deref ( x ) ) ) --> nkConv(x) + result = copyNode(n[0]) + result.add m[0] + if n.typ.skipTypes(abstractVar).kind != tyOpenArray: + result.typ = n.typ + elif n.typ.skipTypes(abstractInst).kind in {tyVar}: + result.typ = toVar(result.typ, n.typ.skipTypes(abstractInst).kind, idgen) + of nkHiddenStdConv, nkHiddenSubConv, nkConv: + var m = n[0][1] + if m.kind in {nkDerefExpr, nkHiddenDeref}: + # addr ( nkConv ( deref ( x ) ) ) --> nkConv(x) + result = copyNode(n[0]) + result.add n[0][0] + result.add m[0] + if n.typ.skipTypes(abstractVar).kind != tyOpenArray: + result.typ = n.typ + elif n.typ.skipTypes(abstractInst).kind in {tyVar}: + result.typ = toVar(result.typ, n.typ.skipTypes(abstractInst).kind, idgen) + else: + if n[0].kind in {nkDerefExpr, nkHiddenDeref}: + # addr ( deref ( x )) --> x + result = n[0][0] + +proc genAddr(c: PCtx, n: PNode, dest: var TDest, flags: TGenFlags) = + if (let m = canElimAddr(n, c.idgen); m != nil): + gen(c, m, dest, flags) + return + + 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[0], newflags) + if dest < 0: dest = c.getTemp(n.typ) + 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.regInfo[tmp].kind = slotTempPerm + # XXX this is still a hack + #message(c.congig, n.info, warnUser, "suspicious opcode used") + else: + gABC(c, n, opcAddrReg, dest, tmp) + c.freeTemp(tmp) + +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: + 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, requiresCopy), dest, tmp) + c.freeTemp(tmp) + +proc setSlot(c: PCtx; v: PSym) = + # XXX generate type initialization here? + if v.position == 0: + v.position = getFreeRegister(c, if v.kind == skLet: slotFixedLet else: slotFixedVar, start = 1) + +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 + a = a.owner + +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: + # 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) + +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) + c.gABC(n, opc, dest, idx, cc) + c.freeTemp(cc) + +proc preventFalseAlias(c: PCtx; n: PNode; opc: TOpcode; + dest, idx, value: TRegister) = + # opcLdObj et al really means "load address". We sometimes have to create a + # copy in order to not introduce false aliasing: + # mylocal = a.b # needs a copy of the data! + assert n.typ != nil + if needsAdditionalCopy(n): + genAdditionalCopy(c, n, opc, dest, idx, value) + else: + c.gABC(n, opc, dest, idx, value) + +proc genAsgn(c: PCtx; le, ri: PNode; requiresCopy: bool) = + case le.kind + of nkBracketExpr: + 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) + 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(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[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, {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}) + 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) + c.freeTemp(cc) + else: + gen(c, ri, dest) + of nkHiddenStdConv, nkHiddenSubConv, nkConv: + if sameBackendType(le.typ, le[1].typ): + genAsgn(c, le[1], ri, requiresCopy) + else: + let dest = c.genx(le, {gfNodeAddr}) + genAsgn(c, dest, ri, requiresCopy) + 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 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' without --experimental:compiletimeFFI") + else: + localError(c.config, info, + "cannot 'importc' variable at compile time; " & s.name.s) + +proc getNullValue*(c: PCtx; typ: PType, info: TLineInfo; conf: ConfigRef): PNode + +proc genGlobalInit(c: PCtx; n: PNode; s: PSym) = + 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.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: + 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 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 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) + 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}): + if dest < 0: + dest = s.position + ord(s.kind == skParam) + internalAssert(c.config, c.prc.regInfo.len > dest and c.prc.regInfo[dest].kind < slotSomeTemp) + else: + # we need to generate an assignment: + let requiresCopy = c.prc.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 = + {gfNode, gfNodeAddr} * flags == {} and + fitsRegister(n.typ.skipTypes({tyVar, tyLent, tyStatic})) + +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 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(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 genObjAccessAux(c: PCtx; n: PNode; a, b: int, dest: var TDest; flags: TGenFlags) = + if dest < 0: dest = c.getTemp(n.typ) + if {gfNodeAddr} * flags != {}: + c.gABC(n, opcLdObjAddr, dest, a, b) + elif needsRegLoad(): + var cc = c.getTemp(n.typ) + c.gABC(n, opcLdObj, cc, a, b) + c.gABC(n, opcNodeToReg, dest, cc) + c.freeTemp(cc) + else: + 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) = + 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[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: + let opc = if gfNodeAddr in flags: opcLdArrAddr else: opcLdArr + genArrAccessOpcode(c, n, dest, opc, flags) + +proc getNullValueAux(c: PCtx; t: PType; obj: PNode, result: PNode; conf: ConfigRef; currPosition: var int) = + if t != nil and t.baseClass != nil: + let b = skipTypes(t.baseClass, skipPtrs) + getNullValueAux(c, b, b.n, result, conf, currPosition) + case obj.kind + of nkRecList: + for i in 0..<obj.len: getNullValueAux(c, nil, obj[i], result, conf, currPosition) + of nkRecCase: + 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) + 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(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) + of tyUInt..tyUInt64: + result = newNodeIT(nkUIntLit, info, t) + of tyFloat..tyFloat128: + result = newNodeIT(nkFloatLit, info, t) + of tyString: + result = newNodeIT(nkStrLit, info, t) + result.strVal = "" + 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, getSysType(c.graph, info, tyPointer))) + result.add(newNodeIT(nkNilLit, info, getSysType(c.graph, info, tyPointer))) + of tyObject: + result = newNodeIT(nkObjConstr, info, t) + result.add(newNodeIT(nkEmpty, info, t)) + # initialize inherited fields, and all in the correct order: + var currPosition = 0 + getNullValueAux(c, t, t.n, result, conf, currPosition) + of tyArray: + result = newNodeIT(nkBracket, info, t) + for i in 0..<toInt(lengthOrd(conf, t)): + result.add getNullValue(c, elemType(t), info, conf) + of tyTuple: + result = newNodeIT(nkTupleConstr, info, t) + for a in t.kids: + result.add getNullValue(c, a, info, conf) + of tySet: + result = newNodeIT(nkCurly, info, t) + of tySequence, tyOpenArray: + result = newNodeIT(nkBracket, info, t) + else: + globalError(conf, info, "cannot create null element for: " & $t.kind) + result = newNodeI(nkEmpty, info) + +proc genVarSection(c: PCtx; n: PNode) = + for a in n: + if a.kind == nkCommentStmt: continue + #assert(a[0].kind == nkSym) can happen for transformed vars + if a.kind == nkVarTuple: + 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 importcCond(c, s): c.importcSym(a.info, s) + else: + let sa = getNullValue(c, s.typ, a.info, c.config) + #if s.ast.isNil: getNullValue(s.typ, a.info) + #else: s.ast + assert sa.kind != nkCall + c.globals.add(sa) + s.position = c.globals.len + if runtimeAccessToCompileTime: + discard + elif a[2].kind != nkEmpty: + let tmp = c.genx(a[0], {gfNodeAddr}) + let val = c.genx(a[2]) + c.genAdditionalCopy(a[2], opcWrDeref, tmp, 0, val) + c.freeTemp(val) + c.freeTemp(tmp) + elif not importcCondVar(s) and not (s.typ.kind == tyProc and s.typ.callConv == ccClosure) and + sfPure notin s.flags: # fixes #10938 + # there is a pre-existing issue with closure types in VM + # if `(var s: proc () = default(proc ()); doAssert s == nil)` works for you; + # you might remove the second condition. + # the problem is that closure types are tuples in VM, but the types of its children + # shouldn't have the same type as closure types. + let tmp = c.genx(a[0], {gfNodeAddr}) + let sa = getNullValue(c, s.typ, a.info, c.config) + let val = c.genx(sa) + c.genAdditionalCopy(sa, opcWrDeref, tmp, 0, val) + c.freeTemp(val) + c.freeTemp(tmp) + else: + setSlot(c, s) + if a[2].kind == nkEmpty: + 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[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[2], cc) + c.gABC(le, whichAsgnOpc(le), s.position.TRegister, cc) + c.freeTemp(cc) + else: + gen(c, a[2], s.position.TRegister) + else: + # 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[0], a[2], true) + +proc genArrayConstr(c: PCtx, n: PNode, dest: var TDest) = + if dest < 0: dest = c.getTemp(n.typ) + c.gABx(n, opcLdNull, dest, c.genType(n.typ)) + + let intType = getSysType(c.graph, n.info, tyInt) + let seqType = n.typ.skipTypes(abstractVar-{tyTypeDesc}) + if seqType.kind == tySequence: + var tmp = c.getTemp(intType) + c.gABx(n, opcLdImmInt, tmp, n.len) + c.gABx(n, opcNewSeq, dest, c.genType(seqType)) + c.gABx(n, opcNewSeq, tmp, 0) + c.freeTemp(tmp) + + if n.len > 0: + var tmp = getTemp(c, intType) + c.gABx(n, opcLdNullReg, tmp, c.genType(intType)) + for x in n: + let a = c.genx(x) + c.preventFalseAlias(n, opcWrArr, dest, tmp, a) + c.gABI(n, opcAddImmInt, tmp, tmp, 1) + c.freeTemp(a) + c.freeTemp(tmp) + +proc genSetConstr(c: PCtx, n: PNode, dest: var TDest) = + if dest < 0: dest = c.getTemp(n.typ) + c.gABx(n, opcLdNull, dest, c.genType(n.typ)) + for x in n: + if x.kind == nkRange: + 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) + else: + let a = c.genx(x) + c.gABC(n, opcIncl, dest, a) + c.freeTemp(a) + +proc genObjConstr(c: PCtx, n: PNode, dest: var TDest) = + if tfUnion in n.typ.flags: # bug #22708 # bug #13481 + globalError(c.config, n.info, "object with '{.union.}' pragmas is not supported by VM") + if dest < 0: dest = c.getTemp(n.typ) + let t = n.typ.skipTypes(abstractRange+{tyOwned}-{tyTypeDesc}) + if t.kind == tyRef: + c.gABx(n, opcNew, dest, c.genType(t.elementType)) + else: + c.gABx(n, opcLdNull, dest, c.genType(n.typ)) + for i in 1..<n.len: + 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: + globalError(c.config, n.info, "invalid object constructor") + +proc genTupleConstr(c: PCtx, n: PNode, dest: var TDest) = + if dest < 0: dest = c.getTemp(n.typ) + 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 toKey(s: PSym): string = + result = "" + var s = s + 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 + 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, 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 importcCond(c, s): c.importcSym(n.info, s) + genLit(c, n, dest) + of skConst: + 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 + # remains for robustness + if dest < 0: dest = c.getTemp(n.typ) + if s.position >= low(int16) and s.position <= high(int16): + c.gABx(n, opcLdImmInt, dest, s.position) + else: + var lit = genLiteral(c, newIntNode(nkIntLit, s.position)) + c.gABx(n, opcLdConst, dest, lit) + of skType: + genTypeLit(c, s.typ, dest) + of skGenericParam: + if c.prc.sym != nil and c.prc.sym.kind == skMacro: + genRdVar(c, n, dest, flags) + else: + globalError(c.config, n.info, "cannot generate code for: " & s.name.s) + else: + globalError(c.config, n.info, "cannot generate code for: " & s.name.s) + of nkCallKinds: + if n[0].kind == nkSym: + let s = n[0].sym + if s.magic != mNone: + 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) + else: + genCall(c, n, dest) + clearDest(c, n, dest) + of nkCharLit..nkInt64Lit: + if isInt16Lit(n): + if dest < 0: dest = c.getTemp(n.typ) + c.gABx(n, opcLdImmInt, dest, n.intVal.int) + else: + genLit(c, n, dest) + of nkUIntLit..pred(nkNilLit): genLit(c, n, dest) + of nkNilLit: + if not n.typ.isEmptyType: genLit(c, getNullValue(c, n.typ, n.info, c.config), dest) + else: unused(c, n, dest) + of nkAsgn, nkFastAsgn, nkSinkAsgn: + unused(c, n, dest) + 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: 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[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: + genReturn(c, n) + of nkRaiseStmt: + genRaise(c, n) + of nkBreakStmt: + genBreak(c, n) + 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: + 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[0]) + of nkHiddenStdConv, nkHiddenSubConv, nkConv: + genConv(c, n, n[1], dest, flags) + of nkObjDownConv: + 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 nkLambdaKinds: + #let s = n[namePos].sym + #discard genProc(c, s) + genLit(c, newSymNode(n[namePos].sym), dest) + of nkChckRangeF, nkChckRange64, nkChckRange: + if skipTypes(n.typ, abstractVar).kind in {tyUInt..tyUInt64}: + genConv(c, n, n[0], dest, flags) + else: + let + tmp0 = c.genx(n[0]) + tmp1 = c.genx(n[1]) + tmp2 = c.genx(n[2]) + c.gABC(n, opcRangeChck, tmp0, tmp1, tmp2) + c.freeTemp(tmp1) + c.freeTemp(tmp2) + if dest >= 0: + gABC(c, n, whichAsgnOpc(n), dest, tmp0) + c.freeTemp(tmp0) + else: + dest = tmp0 + of nkEmpty, nkCommentStmt, nkTypeSection, nkConstSection, nkPragma, + nkTemplateDef, nkIncludeStmt, nkImportStmt, nkFromStmt, nkExportStmt, + nkMixinStmt, nkBindStmt, declarativeDefs, nkMacroDef: + unused(c, n, dest) + of nkStringToCString, nkCStringToString: + 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[1], dest, flags, opcCast) + else: + genCastIntFloat(c, n, dest) + of nkTypeOfExpr: + genTypeLit(c, n.typ, dest) + of nkComesFrom: + discard "XXX to implement for better stack traces" + else: + 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 + if last >= 0 and c.code[last].opcode == opcEof: + # overwrite last EOF: + assert c.code.len == c.debug.len + c.code.setLen(last) + c.debug.setLen(last) + +proc genStmt*(c: PCtx; n: PNode): int = + c.removeLastEof + result = c.code.len + var d: TDest = -1 + c.gen(n, d) + c.gABC(n, opcEof) + if d >= 0: + globalError(c.config, n.info, "VM problem: dest register is set") + +proc genExpr*(c: PCtx; n: PNode, requiresValue = true): int = + c.removeLastEof + result = c.code.len + var d: TDest = -1 + c.gen(n, d) + if d < 0: + if requiresValue: + globalError(c.config, n.info, "VM problem: dest register is not set") + d = 0 + c.gABC(n, opcEof, d) + + #echo renderTree(n) + #c.echoCode(result) + +proc genParams(c: PCtx; params: PNode) = + # res.sym.position is already 0 + setLen(c.prc.regInfo, max(params.len, 1)) + c.prc.regInfo[0] = (inUse: true, kind: slotFixedVar) + for i in 1..<params.len: + c.prc.regInfo[i] = (inUse: true, kind: slotFixedLet) + +proc finalJumpTarget(c: PCtx; pc, diff: int) = + internalAssert(c.config, regBxMin < diff and diff < regBxMax) + let oldInstr = c.code[pc] + # opcode and regA stay the same: + c.code[pc] = ((oldInstr.TInstrType and ((regOMask shl regOShift) or (regAMask shl regAShift))).TInstrType or + TInstrType(diff+wordExcess) shl regBxShift).TInstr + +proc genGenericParams(c: PCtx; gp: PNode) = + var base = c.prc.regInfo.len + setLen c.prc.regInfo, base + gp.len + for i in 0..<gp.len: + var param = gp[i].sym + param.position = base + i # XXX: fix this earlier; make it consistent with templates + c.prc.regInfo[base + i] = (inUse: true, kind: slotFixedLet) + +proc optimizeJumps(c: PCtx; start: int) = + const maxIterations = 10 + for i in start..<c.code.len: + let opc = c.code[i].opcode + case opc + of opcTJmp, opcFJmp: + var reg = c.code[i].regA + var d = i + c.code[i].jmpDiff + for iters in countdown(maxIterations, 0): + case c.code[d].opcode + of opcJmp: + d += c.code[d].jmpDiff + of opcTJmp, opcFJmp: + if c.code[d].regA != reg: break + # tjmp x, 23 + # ... + # tjmp x, 12 + # -- we know 'x' is true, and so can jump to 12+13: + if c.code[d].opcode == opc: + d += c.code[d].jmpDiff + else: + # tjmp x, 23 + # fjmp x, 22 + # We know 'x' is true so skip to the next instruction: + d += 1 + else: break + if d != i + c.code[i].jmpDiff: + c.finalJumpTarget(i, d - i) + of opcJmp, opcJmpBack: + var d = i + c.code[i].jmpDiff + var iters = maxIterations + while c.code[d].opcode == opcJmp and iters > 0: + d += c.code[d].jmpDiff + dec iters + if c.code[d].opcode == opcRet: + # optimize 'jmp to ret' to 'ret' here + c.code[i] = c.code[d] + elif d != i + c.code[i].jmpDiff: + c.finalJumpTarget(i, d - i) + else: discard + +proc genProc(c: PCtx; s: PSym): int = + let + pos = c.procToCodePos.getOrDefault(s.id) + wasNotGenProcBefore = pos == 0 + noRegistersAllocated = s.offset == -1 + if wasNotGenProcBefore or noRegistersAllocated: + # xxx: the noRegisterAllocated check is required in order to avoid issues + # where nimsuggest can crash due as a macro with pos will be loaded + # but it doesn't have offsets for register allocations see: + # https://github.com/nim-lang/Nim/issues/18385 + # Improvements and further use of IC should remove the need for this. + #if s.name.s == "outterMacro" or s.name.s == "innerProc": + # echo "GENERATING CODE FOR ", s.name.s + let last = c.code.len-1 + var eofInstr: TInstr = default(TInstr) + 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 + c.procToCodePos[s.id] = result + # thanks to the jmp we can add top level statements easily and also nest + # procs easily: + let body = transformBody(c.graph, c.idgen, s, if isCompileTimeProc(s): {} else: {useCache}) + let procStart = c.xjmp(body, opcJmp, 0) + var p = PProc(blocks: @[], sym: s) + let oldPrc = c.prc + c.prc = p + # iterate over the parameters and allocate space for them: + genParams(c, s.typ.n) + + # allocate additional space for any generically bound parameters + if s.kind == skMacro and s.isGenericRoutineStrict: + genGenericParams(c, s.ast[genericParamsPos]) + + if tfCapturesEnv in s.typ.flags: + #let env = s.ast[paramsPos].lastSon.sym + #assert env.position == 2 + 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.regInfo.len.int32 + #if s.name.s == "main" or s.name.s == "[]": + # echo renderTree(body) + # c.echoCode(result) + c.prc = oldPrc + else: + c.prc.regInfo.setLen s.offset + result = pos diff --git a/compiler/vmhooks.nim b/compiler/vmhooks.nim new file mode 100644 index 000000000..2d7ad63e7 --- /dev/null +++ b/compiler/vmhooks.nim @@ -0,0 +1,77 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +import pathutils + +when defined(nimPreviewSlimSystem): + import std/assertions + +template setX(k, field) {.dirty.} = + a.slots[a.ra].ensureKind(k) + a.slots[a.ra].field = v + +proc setResult*(a: VmArgs; v: BiggestInt) = setX(rkInt, intVal) +proc setResult*(a: VmArgs; v: BiggestFloat) = setX(rkFloat, floatVal) +proc setResult*(a: VmArgs; v: bool) = + let v = v.ord + setX(rkInt, intVal) + +proc setResult*(a: VmArgs; v: string) = + 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) = + 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]) = + a.slots[a.ra].ensureKind(rkNode) + var n = newNode(nkBracket) + for x in v: n.add newStrNode(nkStrLit, x) + 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 getReg(a, i): untyped = + doAssert i < a.rc-1 + 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 getNode*(a: VmArgs; i: Natural): PNode = getX(rkNode, node) +proc getString*(a: VmArgs; i: Natural): string = getX(rkNode, node).strVal +proc getVar*(a: VmArgs; i: Natural): PNode = + let p = getReg(a, i) + # depending on whether we come from top-level or proc scope, we need to consider 2 cases + case p.kind + of rkRegisterAddr: result = p.regAddr.node + of rkNodeAddr: result = p.nodeAddr[] + else: raiseAssert $p.kind + +proc getNodeAddr*(a: VmArgs; i: Natural): PNode = + let nodeAddr = getX(rkNodeAddr, nodeAddr) + doAssert nodeAddr != nil + result = nodeAddr[] diff --git a/compiler/vmmarshal.nim b/compiler/vmmarshal.nim new file mode 100644 index 000000000..0e67ededa --- /dev/null +++ b/compiler/vmmarshal.nim @@ -0,0 +1,315 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Implements marshaling for the VM. + +import ast, astalgo, idents, types, msgs, + options, lineinfos + +import std/[streams, json, intsets, tables] + +when defined(nimPreviewSlimSystem): + import std/[assertions, formatfloat] + +proc ptrToInt(x: PNode): int {.inline.} = + result = cast[int](x) # don't skip alignment + +proc getField(n: PNode; position: int): PSym = + case n.kind + of nkRecList: + result = nil + for i in 0..<n.len: + result = getField(n[i], position) + if result != nil: return + of nkRecCase: + result = getField(n[0], position) + if result != nil: return + for i in 1..<n.len: + case n[i].kind + of nkOfBranch, nkElse: + result = getField(lastSon(n[i]), position) + if result != nil: return + else: discard + of nkSym: + if n.sym.position == position: result = n.sym + 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 start..<x.len: + if i > start: s.add(", ") + var it = x[i] + if it.kind == nkExprColonExpr: + if it[0].kind == nkSym: + let field = it[0].sym + s.add(escapeJson(field.name.s)) + s.add(": ") + 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 storeAny(s: var string; t: PType; a: PNode; stored: var IntSet; + conf: ConfigRef) = + case t.kind + of tyNone: assert false + of tyBool: s.add($(a.intVal != 0)) + of tyChar: + let ch = char(a.intVal) + if ch < '\128': + s.add(escapeJson($ch)) + else: + s.add($int(ch)) + of tyArray, tySequence: + if t.kind == tySequence and a.kind == nkNilLit: s.add("null") + else: + s.add("[") + 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, ti in t.ikids: + if i > 0: s.add(", ") + s.add("\"Field" & $i) + s.add("\": ") + storeAny(s, ti, a[i].skipColon, stored, conf) + s.add("}") + of tyObject: + s.add("{") + storeObj(s, t, a, stored, conf) + s.add("}") + of tySet: + s.add("[") + for i in 0..<a.len: + if i > 0: s.add(", ") + if a[i].kind == nkRange: + var x = copyNode(a[i][0]) + storeAny(s, t.elementType, x, stored, conf) + inc x.intVal + while x.intVal <= a[i][1].intVal: + s.add(", ") + storeAny(s, t.elementType, x, stored, conf) + inc x.intVal + else: + storeAny(s, t.elementType, a[i], stored, conf) + s.add("]") + of tyRange, tyGenericInst, tyAlias, tySink: + 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): + if e.sym.position == a.intVal: + s.add e.sym.name.s.escapeJson + break + of tyPtr, tyRef: + var x = a + if isNil(x) or x.kind == nkNilLit: s.add("null") + elif stored.containsOrIncl(x.ptrToInt): + # already stored, so we simply write out the pointer as an int: + s.add($x.ptrToInt) + else: + # else as a [value, key] pair: + # (reversed order for convenient x[0] access!) + s.add("[") + s.add($x.ptrToInt) + s.add(", ") + storeAny(s, t.elementType, a, stored, conf) + s.add("]") + 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) + else: + internalError conf, a.info, "cannot marshal at compile-time " & t.typeToString + +proc storeAny*(s: var string; t: PType; a: PNode; conf: ConfigRef) = + var stored = initIntSet() + storeAny(s, t, a, stored, conf) + +proc loadAny(p: var JsonParser, t: PType, + tab: var Table[BiggestInt, PNode]; + cache: IdentCache; + conf: ConfigRef; + idgen: IdGenerator): PNode = + case t.kind + of tyNone: + result = nil + assert false + of tyBool: + case p.kind + of jsonFalse: result = newIntNode(nkIntLit, 0) + of jsonTrue: result = newIntNode(nkIntLit, 1) + else: raiseParseErr(p, "'true' or 'false' expected for a bool") + next(p) + of tyChar: + if p.kind == jsonString: + var x = p.str + result = nil + if x.len == 1: + result = newIntNode(nkIntLit, ord(x[0])) + next(p) + return + elif p.kind == jsonInt: + 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: + result = newIntNode(nkIntLit, e.sym.position) + next(p) + return + raiseParseErr(p, "string expected for an enum") + of tyArray: + if p.kind != jsonArrayStart: raiseParseErr(p, "'[' expected for an array") + next(p) + result = newNode(nkBracket) + while p.kind != jsonArrayEnd and p.kind != jsonEof: + 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: + case p.kind + of jsonNull: + result = newNode(nkNilLit) + next(p) + of jsonArrayStart: + next(p) + result = newNode(nkBracket) + while p.kind != jsonArrayEnd and p.kind != jsonEof: + 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 >= tupleLen: + raiseParseErr(p, "too many fields to tuple type " & typeToString(t)) + 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") + of tyObject: + if p.kind != jsonObjectStart: raiseParseErr(p, "'{' expected for an object") + next(p) + result = newNode(nkObjConstr) + result.sons = @[newNode(nkEmpty)] + while p.kind != jsonObjectEnd and p.kind != jsonEof: + if p.kind != jsonString: + raiseParseErr(p, "string expected for a field name") + let ident = getIdent(cache, p.str) + let field = lookupInRecord(t.n, ident) + if field.isNil: + raiseParseErr(p, "unknown field for object of type " & typeToString(t)) + next(p) + let pos = field.position + 1 + if pos >= result.len: + setLen(result.sons, pos + 1) + let fieldNode = newNode(nkExprColonExpr) + 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: + if p.kind != jsonArrayStart: raiseParseErr(p, "'[' expected for a set") + next(p) + result = newNode(nkCurly) + while p.kind != jsonArrayEnd and p.kind != jsonEof: + 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: + case p.kind + of jsonNull: + result = newNode(nkNilLit) + next(p) + of jsonInt: + result = tab.getOrDefault(p.getInt) + if result.isNil: + 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.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: + result = nil + raiseParseErr(p, "int for pointer type expected") + of tyString, tyCstring: + case p.kind + of jsonNull: + result = newNode(nkNilLit) + next(p) + of jsonString: + result = newStrNode(nkStrLit, p.str) + next(p) + 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.skipModifier, tab, cache, conf, idgen) + else: + result = nil + internalError conf, "cannot marshal at compile-time " & t.typeToString + +proc loadAny*(s: string; t: PType; cache: IdentCache; conf: ConfigRef; idgen: IdGenerator): PNode = + var tab = initTable[BiggestInt, PNode]() + var p: JsonParser = default(JsonParser) + open(p, newStringStream(s), "unknown file") + next(p) + result = loadAny(p, t, tab, cache, conf, idgen) + close(p) diff --git a/compiler/vmops.nim b/compiler/vmops.nim new file mode 100644 index 000000000..45194e633 --- /dev/null +++ b/compiler/vmops.nim @@ -0,0 +1,417 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +# Unfortunately this cannot be a module yet: +#import vmdeps, vm +from std/math import sqrt, ln, log10, log2, exp, round, arccos, arcsin, + arctan, arctan2, cos, cosh, hypot, sinh, sin, tan, tanh, pow, trunc, + floor, ceil, `mod`, cbrt, arcsinh, arccosh, arctanh, erf, erfc, gamma, + lgamma, divmod +from std/sequtils import toSeq +when declared(math.copySign): + # pending bug #18762, avoid renaming math + from std/math as math2 import copySign + +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`) + +template osop(op) {.dirty.} = + registerCallback(c, "stdlib.os." & astToStr(op), `op Wrapper`) + +template oscommonop(op) {.dirty.} = + registerCallback(c, "stdlib.oscommon." & astToStr(op), `op Wrapper`) + +template osdirsop(op) {.dirty.} = + registerCallback(c, "stdlib.osdirs." & astToStr(op), `op Wrapper`) + +template envvarsop(op) {.dirty.} = + registerCallback(c, "stdlib.envvars." & astToStr(op), `op Wrapper`) + +template timesop(op) {.dirty.} = + registerCallback(c, "stdlib.times." & astToStr(op), `op Wrapper`) + +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 wrap1fMath(op) {.dirty.} = + proc `op Wrapper`(a: VmArgs) {.nimcall.} = + doAssert a.numArgs == 1 + setResult(a, op(getFloat(a, 0))) + mathop op + +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()) + modop op + +template wrap1s(op, modop) {.dirty.} = + proc `op Wrapper`(a: VmArgs) {.nimcall.} = + setResult(a, op(getString(a, 0))) + modop op + +template wrap2s(op, modop) {.dirty.} = + proc `op Wrapper`(a: VmArgs) {.nimcall.} = + 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)) + modop op + +template wrap2svoid(op, modop) {.dirty.} = + proc `op Wrapper`(a: VmArgs) {.nimcall.} = + 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[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 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 ret = opGorge(getString(a, 0), getString(a, 1), getString(a, 2), + a.currentLineInfo, c.config) + setResult a, ret.toLit + + proc getProjectPathWrapper(a: VmArgs) = + 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, envvarsop) + wrap1s(existsEnv, envvarsop) + wrap2svoid(putEnv, envvarsop) + wrap1svoid(delEnv, envvarsop) + wrap1s(dirExists, oscommonop) + wrap1s(fileExists, oscommonop) + wrapDangerous2svoid(writeFile, ioop) + wrapDangerous1svoid(createDir, osdirsop) + wrap1s(readFile, ioop) + wrap2si(readLines, ioop) + systemop getCurrentExceptionMsg + systemop getCurrentException + registerCallback c, "stdlib.osdirs.staticWalkDir", proc (a: VmArgs) {.nimcall.} = + setResult(a, staticWalkDirImpl(getString(a, 0), getBool(a, 1))) + 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 06607d2a6..39e0b2e25 100644 --- a/compiler/wordrecg.nim +++ b/compiler/wordrecg.nim @@ -1,7 +1,7 @@ # # -# The Nimrod Compiler -# (c) Copyright 2012 Andreas Rumpf +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -13,172 +13,138 @@ # does not support strings. Without this the code would # be slow and unreadable. -import - hashes, strutils, idents - -# Keywords must be kept sorted and within a range - type - TSpecialWord* = enum - wInvalid, - - wAddr, wAnd, wAs, wAsm, wAtomic, - wBind, wBlock, wBreak, wCase, wCast, wConst, - wContinue, wConverter, wDiscard, wDistinct, wDiv, wDo, - wElif, wElse, wEnd, wEnum, wExcept, wExport, - wFinally, wFor, wFrom, wGeneric, wIf, wImport, wIn, - wInclude, wInterface, wIs, wIsnot, wIterator, wLambda, wLet, - wMacro, wMethod, wMixin, wMod, wNil, - wNot, wNotin, wObject, wOf, wOr, wOut, wProc, wPtr, wRaise, wRef, wReturn, - wShared, wShl, wShr, wStatic, wTemplate, wTry, wTuple, wType, wVar, - wWhen, wWhile, wWith, wWithout, wXor, wYield, - - wColon, wColonColon, wEquals, wDot, wDotDot, - wStar, wMinus, - wMagic, wThread, wFinal, wProfiler, wObjChecks, - - wDestroy, - - wImmediate, wDestructor, wImportCpp, wImportObjC, - wImportCompilerProc, - wImportc, wExportc, wIncompleteStruct, wRequiresInit, - wAlign, wNodecl, wPure, wSideeffect, wHeader, - wNosideeffect, wNoreturn, wMerge, wLib, wDynlib, wCompilerproc, wProcVar, - 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, - wAssertions, wPatterns, wWarnings, - wHints, wOptimization, wRaises, wWrites, wReads, wSize, wEffects, wTags, - wDeadCodeElim, wSafecode, wNoForward, - wPragma, - wCompileTime, wNoInit, - wPassc, wPassl, wBorrow, wDiscardable, - wFieldChecks, - wWatchPoint, wSubsChar, - wAcyclic, wShallow, wUnroll, wLinearScanEnd, - wWrite, wGensym, wInject, wDirty, wInheritable, wThreadVar, wEmit, - wNoStackFrame, - wImplicitStatic, wGlobal, wCodegenDecl, - - 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, wUnsigned, wUsing, 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, - + TSpecialWord* = enum + wInvalid = "", + wAddr = "addr", wAnd = "and", wAs = "as", wAsm = "asm", + wBind = "bind", wBlock = "block", wBreak = "break", wCase = "case", wCast = "cast", + wConcept = "concept", wConst = "const", wContinue = "continue", wConverter = "converter", + 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] -const +const oprLow* = ord(wColon) oprHigh* = ord(wDotDot) - + 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} - - specialWords*: array[low(TSpecialWord)..high(TSpecialWord), string] = ["", - - "addr", "and", "as", "asm", "atomic", - "bind", "block", "break", "case", "cast", - "const", "continue", "converter", - "discard", "distinct", "div", "do", - "elif", "else", "end", "enum", "except", "export", - "finally", "for", "from", "generic", "if", - "import", "in", "include", "interface", "is", "isnot", "iterator", - "lambda", "let", - "macro", "method", "mixin", "mod", "nil", "not", "notin", - "object", "of", "or", - "out", "proc", "ptr", "raise", "ref", "return", - "shared", "shl", "shr", "static", - "template", "try", "tuple", "type", "var", - "when", "while", "with", "without", "xor", - "yield", - - ":", "::", "=", ".", "..", - "*", "-", - "magic", "thread", "final", "profiler", "objchecks", - - "destroy", - - "immediate", "destructor", "importcpp", "importobjc", - "importcompilerproc", "importc", "exportc", "incompletestruct", - "requiresinit", "align", "nodecl", "pure", "sideeffect", - "header", "nosideeffect", "noreturn", "merge", "lib", "dynlib", - "compilerproc", "procvar", "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", - - "assertions", "patterns", "warnings", "hints", - "optimization", "raises", "writes", "reads", "size", "effects", "tags", - "deadcodeelim", "safecode", "noforward", - "pragma", - "compiletime", "noinit", - "passc", "passl", "borrow", "discardable", "fieldchecks", - "watchpoint", - "subschar", "acyclic", "shallow", "unroll", "linearscanend", - "write", "gensym", "inject", "dirty", "inheritable", "threadvar", "emit", - "nostackframe", "implicitstatic", "global", "codegendecl", - - "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", "unsigned", "using", "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", - ] - -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 - -proc whichKeyword*(id: PIdent): TSpecialWord = - if id.id < 0: result = wInvalid - else: result = TSpecialWord(id.id) - -proc whichKeyword*(id: String): TSpecialWord = - result = whichKeyword(getIdent(id)) + wFor, wIf, wReturn, wStatic, wTemplate, wTry, wWhile, wUsing} -proc initSpecials() = - # initialize the keywords: - for s in countup(succ(low(specialWords)), high(specialWords)): - getIdent(specialWords[s], hashIgnoreStyle(specialWords[s])).id = ord(s) - -initSpecials() + nonPragmaWordsLow* = wAuto + nonPragmaWordsHigh* = wOneWay + + +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) |