diff options
Diffstat (limited to 'compiler')
50 files changed, 1204 insertions, 401 deletions
diff --git a/compiler/ast.nim b/compiler/ast.nim index bdb8d1c23..0c828a6d9 100644 --- a/compiler/ast.nim +++ b/compiler/ast.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2013 Andreas Rumpf # # See the file "copying.txt", included in this @@ -263,7 +263,7 @@ type sfNamedParamCall, # symbol needs named parameter call syntax in target # language; for interfacing with Objective C sfDiscardable, # returned value may be discarded implicitly - sfDestructor, # proc is destructor + sfOverriden, # proc is overriden sfGenSym # symbol is 'gensym'ed; do not add to symbol table TSymFlags* = set[TSymFlag] @@ -291,6 +291,8 @@ const 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 const # getting ready for the future expr/stmt merge @@ -476,7 +478,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) @@ -501,7 +503,8 @@ 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) + skPackage, # symbol is a package (used for canonicalization) + skAlias # an alias (needs to be resolved immediately) TSymKinds* = set[TSymKind] const @@ -678,7 +681,7 @@ type 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 + a*: int # ---------------- end of backend information ------------------------------ @@ -731,8 +734,9 @@ type # check for the owner when touching 'usedGenerics'. usedGenerics*: seq[PInstantiation] tab*: TStrTable # interface table for modules + of skLet, skVar, skField: + guard*: PSym else: nil - magic*: TMagic typ*: PType name*: PIdent @@ -785,12 +789,13 @@ type # the body of the user-defined type class # formal param list # 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 + destructor*: PSym # destructor. warning: nil here may not necessary + # mean that there is no destructor. + # see instantiateDestructor in semdestruct.nim + deepCopy*: PSym # overriden 'deepCopy' operation size*: BiggestInt # the size of the type in bytes # -1 means that the size is unkwown align*: int # the type's alignment requirements @@ -871,7 +876,7 @@ const tyProc, tyString, tyError} ExportableSymKinds* = {skVar, skConst, skProc, skMethod, skType, skIterator, skClosureIterator, - skMacro, skTemplate, skConverter, skEnumField, skLet, skStub} + skMacro, skTemplate, skConverter, skEnumField, skLet, skStub, skAlias} PersistentNodeFlags*: TNodeFlags = {nfBase2, nfBase8, nfBase16, nfDotSetter, nfDotField, nfIsRef} @@ -1161,7 +1166,6 @@ proc newProcNode*(kind: TNodeKind, info: TLineInfo, body: PNode, result.sons = @[name, pattern, genericParams, params, pragmas, exceptions, body] - proc newType(kind: TTypeKind, owner: PSym): PType = new(result) result.kind = kind @@ -1171,8 +1175,8 @@ proc newType(kind: TTypeKind, owner: PSym): PType = result.id = getID() when debugIds: registerId(result) - #if result.id < 2000 then - # MessageOut(typeKindToStr[kind] & ' has id: ' & toString(result.id)) + #if result.id < 2000: + # 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 @@ -1190,6 +1194,7 @@ proc assignType(dest, src: PType) = dest.size = src.size dest.align = src.align dest.destructor = src.destructor + dest.deepCopy = src.deepCopy # this fixes 'type TLock = TSysLock': if src.sym != nil: if dest.sym != nil: @@ -1227,6 +1232,8 @@ proc copySym(s: PSym, keepId: bool = false): PSym = result.position = s.position result.loc = s.loc result.annex = s.annex # BUGFIX + if result.kind in {skVar, skLet, skField}: + result.guard = s.guard proc createModuleAlias*(s: PSym, newIdent: PIdent, info: TLineInfo): PSym = result = newSym(s.kind, newIdent, s.owner, info) @@ -1311,6 +1318,10 @@ proc newSons(father: PNode, length: int) = setLen(father.sons, length) proc skipTypes*(t: PType, kinds: TTypeKinds): PType = + ## Used throughout the compiler code to test whether a type tree contains or + ## doesn't contain a specific type/types - it is often the case that only the + ## last child nodes of a type tree need to be searched. This is a really hot + ## path within the compiler! result = t while result.kind in kinds: result = lastSon(result) diff --git a/compiler/astalgo.nim b/compiler/astalgo.nim index dbf13f764..eb7ffc63e 100644 --- a/compiler/astalgo.nim +++ b/compiler/astalgo.nim @@ -116,17 +116,16 @@ 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 skipConvAndClosure*(n: PNode): PNode = + result = n + while true: + case result.kind + of nkObjUpConv, nkObjDownConv, nkChckRange, nkChckRangeF, nkChckRange64, + nkClosure: + result = result.sons[0] + of nkHiddenStdConv, nkHiddenSubConv, nkConv: + result = result.sons[1] + else: break proc sameValue*(a, b: PNode): bool = result = false @@ -379,29 +378,30 @@ 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 = +proc debugTree(n: PNode, indent: int, maxRecDepth: int; renderType=false): PRope +proc debugType(n: PType, maxRecDepth=100): PRope = if n == nil: result = toRope("null") - else: + 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): + if (n.kind != tyString) and (sonsLen(n) > 0) and maxRecDepth != 0: app(result, "(") - for i in countup(0, sonsLen(n) - 1): + for i in countup(0, sonsLen(n) - 1): if i > 0: app(result, ", ") - if n.sons[i] == nil: + if n.sons[i] == nil: app(result, "null") - else: - app(result, debugType(n.sons[i])) - if n.kind == tyObject and n.n != nil: + else: + app(result, debugType(n.sons[i], maxRecDepth-1)) + if n.kind == tyObject and n.n != nil: app(result, ", node: ") - app(result, debugTree(n.n, 2, 100)) + app(result, debugTree(n.n, 2, maxRecDepth-1, renderType=true)) app(result, ")") -proc debugTree(n: PNode, indent: int, maxRecDepth: int): PRope = +proc debugTree(n: PNode, indent: int, maxRecDepth: int; + renderType=false): PRope = if n == nil: result = toRope("null") else: @@ -425,6 +425,8 @@ proc debugTree(n: PNode, indent: int, maxRecDepth: int): PRope = [istr, toRope(n.sym.name.s), toRope(n.sym.id)]) # [istr, symToYaml(n.sym, indent, maxRecDepth), # toRope(n.sym.id)]) + if renderType and n.sym.typ != nil: + appf(result, ",$N$1\"typ\": $2", [istr, debugType(n.sym.typ, 2)]) of nkIdent: if n.ident != nil: appf(result, ",$N$1\"ident\": $2", [istr, makeYamlString(n.ident.s)]) @@ -436,7 +438,7 @@ proc debugTree(n: PNode, indent: int, maxRecDepth: int): PRope = 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)]) + indent + 4, maxRecDepth - 1, renderType)]) appf(result, "$N$1]", [istr]) appf(result, ",$N$1\"info\": $2", [istr, lineInfoToStr(n.info)]) appf(result, "$N$1}", [spaces(indent)]) diff --git a/compiler/ccgcalls.nim b/compiler/ccgcalls.nim index 71e23aa1d..adcc95e84 100644 --- a/compiler/ccgcalls.nim +++ b/compiler/ccgcalls.nim @@ -29,7 +29,7 @@ proc fixupCall(p: BProc, le, ri: PNode, d: var TLoc, # beware of 'result = p(result)'. We may need to allocate a temporary: if d.k in {locTemp, locNone} or not leftAppearsOnRightSide(le, ri): # Great, we can use 'd': - if d.k == locNone: getTemp(p, typ.sons[0], d) + if d.k == locNone: getTemp(p, typ.sons[0], d, needsInit=true) elif d.k notin {locExpr, locTemp} and not hasNoInit(ri): # reset before pass as 'result' var: resetLoc(p, d) @@ -38,7 +38,7 @@ proc fixupCall(p: BProc, le, ri: PNode, d: var TLoc, line(p, cpsStmts, pl) else: var tmp: TLoc - getTemp(p, typ.sons[0], tmp) + getTemp(p, typ.sons[0], tmp, needsInit=true) app(pl, addrLoc(tmp)) app(pl, ~");$n") line(p, cpsStmts, pl) @@ -195,7 +195,8 @@ proc genClosureCall(p: BProc, le, ri: PNode, d: var TLoc) = # beware of 'result = p(result)'. We may need to allocate a temporary: if d.k in {locTemp, locNone} or not leftAppearsOnRightSide(le, ri): # Great, we can use 'd': - if d.k == locNone: getTemp(p, typ.sons[0], d) + if d.k == locNone: + getTemp(p, typ.sons[0], d, needsInit=true) elif d.k notin {locExpr, locTemp} and not hasNoInit(ri): # reset before pass as 'result' var: resetLoc(p, d) @@ -203,7 +204,7 @@ proc genClosureCall(p: BProc, le, ri: PNode, d: var TLoc) = genCallPattern() else: var tmp: TLoc - getTemp(p, typ.sons[0], tmp) + getTemp(p, typ.sons[0], tmp, needsInit=true) app(pl, addrLoc(tmp)) genCallPattern() genAssignment(p, d, tmp, {}) # no need for deep copying @@ -278,14 +279,14 @@ proc genNamedParamCall(p: BProc, ri: PNode, d: var TLoc) = # 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) + if d.k == locNone: getTemp(p, typ.sons[0], d, needsInit=true) app(pl, ~"Result: ") app(pl, addrLoc(d)) app(pl, ~"];$n") line(p, cpsStmts, pl) else: var tmp: TLoc - getTemp(p, typ.sons[0], tmp) + getTemp(p, typ.sons[0], tmp, needsInit=true) app(pl, addrLoc(tmp)) app(pl, ~"];$n") line(p, cpsStmts, pl) diff --git a/compiler/ccgexprs.nim b/compiler/ccgexprs.nim index 691feeb47..b5817de05 100644 --- a/compiler/ccgexprs.nim +++ b/compiler/ccgexprs.nim @@ -359,6 +359,32 @@ proc genAssignment(p: BProc, dest, src: TLoc, flags: TAssignmentFlags) = linefmt(p, cpsStmts, "$1 = $2;$n", rdLoc(dest), rdLoc(src)) else: internalError("genAssignment: " & $ty.kind) +proc genDeepCopy(p: BProc; dest, src: TLoc) = + var ty = skipTypes(dest.t, abstractVarRange) + case ty.kind + of tyPtr, tyRef, tyProc, tyTuple, tyObject, tyArray, tyArrayConstr: + # XXX optimize this + linefmt(p, cpsStmts, "#genericDeepCopy((void*)$1, (void*)$2, $3);$n", + addrLoc(dest), addrLoc(src), genTypeInfo(p.module, dest.t)) + of tySequence, tyString: + linefmt(p, cpsStmts, "#genericSeqDeepCopy($1, $2, $3);$n", + addrLoc(dest), rdLoc(src), genTypeInfo(p.module, dest.t)) + of tyOpenArray, tyVarargs: + linefmt(p, cpsStmts, + "#genericDeepCopyOpenArray((void*)$1, (void*)$2, $1Len0, $3);$n", + addrLoc(dest), addrLoc(src), genTypeInfo(p.module, dest.t)) + of tySet: + if mapType(ty) == ctArray: + useStringh(p.module) + linefmt(p, cpsStmts, "memcpy((void*)$1, (NIM_CONST void*)$2, $3);$n", + rdLoc(dest), rdLoc(src), toRope(getSize(dest.t))) + else: + linefmt(p, cpsStmts, "$1 = $2;$n", rdLoc(dest), rdLoc(src)) + of tyPointer, tyChar, tyBool, tyEnum, tyCString, + tyInt..tyUInt64, tyRange, tyVar: + linefmt(p, cpsStmts, "$1 = $2;$n", rdLoc(dest), rdLoc(src)) + else: internalError("genDeepCopy: " & $ty.kind) + proc getDestLoc(p: BProc, d: var TLoc, typ: PType) = if d.k == locNone: getTemp(p, typ, d) @@ -1191,7 +1217,6 @@ proc genOf(p: BProc, n: PNode, d: var TLoc) = genOf(p, n.sons[1], n.sons[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) @@ -1260,6 +1285,7 @@ proc genArrayLen(p: BProc, e: PNode, d: var TLoc, op: TMagic) = if op == mHigh: unaryExpr(p, e, d, "($1Len0-1)") else: unaryExpr(p, e, d, "$1Len0") of tyCString: + useStringh(p.module) if op == mHigh: unaryExpr(p, e, d, "(strlen($1)-1)") else: unaryExpr(p, e, d, "strlen($1)") of tyString, tySequence: @@ -1578,25 +1604,25 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = of mGetTypeInfo: genGetTypeInfo(p, e, d) of mSwap: genSwap(p, e, d) of mUnaryLt: - if not (optOverflowCheck in p.options): unaryExpr(p, e, d, "($1 - 1)") + if optOverflowCheck notin 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)") + if optOverflowCheck notin 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)") + if optOverflowCheck notin p.options: binaryExpr(p, e, d, "($1 + $2)") else: binaryExpr(p, e, d, "#addInt($1, $2)") of mInc: - if not (optOverflowCheck in p.options): + if optOverflowCheck notin 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): + if optOverflowCheck notin 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") @@ -1659,6 +1685,12 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = of mParallel: let n = semparallel.liftParallel(p.module.module, e) expr(p, n, d) + of mDeepCopy: + var a, b: TLoc + let x = if e[1].kind in {nkAddr, nkHiddenAddr}: e[1][0] else: e[1] + initLocExpr(p, x, a) + initLocExpr(p, e.sons[2], b) + genDeepCopy(p, a, b) else: internalError(e.info, "genMagicExpr: " & $op) proc genConstExpr(p: BProc, n: PNode): PRope @@ -1878,7 +1910,8 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = 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) + #echo "FAILED FOR PRCO ", p.prc.name.s + internalError n.info, "expr: var not init " & sym.name.s & "_" & $sym.id if sfThread in sym.flags: accessThreadLocalVar(p, sym) if emulatedThreadVars(): @@ -1889,11 +1922,14 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = 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) + #echo "FAILED FOR PRCO ", p.prc.name.s + #echo renderTree(p.prc.ast, {renderIds}) + internalError(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) + #echo "FAILED FOR PRCO ", p.prc.name.s + internalError(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") of nkNilLit: diff --git a/compiler/ccgstmts.nim b/compiler/ccgstmts.nim index a8cfa57e4..037594e89 100644 --- a/compiler/ccgstmts.nim +++ b/compiler/ccgstmts.nim @@ -1,7 +1,7 @@ # # # The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# (c) Copyright 2014 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -24,10 +24,29 @@ proc registerGcRoot(p: BProc, v: PSym) = linefmt(p.module.initProc, cpsStmts, "#nimRegisterGlobalMarker($1);$n", prc) +proc isAssignedImmediately(n: PNode): bool {.inline.} = + if n.kind == nkEmpty: return false + if isInvalidReturnType(n.typ): + # var v = f() + # is transformed into: var v; f(addr v) + # where 'f' **does not** initialize the result! + return false + result = true + proc genVarTuple(p: BProc, n: PNode) = var tup, field: TLoc if n.kind != nkVarTuple: internalError(n.info, "genVarTuple") var L = sonsLen(n) + + # if we have a something that's been captured, use the lowering instead: + var useLowering = false + for i in countup(0, L-3): + if n[i].kind != nkSym: + useLowering = true; break + if useLowering: + genStmts(p, lowerTupleUnpacking(n, p.prc)) + return + genLineDir(p, n) initLocExpr(p, n.sons[L-1], tup) var t = tup.t @@ -40,7 +59,7 @@ proc genVarTuple(p: BProc, n: PNode) = registerGcRoot(p, v) else: assignLocalVar(p, v) - initLocalVar(p, v, immediateAsgn=true) + initLocalVar(p, v, immediateAsgn=isAssignedImmediately(n[L-1])) initLoc(field, locExpr, t.sons[i], tup.s) if t.kind == tyTuple: field.r = ropef("$1.Field$2", [rdLoc(tup), toRope(i)]) @@ -146,12 +165,16 @@ proc genBreakState(p: BProc, n: PNode) = # lineF(p, cpsStmts, "if (($1) < 0) break;$n", [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 var targetProc = p - var immediateAsgn = a.sons[2].kind != nkEmpty if sfGlobal in v.flags: + if v.flags * {sfImportc, sfExportc} == {sfImportc} and + a.sons[2].kind == nkEmpty and + v.loc.flags * {lfHeader, lfNoDecl} != {}: + return if sfPure in v.flags: # v.owner.kind != skModule: targetProc = p.module.preInitProc @@ -170,9 +193,9 @@ proc genSingleVar(p: BProc, a: PNode) = registerGcRoot(p, v) else: assignLocalVar(p, v) - initLocalVar(p, v, immediateAsgn) + initLocalVar(p, v, isAssignedImmediately(a.sons[2])) - if immediateAsgn: + if a.sons[2].kind != nkEmpty: genLineDir(targetProc, a) loadInto(targetProc, a.sons[0], a.sons[2], v.loc) @@ -809,7 +832,14 @@ proc genTry(p: BProc, t: PNode, d: var TLoc) = 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) + if isDefined("nimStdSetjmp"): + linefmt(p, cpsStmts, "$1.status = setjmp($1.context);$n", safePoint) + elif isDefined("nimSigSetjmp"): + linefmt(p, cpsStmts, "$1.status = sigsetjmp($1.context, 0);$n", safePoint) + elif isDefined("nimRawSetjmp"): + linefmt(p, cpsStmts, "$1.status = _setjmp($1.context);$n", safePoint) + else: + linefmt(p, cpsStmts, "$1.status = setjmp($1.context);$n", safePoint) startBlock(p, "if ($1.status == 0) {$n", [safePoint]) var length = sonsLen(t) add(p.nestedTryStmts, t) @@ -891,6 +921,7 @@ proc genAsmOrEmitStmt(p: BProc, t: PNode, isAsmStmt=false): PRope = app(result, x) app(result, "\\n\"\n") else: + res.add(tnl) result = res.toRope proc genAsmStmt(p: BProc, t: PNode) = diff --git a/compiler/ccgtrav.nim b/compiler/ccgtrav.nim index 26f474659..a5bf9e7a7 100644 --- a/compiler/ccgtrav.nim +++ b/compiler/ccgtrav.nim @@ -19,7 +19,7 @@ type proc genTraverseProc(c: var TTraversalClosure, accessor: PRope, typ: PType) proc genCaseRange(p: BProc, branch: PNode) -proc getTemp(p: BProc, t: PType, result: var TLoc) +proc getTemp(p: BProc, t: PType, result: var TLoc; needsInit=false) proc genTraverseProc(c: var TTraversalClosure, accessor: PRope, n: PNode) = if n == nil: return diff --git a/compiler/ccgtypes.nim b/compiler/ccgtypes.nim index 8e762ce27..fc6febc6f 100644 --- a/compiler/ccgtypes.nim +++ b/compiler/ccgtypes.nim @@ -122,6 +122,7 @@ proc mapSetType(typ: PType): TCTypeKind = else: result = ctArray proc mapType(typ: PType): TCTypeKind = + ## Maps a nimrod type to a C type case typ.kind of tyNone, tyStmt: result = ctVoid of tyBool: result = ctBool @@ -453,7 +454,7 @@ proc getRecordDesc(m: BModule, typ: PType, name: PRope, appf(result, " {$n", [name]) var desc = getRecordFields(m, typ, check) - if (desc == nil) and not hasField: + if desc == nil and not hasField: appf(result, "char dummy;$n", []) else: app(result, desc) @@ -722,7 +723,7 @@ proc discriminatorTableName(m: BModule, objtype: PType, d: PSym): PRope = 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)]) + toRope(objtype.id), toRope(d.name.s.mangle)]) proc discriminatorTableDecl(m: BModule, objtype: PType, d: PSym): PRope = discard cgsym(m, "TNimNode") @@ -895,11 +896,20 @@ type include ccgtrav -proc genTypeInfo(m: BModule, t: PType): PRope = +proc genDeepCopyProc(m: BModule; s: PSym; result: PRope) = + genProc(m, s) + appf(m.s[cfsTypeInit3], "$1.deepcopy = (N_NIMCALL_PTR(void*, void*)) $2;$n", + [result, s.loc.r]) + +proc genTypeInfo(m: BModule, t: PType): PRope = + let origType = t var t = getUniqueType(t) result = ropef("NTI$1", [toRope(t.id)]) if containsOrIncl(m.typeInfoMarker, t.id): return con("(&".toRope, result, ")".toRope) + + # getUniqueType doesn't skip tyDistinct when that has an overriden operation: + while t.kind == tyDistinct: t = t.lastSon let owner = t.skipTypes(typedescPtrs).owner.getModule if owner != m.module: # make sure the type info is created in the owner module @@ -936,6 +946,10 @@ proc genTypeInfo(m: BModule, t: PType): PRope = # results are not deterministic! genTupleInfo(m, t, result) else: internalError("genTypeInfo(" & $t.kind & ')') + if t.deepCopy != nil: + genDeepCopyProc(m, t.deepCopy, result) + elif origType.deepCopy != nil: + genDeepCopyProc(m, origType.deepCopy, result) result = con("(&".toRope, result, ")".toRope) proc genTypeSection(m: BModule, n: PNode) = diff --git a/compiler/ccgutils.nim b/compiler/ccgutils.nim index 04983d6a4..65957584a 100644 --- a/compiler/ccgutils.nim +++ b/compiler/ccgutils.nim @@ -89,9 +89,15 @@ proc getUniqueType*(key: PType): PType = of tyTypeDesc, tyTypeClasses, tyGenericParam, tyFromExpr, tyFieldAccessor: internalError("GetUniqueType") - of tyGenericInst, tyDistinct, tyOrdinal, tyMutable, - tyConst, tyIter, tyStatic: + of tyDistinct: + if key.deepCopy != nil: result = key + else: result = getUniqueType(lastSon(key)) + of tyGenericInst, tyOrdinal, tyMutable, tyConst, tyIter, tyStatic: result = getUniqueType(lastSon(key)) + #let obj = lastSon(key) + #if obj.sym != nil and obj.sym.name.s == "TOption": + # echo "for ", typeToString(key), " I returned " + # debug result of tyArrayConstr, tyGenericInvokation, tyGenericBody, tyOpenArray, tyArray, tySet, tyRange, tyTuple, tyPtr, tyRef, tySequence, tyForward, tyVarargs, tyProxy, tyVar: @@ -124,7 +130,7 @@ proc getUniqueType*(key: PType): PType = if t != nil and sameType(t, key): return t idTablePut(gTypeTable[k], key, key) - result = key + result = key of tyEnum: result = PType(idTableGet(gTypeTable[k], key)) if result == nil: diff --git a/compiler/cgen.nim b/compiler/cgen.nim index e2f3b5ab0..359fa3309 100644 --- a/compiler/cgen.nim +++ b/compiler/cgen.nim @@ -13,7 +13,7 @@ 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, + times, ropes, math, passes, rodread, wordrecg, treetab, cgmeth, condsyms, rodutils, renderer, idgen, cgendata, ccgmerge, semfold, aliases, lowerings, semparallel @@ -295,6 +295,7 @@ proc postStmtActions(p: BProc) {.inline.} = proc accessThreadLocalVar(p: BProc, s: PSym) proc emulatedThreadVars(): bool {.inline.} +proc genProc(m: BModule, prc: PSym) include "ccgtypes.nim" @@ -398,7 +399,7 @@ proc initLocalVar(p: BProc, v: PSym, immediateAsgn: bool) = if not immediateAsgn: constructLoc(p, v.loc) -proc getTemp(p: BProc, t: PType, result: var TLoc) = +proc getTemp(p: BProc, t: PType, result: var TLoc; needsInit=false) = inc(p.labels) if gCmd == cmdCompileToLLVM: result.r = con("%LOC", toRope(p.labels)) @@ -410,7 +411,7 @@ proc getTemp(p: BProc, t: PType, result: var TLoc) = result.t = getUniqueType(t) result.s = OnStack result.flags = {} - constructLoc(p, result, isTemp=true) + constructLoc(p, result, not needsInit) proc keepAlive(p: BProc, toKeepAlive: TLoc) = when false: @@ -574,7 +575,6 @@ proc fixLabel(p: BProc, labl: TLabel) = proc genVarPrototype(m: BModule, sym: PSym) 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) @@ -949,13 +949,23 @@ proc genFilenames(m: BModule): PRope = proc genMainProc(m: BModule) = 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 = - "\tsystemDatInit();$N" & + "void PreMainInner() {$N" & "\tsystemInit();$N" & "$1" & "$2" & "$3" & - "$4" + "}$N$N" & + "void PreMain() {$N" & + "\tvoid (*volatile inner)();$N" & + "\tsystemDatInit();$N" & + "\tinner = PreMainInner;$N" & + "$4" & + "\t(*inner)();$N" & + "}$N$N" MainProcs = "\tNimMain();$N" @@ -964,9 +974,15 @@ proc genMainProc(m: BModule) = MainProcs & "\treturn nim_program_result;$N" NimMainBody = + "N_CDECL(void, NimMainInner)(void) {$N" & + "$1" & + "}$N$N" & "N_CDECL(void, NimMain)(void) {$N" & + "\tvoid (*volatile inner)();$N" & "\tPreMain();$N" & - "$1" & + "\tinner = NimMainInner;$N" & + "$2" & + "\t(*inner)();$N" & "}$N$N" PosixNimMain = @@ -1034,14 +1050,15 @@ proc genMainProc(m: BModule) = if optEndb in gOptions: gBreakpoints.app(m.genFilenames) - let initStackBottomCall = if emulatedThreadVars() or - platform.targetOS == osStandalone: "".toRope - else: ropecg(m, "\t#initStackBottom();$N") + let initStackBottomCall = + if emulatedThreadVars() or + platform.targetOS == osStandalone: "".toRope + else: ropecg(m, "\t#initStackBottomWith((void *)&inner);$N") inc(m.labels) - appcg(m, m.s[cfsProcs], "void PreMain() {$N" & PreMainBody & "}$N$N", [ - mainDatInit, initStackBottomCall, gBreakpoints, otherModsInit]) + appcg(m, m.s[cfsProcs], PreMainBody, [ + mainDatInit, gBreakpoints, otherModsInit, initStackBottomCall]) - appcg(m, m.s[cfsProcs], nimMain, [mainModInit, toRope(m.labels)]) + appcg(m, m.s[cfsProcs], nimMain, [mainModInit, initStackBottomCall, toRope(m.labels)]) if optNoMain notin gGlobalOptions: appcg(m, m.s[cfsProcs], otherMain, []) diff --git a/compiler/commands.nim b/compiler/commands.nim index 7219c168a..cea965f5c 100644 --- a/compiler/commands.nim +++ b/compiler/commands.nim @@ -80,9 +80,9 @@ proc writeVersionInfo(pass: TCmdLinePass) = platform.OS[platform.hostOS].name, CPU[platform.hostCPU].name])) - const gitHash = gorge("git log -n 1 --format=%H") + discard """const gitHash = gorge("git log -n 1 --format=%H") if gitHash.strip.len == 40: - msgWriteln("git hash: " & gitHash) + msgWriteln("git hash: " & gitHash)""" msgWriteln("active boot switches:" & usedRelease & usedAvoidTimeMachine & usedTinyC & usedGnuReadline & usedNativeStacktrace & usedNoCaas & @@ -315,6 +315,9 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = of "undef", "u": expectArg(switch, arg, pass, info) undefSymbol(arg) + of "symbol": + expectArg(switch, arg, pass, info) + declareSymbol(arg) of "compile": expectArg(switch, arg, pass, info) if pass in {passCmd2, passPP}: processCompile(arg) @@ -390,7 +393,9 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = 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 "threads": + processOnOffSwitchG({optThreads}, arg, pass, info) + if optThreads in gGlobalOptions: incl(gNotes, warnGcUnsafe) of "tlsemulation": processOnOffSwitchG({optTlsEmulation}, arg, pass, info) of "taintmode": processOnOffSwitchG({optTaintMode}, arg, pass, info) of "implicitstatic": diff --git a/compiler/condsyms.nim b/compiler/condsyms.nim index 76026a59d..6d144ad96 100644 --- a/compiler/condsyms.nim +++ b/compiler/condsyms.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2014 Andreas Rumpf # # See the file "copying.txt", included in this @@ -19,6 +19,9 @@ var gSymbols: PStringTable proc defineSymbol*(symbol: string) = gSymbols[symbol] = "true" +proc declareSymbol*(symbol: string) = + gSymbols[symbol] = "unknown" + proc undefSymbol*(symbol: string) = gSymbols[symbol] = "false" @@ -27,6 +30,7 @@ proc isDefined*(symbol: string): bool = result = gSymbols[symbol] == "true" proc isDefined*(symbol: PIdent): bool = isDefined(symbol.s) +proc isDeclared*(symbol: PIdent): bool = gSymbols.hasKey(symbol.s) iterator definedSymbolNames*: string = for key, val in pairs(gSymbols): @@ -37,6 +41,38 @@ proc countDefinedSymbols*(): int = for key, val in pairs(gSymbols): if val == "true": inc(result) +# For ease of bootstrapping, we keep there here and not in the global config +# file for now: +const + additionalSymbols = """ + x86 itanium x8664 + msdos mswindows win32 unix posix sunos bsd macintosh RISCOS doslike hpux + mac + + hppa hp9000 hp9000s300 hp9000s700 hp9000s800 hp9000s820 ELATE sparcv9 + + ecmascript js nimrodvm nimffi nimdoc cpp objc + gcc llvmgcc clang lcc bcc dmc wcc vcc tcc pcc ucc icl + boehmgc gcmarkandsweep gcgenerational nogc gcUseBitvectors + endb profiler + executable guiapp consoleapp library dll staticlib + + quick + release debug + useWinAnsi useFork useNimRtl useMalloc useRealtimeGC ssl memProfiler + nodejs kwin nimfix + + usesysassert usegcassert tinyC useFFI + useStdoutAsStdmsg createNimRtl + booting fulldebug corruption nimsuperops noSignalHandler useGnuReadline + noCaas noDocGen noBusyWaiting nativeStackTrace useNodeIds selftest + reportMissedDeadlines avoidTimeMachine useClone ignoreAllocationSize + debugExecProcesses pcreDll useLipzipSrc + preventDeadlocks UNICODE winUnicode trackGcHeaders posixRealtime + + nimStdSetjmp nimRawSetjmp nimSigSetjmp + """.split + proc initDefines*() = gSymbols = newStringTable(modeStyleInsensitive) defineSymbol("nimrod") # 'nimrod' is always defined @@ -51,8 +87,20 @@ proc initDefines*() = defineSymbol("nimnewshared") defineSymbol("nimrequiresnimframe") defineSymbol("nimparsebiggestfloatmagic") + defineSymbol("nimalias") # add platform specific symbols: + for c in low(CPU)..high(CPU): + declareSymbol("cpu" & $CPU[c].bit) + declareSymbol(normalize(EndianToStr[CPU[c].endian])) + declareSymbol(CPU[c].name) + for o in low(platform.OS)..high(platform.OS): + declareSymbol(platform.OS[o].name) + + for a in additionalSymbols: + declareSymbol(a) + + # ----------------------------------------------------------- case targetCPU of cpuI386: defineSymbol("x86") of cpuIa64: defineSymbol("itanium") @@ -88,5 +136,10 @@ proc initDefines*() = defineSymbol(normalize(EndianToStr[CPU[targetCPU].endian])) defineSymbol(CPU[targetCPU].name) defineSymbol(platform.OS[targetOS].name) + declareSymbol("emulatedthreadvars") if platform.OS[targetOS].props.contains(ospLacksThreadVars): defineSymbol("emulatedthreadvars") + case targetOS + of osSolaris, osNetbsd, osFreebsd, osOpenbsd, osMacosx: + defineSymbol("nimRawSetjmp") + else: discard diff --git a/compiler/docgen.nim b/compiler/docgen.nim index 4c9803401..434e2a65b 100644 --- a/compiler/docgen.nim +++ b/compiler/docgen.nim @@ -383,6 +383,8 @@ proc genItem(d: PDoc, n, nameNode: PNode, k: TSymKind) = var seeSrcRope: PRope = nil let docItemSeeSrc = getConfigVar("doc.item.seesrc") if docItemSeeSrc.len > 0 and options.docSeeSrcUrl.len > 0: + # XXX toFilename doesn't really work. We need to ensure that this keeps + # returning a relative path. let urlRope = ropeFormatNamedVars(options.docSeeSrcUrl, ["path", "line"], [n.info.toFilename.toRope, toRope($n.info.line)]) dispA(seeSrcRope, "$1", "", [ropeFormatNamedVars(docItemSeeSrc, diff --git a/compiler/guards.nim b/compiler/guards.nim index 4cf06fe02..431de6156 100644 --- a/compiler/guards.nim +++ b/compiler/guards.nim @@ -758,7 +758,7 @@ proc pleViaModelRec(m: var TModel; a, b: PNode): TImplication = result = impliesLe(fact, a, b) if result != impUnknown: return result if sameTree(y, a): - result = ple(m, x, b) + result = ple(m, b, x) if result != impUnknown: return result proc pleViaModel(model: TModel; aa, bb: PNode): TImplication = diff --git a/compiler/importer.nim b/compiler/importer.nim index b4cae017e..33ed7e055 100644 --- a/compiler/importer.nim +++ b/compiler/importer.nim @@ -92,7 +92,7 @@ proc rawImportSymbol(c: PContext, s: PSym) = if s.kind == skConverter: addConverter(c, s) if hasPattern(s): addPattern(c, s) -proc importSymbol(c: PContext, n: PNode, fromMod: PSym) = +proc importSymbol(c: PContext, n: PNode, fromMod: PSym) = let ident = lookups.considerQuotedIdent(n) let s = strTableGet(fromMod.tab, ident) if s == nil: @@ -153,12 +153,14 @@ proc importModuleAs(n: PNode, realModule: PSym): PSym = localError(n.info, errGenerated, "module alias must be an identifier") elif n.sons[1].ident.id != realModule.name.id: # some misguided guy will write 'import abc.foo as foo' ... - result = createModuleAlias(realModule, n.sons[1].ident, n.sons[1].info) + result = createModuleAlias(realModule, n.sons[1].ident, realModule.info) -proc myImportModule(c: PContext, n: PNode): PSym = +proc myImportModule(c: PContext, n: PNode): PSym = var f = checkModuleName(n) if f != InvalidFileIDX: result = importModuleAs(n, gImportModule(c.module, f)) + if result.info.fileIndex == n.info.fileIndex: + localError(n.info, errGenerated, "A module cannot import itself") if sfDeprecated in result.flags: message(n.info, warnDeprecated, result.name.s) @@ -171,7 +173,7 @@ proc evalImport(c: PContext, n: PNode): PNode = # ``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) + #importForwarded(c, m.ast, emptySet) proc evalFrom(c: PContext, n: PNode): PNode = result = n @@ -196,4 +198,4 @@ proc evalImportExcept*(c: PContext, n: PNode): PNode = let ident = lookups.considerQuotedIdent(n.sons[i]) exceptSet.incl(ident.id) importAllSymbolsExcept(c, m, exceptSet) - importForwarded(c, m.ast, exceptSet) + #importForwarded(c, m.ast, exceptSet) diff --git a/compiler/jsgen.nim b/compiler/jsgen.nim index 96d8b3d11..dfe498e47 100644 --- a/compiler/jsgen.nim +++ b/compiler/jsgen.nim @@ -10,6 +10,25 @@ # 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, @@ -833,8 +852,8 @@ proc genSwap(p: PProc, n: PNode) = "local $1 = $2; $2 = $3; $3 = $1;$n", [ tmp, a.address, b.address]) tmp = tmp2 - appf(p.body, "var $1 = $2; $2 = $3; $3 = $1" | - "local $1 = $2; $2 = $3; $3 = $1", [tmp, a.res, b.res]) + appf(p.body, "var $1 = $2; $2 = $3; $3 = $1;" | + "local $1 = $2; $2 = $3; $3 = $1;", [tmp, a.res, b.res]) proc getFieldPosition(f: PNode): int = case f.kind @@ -881,14 +900,15 @@ proc genArrayAddr(p: PProc, n: PNode, r: var TCompRes) = a, b: TCompRes first: BiggestInt r.typ = etyBaseIndex - gen(p, n.sons[0], a) - gen(p, n.sons[1], b) + let m = if n.kind == nkHiddenAddr: n.sons[0] else: n + gen(p, m.sons[0], a) + gen(p, m.sons[1], b) internalAssert a.typ != etyBaseIndex and b.typ != etyBaseIndex r.address = a.res - var typ = skipTypes(n.sons[0].typ, abstractPtrs) + var typ = skipTypes(m.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]): + if optBoundsCheck in p.options and not isConstExpr(m.sons[1]): useMagic(p, "chckIndx") r.res = ropef("chckIndx($1, $2, $3.length)-$2", [b.res, toRope(first), a.res]) @@ -1351,7 +1371,7 @@ proc genMagic(p: PProc, n: PNode, r: var TCompRes) = of mEcho: genEcho(p, n, r) of mSlurp, mStaticExec: localError(n.info, errXMustBeCompileTime, n.sons[0].sym.name.s) - of mCopyStr: binaryExpr(p, n, r, "", "($1.slice($2,-1))") + of mCopyStr: binaryExpr(p, n, r, "", "($1.slice($2))") of mCopyStrLast: ternaryExpr(p, n, r, "", "($1.slice($2, ($3)+1).concat(0))") of mNewString: unaryExpr(p, n, r, "mnewString", "mnewString($1)") of mNewStringOfCap: unaryExpr(p, n, r, "mnewString", "mnewString(0)") diff --git a/compiler/lambdalifting.nim b/compiler/lambdalifting.nim index bdad0e471..62e13b9c4 100644 --- a/compiler/lambdalifting.nim +++ b/compiler/lambdalifting.nim @@ -843,8 +843,15 @@ proc transformOuterProc(o: POuterContext, n: PNode; it: TIter): PNode = # every local goes through the closure: #if not containsOrIncl(o.capturedVars, local.id): # addField(it.obj, local) - addUniqueField(it.obj, local) - return indirectAccess(newSymNode(it.closureParam), local, n.info) + if contains(o.capturedVars, local.id): + # 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 + return result + else: + addUniqueField(it.obj, local) + return indirectAccess(newSymNode(it.closureParam), local, n.info) var closure = PEnv(idTableGet(o.lambdasToEnv, local)) if local.kind == skClosureIterator: @@ -942,7 +949,7 @@ proc liftLambdas*(fn: PSym, body: PNode): PNode = discard transformOuterProcBody(o, body, initIter(fn)) result = ex finishEnvironments(o) - #if fn.name.s == "cbOuter": + #if fn.name.s == "parseLong": # echo rendertree(result, {renderIds}) proc liftLambdasForTopLevel*(module: PSym, body: PNode): PNode = diff --git a/compiler/lexer.nim b/compiler/lexer.nim index 0e4dfc2ac..ea51a1399 100644 --- a/compiler/lexer.nim +++ b/compiler/lexer.nim @@ -40,7 +40,7 @@ type tkFinally, tkFor, tkFrom, tkGeneric, tkIf, tkImport, tkIn, tkInclude, tkInterface, tkIs, tkIsnot, tkIterator, - tkLambda, tkLet, + tkLet, tkMacro, tkMethod, tkMixin, tkMod, tkNil, tkNot, tkNotin, tkObject, tkOf, tkOr, tkOut, tkProc, tkPtr, tkRaise, tkRef, tkReturn, tkShl, tkShr, tkStatic, @@ -75,7 +75,7 @@ const "elif", "else", "end", "enum", "except", "export", "finally", "for", "from", "generic", "if", "import", "in", "include", "interface", "is", "isnot", "iterator", - "lambda", "let", + "let", "macro", "method", "mixin", "mod", "nil", "not", "notin", "object", "of", "or", "out", "proc", "ptr", "raise", "ref", "return", diff --git a/compiler/llstream.nim b/compiler/llstream.nim index 86bfeaabd..5aefd468a 100644 --- a/compiler/llstream.nim +++ b/compiler/llstream.nim @@ -77,7 +77,7 @@ proc llStreamClose(s: PLLStream) = of llsFile: close(s.f) -when not defined(readLineFromStdin): +when not declared(readLineFromStdin): # fallback implementation: proc readLineFromStdin(prompt: string, line: var string): bool = stdout.write(prompt) diff --git a/compiler/lookups.nim b/compiler/lookups.nim index aee64f52f..d486585ef 100644 --- a/compiler/lookups.nim +++ b/compiler/lookups.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,7 +11,7 @@ import intsets, ast, astalgo, idents, semdata, types, msgs, options, rodread, - renderer, wordrecg, idgen + renderer, wordrecg, idgen, nimfix.prettybase proc ensureNoMissingOrUnusedSymbols(scope: PScope) @@ -40,11 +40,8 @@ proc considerQuotedIdent*(n: PNode): PIdent = template addSym*(scope: PScope, s: PSym) = 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): bool = + result = not strTableIncl(scope.symbols, s) proc openScope*(c: PContext): PScope {.discardable.} = result = PScope(parent: c.currentScope, @@ -65,6 +62,17 @@ iterator walkScopes*(scope: PScope): PScope = yield current current = current.parent +proc skipAlias*(s: PSym; n: PNode): PSym = + if s == nil or s.kind != skAlias: + result = s + else: + result = s.owner + if gCmd == cmdPretty: + prettybase.replaceDeprecated(n.info, s, result) + else: + message(n.info, warnDeprecated, "use " & result.name.s & " instead; " & + s.name.s) + proc localSearchInScope*(c: PContext, s: PIdent): PSym = result = strTableGet(c.currentScope.symbols, s) @@ -139,14 +147,14 @@ proc wrongRedefinition*(info: TLineInfo, s: string) = localError(info, errAttemptToRedefine, s) proc addDecl*(c: PContext, sym: PSym) = - if c.currentScope.addUniqueSym(sym) == Failure: + if not c.currentScope.addUniqueSym(sym): wrongRedefinition(sym.info, sym.name.s) proc addPrelimDecl*(c: PContext, sym: PSym) = discard c.currentScope.addUniqueSym(sym) proc addDeclAt*(scope: PScope, sym: PSym) = - if scope.addUniqueSym(sym) == Failure: + if not scope.addUniqueSym(sym): wrongRedefinition(sym.info, sym.name.s) proc addInterfaceDeclAux(c: PContext, sym: PSym) = @@ -163,7 +171,7 @@ proc addOverloadableSymAt*(scope: PScope, fn: PSym) = if fn.kind notin OverloadableSyms: internalError(fn.info, "addOverloadableSymAt") return - var check = strTableGet(scope.symbols, fn.name) + let check = strTableGet(scope.symbols, fn.name) if check != nil and check.kind notin OverloadableSyms: wrongRedefinition(fn.info, fn.name.s) else: @@ -179,20 +187,41 @@ proc addInterfaceOverloadableSymAt*(c: PContext, scope: PScope, sym: PSym) = addOverloadableSymAt(scope, sym) addInterfaceDeclAux(c, sym) +when defined(nimfix): + import strutils + + # when we cannot find the identifier, retry with a changed identifer: + proc altSpelling(x: PIdent): PIdent = + case x.s[0] + of 'A'..'Z': result = getIdent(toLower(x.s[0]) & x.s.substr(1)) + of 'a'..'z': result = getIdent(toLower(x.s[0]) & x.s.substr(1)) + else: result = x + + template fixSpelling(n: PNode; ident: PIdent; op: expr) = + let alt = ident.altSpelling + result = op(c, alt).skipAlias(n) + if result != nil: + prettybase.replaceDeprecated(n.info, ident, alt) + return result +else: + template fixSpelling(n: PNode; ident: PIdent; op: expr) = discard + proc lookUp*(c: PContext, n: PNode): PSym = # Looks up a symbol. Generates an error in case of nil. case n.kind of nkIdent: - result = searchInScopes(c, n.ident) - if result == nil: + result = searchInScopes(c, n.ident).skipAlias(n) + if result == nil: + fixSpelling(n, n.ident, searchInScopes) localError(n.info, errUndeclaredIdentifier, n.ident.s) result = errorSym(c, n) of nkSym: result = n.sym of nkAccQuoted: var ident = considerQuotedIdent(n) - result = searchInScopes(c, ident) + result = searchInScopes(c, ident).skipAlias(n) if result == nil: + fixSpelling(n, ident, searchInScopes) localError(n.info, errUndeclaredIdentifier, ident.s) result = errorSym(c, n) else: @@ -206,36 +235,38 @@ type TLookupFlag* = enum checkAmbiguity, checkUndeclared -proc qualifiedLookUp*(c: PContext, n: PNode, flags = {checkUndeclared}): PSym = +proc qualifiedLookUp*(c: PContext, n: PNode, flags = {checkUndeclared}): PSym = case n.kind of nkIdent, nkAccQuoted: var ident = considerQuotedIdent(n) - result = searchInScopes(c, ident) - if result == nil and checkUndeclared in flags: + result = searchInScopes(c, ident).skipAlias(n) + if result == nil and checkUndeclared in flags: + fixSpelling(n, ident, searchInScopes) localError(n.info, errUndeclaredIdentifier, ident.s) result = errorSym(c, n) - elif checkAmbiguity in flags and result != nil and - contains(c.ambiguousSymbols, result.id): + elif checkAmbiguity in flags and result != nil and + contains(c.ambiguousSymbols, result.id): localError(n.info, errUseQualifier, ident.s) of nkSym: result = n.sym - if checkAmbiguity in flags and contains(c.ambiguousSymbols, result.id): + if checkAmbiguity in flags and contains(c.ambiguousSymbols, result.id): localError(n.info, errUseQualifier, n.sym.name.s) - of nkDotExpr: + of nkDotExpr: result = nil var m = qualifiedLookUp(c, n.sons[0], flags*{checkUndeclared}) - if (m != nil) and (m.kind == skModule): + if m != nil and m.kind == skModule: var ident: PIdent = nil - if n.sons[1].kind == nkIdent: + if n.sons[1].kind == nkIdent: ident = n.sons[1].ident - elif n.sons[1].kind == nkAccQuoted: + elif n.sons[1].kind == nkAccQuoted: ident = considerQuotedIdent(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: + if ident != nil: + if m == c.module: + result = strTableGet(c.topLevelScope.symbols, ident).skipAlias(n) + else: + result = strTableGet(m.tab, ident).skipAlias(n) + if result == nil and checkUndeclared in flags: + fixSpelling(n.sons[1], ident, searchInScopes) localError(n.sons[1].info, errUndeclaredIdentifier, ident.s) result = errorSym(c, n.sons[1]) elif n.sons[1].kind == nkSym: @@ -256,7 +287,7 @@ proc initOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = o.scope = c.currentScope o.mode = oimNoQualifier while true: - result = initIdentIter(o.it, o.scope.symbols, ident) + result = initIdentIter(o.it, o.scope.symbols, ident).skipAlias(n) if result != nil: break else: @@ -277,11 +308,12 @@ proc initOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = 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).skipAlias(n) o.mode = oimSelfModule - else: - result = initIdentIter(o.it, o.m.tab, ident) - else: + else: + result = initIdentIter(o.it, o.m.tab, ident).skipAlias(n) + else: localError(n.sons[1].info, errIdentifierExpected, renderTree(n.sons[1])) result = errorSym(c, n.sons[1]) @@ -307,18 +339,18 @@ proc nextOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = result = nil of oimNoQualifier: if o.scope != nil: - result = nextIdentIter(o.it, o.scope.symbols) + result = nextIdentIter(o.it, o.scope.symbols).skipAlias(n) while result == nil: o.scope = o.scope.parent if o.scope == nil: break - result = initIdentIter(o.it, o.scope.symbols, o.it.name) + result = initIdentIter(o.it, o.scope.symbols, o.it.name).skipAlias(n) # BUGFIX: o.it.name <-> n.ident else: result = nil of oimSelfModule: - result = nextIdentIter(o.it, c.topLevelScope.symbols) + result = nextIdentIter(o.it, c.topLevelScope.symbols).skipAlias(n) of oimOtherModule: - result = nextIdentIter(o.it, o.m.tab) + result = nextIdentIter(o.it, o.m.tab).skipAlias(n) of oimSymChoice: if o.symChoiceIndex < sonsLen(n): result = n.sons[o.symChoiceIndex].sym @@ -329,31 +361,27 @@ proc nextOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = o.mode = oimSymChoiceLocalLookup o.scope = c.currentScope result = firstIdentExcluding(o.it, o.scope.symbols, - n.sons[0].sym.name, o.inSymChoice) + n.sons[0].sym.name, o.inSymChoice).skipAlias(n) 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) + n.sons[0].sym.name, o.inSymChoice).skipAlias(n) of oimSymChoiceLocalLookup: - result = nextIdentExcluding(o.it, o.scope.symbols, o.inSymChoice) + result = nextIdentExcluding(o.it, o.scope.symbols, o.inSymChoice).skipAlias(n) 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) + n.sons[0].sym.name, o.inSymChoice).skipAlias(n) if result != nil and result.kind == skStub: loadStub(result) -when false: - proc qualifiedLookUpPreferImmediate*(c: PContext, n: PNode, - flags = {checkUndeclared}): PSym = - var o: TOverloadIter - result = initOverloadIter(o, c, n) - var a = result - while a != nil: - if sfImmediate in a.flags: return a - a = nextOverloadIter(o, c, n) - if result == nil and checkUndeclared in flags: - localError(n.info, errUndeclaredIdentifier, n.considerQuotedIdent.s) - result = errorSym(c, n) +proc pickSym*(c: PContext, n: PNode; kind: TSymKind; + flags: TSymFlags = {}): PSym = + var o: TOverloadIter + var a = initOverloadIter(o, c, n) + while a != nil: + if a.kind == kind and flags <= a.flags: + return a + a = nextOverloadIter(o, c, n) diff --git a/compiler/lowerings.nim b/compiler/lowerings.nim index 5b61a9cae..e1fb09e44 100644 --- a/compiler/lowerings.nim +++ b/compiler/lowerings.nim @@ -56,6 +56,7 @@ proc lowerTupleUnpacking*(n: PNode; owner: PSym): PNode = result.add newAsgnStmt(newSymNode(temp), value) for i in 0 .. n.len-3: + if n.sons[i].kind == nkSym: v.addVar(n.sons[i]) result.add newAsgnStmt(n.sons[i], newTupleAccess(value, i)) proc createObj*(owner: PSym, info: TLineInfo): PType = @@ -122,8 +123,8 @@ proc indirectAccess*(a: PNode, b: string, info: TLineInfo): PNode = if t == nil: break t = t.skipTypes(abstractInst) #if field == nil: + # echo "FIELD ", b # debug deref.typ - # echo deref.typ.id internalAssert field != nil addSon(deref, a) result = newNodeI(nkDotExpr, info) @@ -185,14 +186,14 @@ proc callProc(a: PNode): PNode = # - 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 + 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 = +proc spawnResult*(t: PType; inParallel: bool): TSpawnResult = if t.isEmptyType: srVoid elif inParallel and not containsGarbageCollectedRef(t): srByVar else: srFlowVar @@ -202,7 +203,8 @@ proc flowVarKind(t: PType): TFlowVarKind = elif containsGarbageCollectedRef(t): fvInvalid else: fvBlob -proc addLocalVar(varSection: PNode; owner: PSym; typ: PType; v: PNode): PSym = +proc addLocalVar(varSection, varInit: PNode; owner: PSym; typ: PType; + v: PNode): PSym = result = newSym(skTemp, getIdent(genPrefix), owner, varSection.info) result.typ = typ incl(result.flags, sfFromGeneric) @@ -210,8 +212,14 @@ proc addLocalVar(varSection: PNode; owner: PSym; typ: PType; v: PNode): PSym = var vpart = newNodeI(nkIdentDefs, varSection.info, 3) vpart.sons[0] = newSymNode(result) vpart.sons[1] = ast.emptyNode - vpart.sons[2] = v + vpart.sons[2] = if varInit.isNil: v else: ast.emptyNode varSection.add vpart + if varInit != nil: + let deepCopyCall = newNodeI(nkCall, varInit.info, 3) + deepCopyCall.sons[0] = newSymNode(createMagic("deepCopy", mDeepCopy)) + deepCopyCall.sons[1] = newSymNode(result) + deepCopyCall.sons[2] = v + varInit.add deepCopyCall discard """ We generate roughly this: @@ -244,24 +252,24 @@ stmtList: """ proc createWrapperProc(f: PNode; threadParam, argsParam: PSym; - varSection, call, barrier, fv: PNode; + varSection, varInit, call, barrier, fv: PNode; spawnKind: TSpawnResult): PSym = var body = newNodeI(nkStmtList, f.info) var threadLocalBarrier: PSym if barrier != nil: - var varSection = newNodeI(nkVarSection, barrier.info) - threadLocalBarrier = addLocalVar(varSection, argsParam.owner, + var varSection2 = newNodeI(nkVarSection, barrier.info) + threadLocalBarrier = addLocalVar(varSection2, nil, argsParam.owner, barrier.typ, barrier) - body.add varSection + body.add varSection2 body.add callCodeGenProc("barrierEnter", threadLocalBarrier.newSymNode) var threadLocalProm: PSym if spawnKind == srByVar: - threadLocalProm = addLocalVar(varSection, argsParam.owner, fv.typ, fv) + threadLocalProm = addLocalVar(varSection, nil, argsParam.owner, fv.typ, fv) elif fv != nil: internalAssert fv.typ.kind == tyGenericInst - threadLocalProm = addLocalVar(varSection, argsParam.owner, fv.typ, fv) - + threadLocalProm = addLocalVar(varSection, nil, argsParam.owner, fv.typ, fv) body.add varSection + body.add varInit if fv != nil and spawnKind != srByVar: # generate: # fv.owner = threadParam @@ -314,7 +322,8 @@ proc createCastExpr(argsParam: PSym; objType: PType): PNode = result.typ.rawAddSon(objType) proc setupArgsForConcurrency(n: PNode; objType: PType; scratchObj: PSym, - castExpr, call, varSection, result: PNode) = + castExpr, call, + varSection, varInit, result: PNode) = let formals = n[0].typ.n let tmpName = getIdent(genPrefix) for i in 1 .. <n.len: @@ -323,8 +332,8 @@ proc setupArgsForConcurrency(n: PNode; objType: PType; scratchObj: PSym, var argType = n[i].typ.skipTypes(abstractInst) if i < formals.len and formals[i].typ.kind == tyVar: localError(n[i].info, "'spawn'ed function cannot have a 'var' parameter") - elif containsTyRef(argType): - localError(n[i].info, "'spawn'ed function cannot refer to 'ref'/closure") + #elif containsTyRef(argType): + # localError(n[i].info, "'spawn'ed function cannot refer to 'ref'/closure") let fieldname = if i < formals.len: formals[i].sym.name else: tmpName var field = newSym(skField, fieldname, objType.owner, n.info) @@ -332,8 +341,8 @@ proc setupArgsForConcurrency(n: PNode; objType: PType; scratchObj: PSym, objType.addField(field) result.add newFastAsgnStmt(newDotExpr(scratchObj, field), n[i]) - let temp = addLocalVar(varSection, objType.owner, argType, - indirectAccess(castExpr, field, n.info)) + let temp = addLocalVar(varSection, varInit, objType.owner, argType, + indirectAccess(castExpr, field, n.info)) call.add(newSymNode(temp)) proc getRoot*(n: PNode): PSym = @@ -367,7 +376,8 @@ proc genHigh(n: PNode): PNode = result.sons[1] = n proc setupArgsForParallelism(n: PNode; objType: PType; scratchObj: PSym; - castExpr, call, varSection, result: PNode) = + castExpr, call, + varSection, varInit, result: PNode) = let formals = n[0].typ.n let tmpName = getIdent(genPrefix) # we need to copy the foreign scratch object fields into local variables @@ -376,8 +386,8 @@ proc setupArgsForParallelism(n: PNode; objType: PType; scratchObj: PSym; let n = n[i] let argType = skipTypes(if i < formals.len: formals[i].typ else: n.typ, abstractInst) - if containsTyRef(argType): - localError(n.info, "'spawn'ed function cannot refer to 'ref'/closure") + #if containsTyRef(argType): + # localError(n.info, "'spawn'ed function cannot refer to 'ref'/closure") let fieldname = if i < formals.len: formals[i].sym.name else: tmpName var field = newSym(skField, fieldname, objType.owner, n.info) @@ -403,7 +413,7 @@ proc setupArgsForParallelism(n: PNode; objType: PType; scratchObj: PSym; result.add newFastAsgnStmt(newDotExpr(scratchObj, fieldA), n[2]) result.add newFastAsgnStmt(newDotExpr(scratchObj, fieldB), n[3]) - let threadLocal = addLocalVar(varSection, objType.owner, fieldA.typ, + let threadLocal = addLocalVar(varSection,nil, objType.owner, fieldA.typ, indirectAccess(castExpr, fieldA, n.info)) slice.sons[2] = threadLocal.newSymNode else: @@ -417,7 +427,7 @@ proc setupArgsForParallelism(n: PNode; objType: PType; scratchObj: PSym; # the array itself does not need to go through a thread local variable: slice.sons[1] = genDeref(indirectAccess(castExpr, field, n.info)) - let threadLocal = addLocalVar(varSection, objType.owner, fieldB.typ, + let threadLocal = addLocalVar(varSection,nil, objType.owner, fieldB.typ, indirectAccess(castExpr, fieldB, n.info)) slice.sons[3] = threadLocal.newSymNode call.add slice @@ -428,7 +438,7 @@ proc setupArgsForParallelism(n: PNode; objType: PType; scratchObj: PSym; field.typ = a.typ objType.addField(field) result.add newFastAsgnStmt(newDotExpr(scratchObj, field), a) - let threadLocal = addLocalVar(varSection, objType.owner, field.typ, + let threadLocal = addLocalVar(varSection,nil, objType.owner, field.typ, indirectAccess(castExpr, field, n.info)) call.add(genDeref(threadLocal.newSymNode)) else: @@ -436,7 +446,8 @@ proc setupArgsForParallelism(n: PNode; objType: PType; scratchObj: PSym; field.typ = argType objType.addField(field) result.add newFastAsgnStmt(newDotExpr(scratchObj, field), n) - let threadLocal = addLocalVar(varSection, objType.owner, field.typ, + let threadLocal = addLocalVar(varSection, varInit, + objType.owner, field.typ, indirectAccess(castExpr, field, n.info)) call.add(threadLocal.newSymNode) @@ -504,10 +515,13 @@ proc wrapProcForSpawn*(owner: PSym; spawnExpr: PNode; retType: PType; call.add(fn) var varSection = newNodeI(nkVarSection, n.info) + var varInit = newNodeI(nkStmtList, n.info) if barrier.isNil: - setupArgsForConcurrency(n, objType, scratchObj, castExpr, call, varSection, result) - else: - setupArgsForParallelism(n, objType, scratchObj, castExpr, call, varSection, result) + setupArgsForConcurrency(n, objType, scratchObj, castExpr, call, + varSection, varInit, result) + else: + setupArgsForParallelism(n, objType, scratchObj, castExpr, call, + varSection, varInit, result) var barrierAsExpr: PNode = nil if barrier != nil: @@ -539,7 +553,8 @@ proc wrapProcForSpawn*(owner: PSym; spawnExpr: PNode; retType: PType; fvAsExpr = indirectAccess(castExpr, field, n.info) result.add newFastAsgnStmt(newDotExpr(scratchObj, field), genAddrOf(dest)) - let wrapper = createWrapperProc(fn, threadParam, argsParam, varSection, call, + let wrapper = createWrapperProc(fn, threadParam, argsParam, + varSection, varInit, call, barrierAsExpr, fvAsExpr, spawnKind) result.add callCodeGenProc("nimSpawn", wrapper.newSymNode, genAddrOf(scratchObj.newSymNode)) diff --git a/compiler/nimfix/nimfix.nim b/compiler/nimfix/nimfix.nim new file mode 100644 index 000000000..e561b6d4d --- /dev/null +++ b/compiler/nimfix/nimfix.nim @@ -0,0 +1,106 @@ +# +# +# The Nim Compiler +# (c) Copyright 2014 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Nimfix is a tool that helps to convert old-style Nimrod code to Nim code. + +import strutils, os, parseopt +import options, commands, modules, sem, passes, passaux, pretty, msgs, nimconf, + extccomp, condsyms, lists + +const Usage = """ +Nimfix - Tool to patch Nim code +Usage: + nimfix [options] projectflie.nim + +Options: + --overwriteFiles:on|off overwrite the original nim files. + DEFAULT is ON! + --wholeProject overwrite every processed file. + --checkExtern:on|off style check also extern names + --styleCheck:on|off|auto performs style checking for identifiers + and suggests an alternative spelling; + 'auto' corrects the spelling. + +In addition, all command line options of Nim are supported. +""" + +proc mainCommand = + #msgs.gErrorMax = high(int) # do not stop after first error + registerPass verbosePass + registerPass semPass + gCmd = cmdPretty + appendStr(searchPaths, options.libpath) + if gProjectFull.len != 0: + # current path is always looked first for modules + prependStr(searchPaths, gProjectPath) + + compileProject() + pretty.overwriteFiles() + +proc processCmdLine*(pass: TCmdLinePass, cmd: string) = + var p = parseopt.initOptParser(cmd) + var argsCount = 0 + gOnlyMainfile = true + while true: + parseopt.next(p) + case p.kind + of cmdEnd: break + of cmdLongoption, cmdShortOption: + case p.key.normalize + of "overwritefiles": + case p.val.normalize + of "on": gOverWrite = true + of "off": gOverWrite = false + else: localError(gCmdLineInfo, errOnOrOffExpected) + of "checkextern": + case p.val.normalize + of "on": gCheckExtern = true + of "off": gCheckExtern = false + else: localError(gCmdLineInfo, errOnOrOffExpected) + of "stylecheck": + case p.val.normalize + of "off": gStyleCheck = StyleCheck.None + of "on": gStyleCheck = StyleCheck.Warn + of "auto": gStyleCheck = StyleCheck.Auto + else: localError(gCmdLineInfo, errOnOrOffExpected) + of "wholeproject": gOnlyMainfile = false + else: + processSwitch(pass, p) + of cmdArgument: + options.gProjectName = unixToNativePath(p.key) + # if processArgument(pass, p, argsCount): break + +proc handleCmdLine() = + if paramCount() == 0: + stdout.writeln(Usage) + else: + processCmdLine(passCmd1, "") + if gProjectName != "": + try: + gProjectFull = canonicalizePath(gProjectName) + except OSError: + gProjectFull = gProjectName + var p = splitFile(gProjectFull) + gProjectPath = p.dir + gProjectName = p.name + else: + gProjectPath = getCurrentDir() + loadConfigs(DefaultConfig) # 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() + +when compileOption("gc", "v2") or compileOption("gc", "refc"): + GC_disableMarkAndSweep() + +condsyms.initDefines() +defineSymbol "nimfix" +handleCmdline() diff --git a/compiler/nimfix/nimfix.nim.cfg b/compiler/nimfix/nimfix.nim.cfg new file mode 100644 index 000000000..31a41e080 --- /dev/null +++ b/compiler/nimfix/nimfix.nim.cfg @@ -0,0 +1,17 @@ +# Special configuration file for the Nim project +# gc:markAndSweep + +hint[XDeclaredButNotUsed]:off +path:"$projectPath/../.." + +path:"$lib/packages/docutils" +path:"$nim/compiler" + +define:useStdoutAsStdmsg +symbol:nimfix +define:nimfix + +cs:partial +#define:useNodeIds +define:booting +define:noDocgen diff --git a/compiler/nimfix/pretty.nim b/compiler/nimfix/pretty.nim new file mode 100644 index 000000000..acac574af --- /dev/null +++ b/compiler/nimfix/pretty.nim @@ -0,0 +1,152 @@ +# +# +# The Nim Compiler +# (c) Copyright 2014 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## This module implements the code "prettifier". This is part of the toolchain +## to convert Nim code into a consistent style. + +import + strutils, os, options, ast, astalgo, msgs, ropes, idents, + intsets, strtabs, semdata, prettybase + +type + StyleCheck* {.pure.} = enum None, Warn, Auto + +var + gOverWrite* = true + gStyleCheck*: StyleCheck + gCheckExtern*, gOnlyMainfile*: bool + +proc overwriteFiles*() = + let doStrip = options.getConfigVar("pretty.strip").normalize == "on" + for i in 0 .. high(gSourceFiles): + if gSourceFiles[i].dirty and not gSourceFiles[i].isNimfixFile and + (not gOnlyMainfile or gSourceFiles[i].fileIdx == gProjectMainIdx): + let newFile = if gOverWrite: gSourceFiles[i].fullpath + else: gSourceFiles[i].fullpath.changeFileExt(".pretty.nim") + try: + var f = open(newFile, fmWrite) + for line in gSourceFiles[i].lines: + if doStrip: + f.write line.strip(leading = false, trailing = true) + else: + f.write line + f.write(gSourceFiles[i].newline) + f.close + except IOError: + rawMessage(errCannotOpenFile, newFile) + +proc `=~`(s: string, a: openArray[string]): bool = + 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", "cdouble", "cchar", "cschar", + "cshort", "cu", "nil", "expr", "stmt", "typedesc", "auto", "any", + "range", "openarray", "varargs", "set", "cfloat" + ]: + result.add s[i] + else: + result.add toUpper(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 toLower(s[0]) + inc i + while i < s.len: + if s[i] == '_': + if 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 toUpper(s[i]) + elif allUpper: + result.add toLower(s[i]) + else: + result.add s[i] + inc i + +proc replaceInFile(info: TLineInfo; newName: string) = + loadFile(info) + + let line = gSourceFiles[info.fileIndex].lines[info.line-1] + 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 prettybase.Letters: dec first + if first < 0: return + if line[first] == '`': inc first + + let last = first+identLen(line, first)-1 + if differ(line, first, last, newName): + # last-first+1 != newName.len or + var x = line.substr(0, first-1) & newName & line.substr(last+1) + system.shallowCopy(gSourceFiles[info.fileIndex].lines[info.line-1], x) + gSourceFiles[info.fileIndex].dirty = true + +proc checkStyle(info: TLineInfo, s: string, k: TSymKind; sym: PSym) = + let beau = beautifyName(s, k) + if s != beau: + if gStyleCheck == StyleCheck.Auto: + sym.name = getIdent(beau) + replaceInFile(info, beau) + else: + message(info, hintName, beau) + +proc styleCheckDefImpl(info: TLineInfo; s: PSym; k: TSymKind) = + # operators stay as they are: + if k in {skResult, skTemp} or s.name.s[0] notin prettybase.Letters: return + if k in {skType, skGenericParam} and sfAnon in s.flags: return + if {sfImportc, sfExportc} * s.flags == {} or gCheckExtern: + checkStyle(info, s.name.s, k, s) + +template styleCheckDef*(info: TLineInfo; s: PSym; k: TSymKind) = + when defined(nimfix): + if gStyleCheck != StyleCheck.None: styleCheckDefImpl(info, s, k) + +template styleCheckDef*(info: TLineInfo; s: PSym) = + styleCheckDef(info, s, s.kind) +template styleCheckDef*(s: PSym) = + styleCheckDef(s.info, s, s.kind) + +proc styleCheckUseImpl(info: TLineInfo; s: PSym) = + if info.fileIndex < 0: return + # we simply convert it to what it looks like in the definition + # for consistency + + # operators stay as they are: + if s.kind in {skResult, skTemp} or s.name.s[0] notin prettybase.Letters: + return + if s.kind in {skType, skGenericParam} and sfAnon in s.flags: return + let newName = s.name.s + + replaceInFile(info, newName) + #if newName == "File": writeStackTrace() + +template styleCheckUse*(info: TLineInfo; s: PSym) = + when defined(nimfix): + if gStyleCheck != StyleCheck.None: styleCheckUseImpl(info, s) diff --git a/compiler/nimfix/prettybase.nim b/compiler/nimfix/prettybase.nim new file mode 100644 index 000000000..8e0f5db6d --- /dev/null +++ b/compiler/nimfix/prettybase.nim @@ -0,0 +1,93 @@ +# +# +# The Nim Compiler +# (c) Copyright 2014 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +import ast, msgs, strutils, idents, lexbase, streams +from os import splitFile + +type + TSourceFile* = object + lines*: seq[string] + dirty*, isNimfixFile*: bool + fullpath*, newline*: string + fileIdx*: int32 + +var + gSourceFiles*: seq[TSourceFile] = @[] + +proc loadFile*(info: TLineInfo) = + let i = info.fileIndex + if i >= gSourceFiles.len: + gSourceFiles.setLen(i+1) + if gSourceFiles[i].lines.isNil: + gSourceFiles[i].fileIdx = info.fileIndex + gSourceFiles[i].lines = @[] + let path = info.toFullPath + gSourceFiles[i].fullpath = path + gSourceFiles[i].isNimfixFile = path.splitFile.ext == ".nimfix" + # we want to die here for IOError: + for line in lines(path): + gSourceFiles[i].lines.add(line) + # extract line ending of the file: + var lex: TBaseLexer + open(lex, newFileStream(path, fmRead)) + var pos = lex.bufpos + while true: + case lex.buf[pos] + of '\c': + gSourceFiles[i].newline = "\c\L" + break + of '\L', '\0': + gSourceFiles[i].newline = "\L" + break + else: discard + inc pos + close(lex) + +const + Letters* = {'a'..'z', 'A'..'Z', '0'..'9', '\x80'..'\xFF', '_'} + +proc identLen*(line: string, start: int): int = + while start+result < line.len and line[start+result] in Letters: + inc result + +proc differ*(line: string, a, b: int, x: string): bool = + let y = line[a..b] + result = cmpIgnoreStyle(y, x) == 0 and y != x + +proc replaceDeprecated*(info: TLineInfo; oldSym, newSym: PIdent) = + loadFile(info) + + let line = gSourceFiles[info.fileIndex].lines[info.line-1] + var first = min(info.col.int, line.len) + if first < 0: return + #inc first, skipIgnoreCase(line, "proc ", first) + while first > 0 and line[first-1] in Letters: dec first + if first < 0: return + if line[first] == '`': inc first + + let last = first+identLen(line, first)-1 + if cmpIgnoreStyle(line[first..last], oldSym.s) == 0: + var x = line.substr(0, first-1) & newSym.s & line.substr(last+1) + system.shallowCopy(gSourceFiles[info.fileIndex].lines[info.line-1], x) + gSourceFiles[info.fileIndex].dirty = true + #if newSym.s == "File": writeStackTrace() + +proc replaceDeprecated*(info: TLineInfo; oldSym, newSym: PSym) = + replaceDeprecated(info, oldSym.name, newSym.name) + +proc replaceComment*(info: TLineInfo) = + loadFile(info) + + let line = gSourceFiles[info.fileIndex].lines[info.line-1] + var first = info.col.int + if line[first] != '#': inc first + + var x = line.substr(0, first-1) & "discard " & line.substr(first+1).escape + system.shallowCopy(gSourceFiles[info.fileIndex].lines[info.line-1], x) + gSourceFiles[info.fileIndex].dirty = true diff --git a/compiler/nimrod.ini b/compiler/nimrod.ini index 44e16cec8..7135b3490 100644 --- a/compiler/nimrod.ini +++ b/compiler/nimrod.ini @@ -1,3 +1,6 @@ +; This config file holds configuration information about the Nim compiler +; and project. + [Project] Name: "Nimrod" Version: "$version" @@ -34,11 +37,11 @@ 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" +; Files: "doc/*.html" +; Files: "doc/*.cfg" +; Files: "doc/*.pdf" +; Files: "doc/*.ini" +Files: "doc/overview.html" Start: "doc/overview.html" @@ -61,13 +64,9 @@ 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" +Files: "doc/*.txt" +Files: "compiler/nimfix/*.nim" +Files: "compiler/nimfix/*.cfg" [Lib] @@ -115,17 +114,22 @@ Files: "examples/*.tmpl" [Windows] Files: "bin/nimrod.exe" +Files: "bin/nimrod_debug.exe" Files: "bin/c2nim.exe" Files: "bin/niminst.exe" Files: "bin/nimgrep.exe" Files: "dist/*.dll" Files: "koch.exe" -Files: "dist/mingw" +; Files: "dist/mingw" Files: "start.bat" BinPath: r"bin;dist\mingw\bin;dist" -InnoSetup: "Yes" +; Section | dir | zipFile | size hint (in KB) | url | exe start menu entry +Download: r"Documentation|doc|docs.zip|13824|http://nim-lang.org/download/docs-${version}.zip|doc\overview.html" +Download: r"C Compiler (MingW)|dist|mingw.zip|82944|http://nim-lang.org/download/${mingw}.zip" +Download: r"Aporia IDE|dist|aporia.zip|97997|http://nim-lang.org/download/aporia-0.1.3.zip|aporia\bin\aporia.exe" +; for now only NSIS supports optional downloads [UnixBin] Files: "bin/nimrod" @@ -140,6 +144,9 @@ UninstallScript: "yes" path = r"c:\Program Files (x86)\Inno Setup 5\iscc.exe" flags = "/Q" +[NSIS] +path = r"c:\Program Files (x86)\NSIS\makensis.exe" +flags = "/V0" [C_Compiler] path = r"" diff --git a/compiler/nimrod.nim b/compiler/nimrod.nim index ea7621b09..618d98698 100644 --- a/compiler/nimrod.nim +++ b/compiler/nimrod.nim @@ -79,7 +79,7 @@ proc handleCmdLine() = var ex = quoteShell(binPath) execExternalProgram(ex & ' ' & service.arguments) -when defined(GC_setMaxPause): +when declared(GC_setMaxPause): GC_setMaxPause 2_000 when compileOption("gc", "v2") or compileOption("gc", "refc"): diff --git a/compiler/nversion.nim b/compiler/nversion.nim index 3c868ed2a..bd1f79ac6 100644 --- a/compiler/nversion.nim +++ b/compiler/nversion.nim @@ -14,7 +14,7 @@ const MaxSetElements* = 1 shl 16 # (2^16) to support unicode character sets? VersionMajor* = 0 VersionMinor* = 9 - VersionPatch* = 5 + VersionPatch* = 6 VersionAsString* = $VersionMajor & "." & $VersionMinor & "." & $VersionPatch RodFileVersion* = "1215" # modify this if the rod-format changes! diff --git a/compiler/options.nim b/compiler/options.nim index 58a340d21..02719cacc 100644 --- a/compiler/options.nim +++ b/compiler/options.nim @@ -95,7 +95,7 @@ var optBoundsCheck, optOverflowCheck, optAssert, optWarns, optHints, optStackTrace, optLineTrace, optPatterns, optNilCheck} - gGlobalOptions*: TGlobalOptions = {} + gGlobalOptions*: TGlobalOptions = {optThreadAnalysis} gExitcode*: int8 gCmd*: TCommands = cmdNone # the command gSelectedGC* = gcRefc # the selected GC diff --git a/compiler/pragmas.nim b/compiler/pragmas.nim index a17773aa4..d73494c6e 100644 --- a/compiler/pragmas.nim +++ b/compiler/pragmas.nim @@ -1,6 +1,6 @@ # # -# The Nimrod Compiler +# The Nim Compiler # (c) Copyright 2014 Andreas Rumpf # # See the file "copying.txt", included in this @@ -24,7 +24,8 @@ const wCompilerproc, wProcVar, wDeprecated, wVarargs, wCompileTime, wMerge, wBorrow, wExtern, wImportCompilerProc, wThread, wImportCpp, wImportObjC, wAsmNoStackFrame, wError, wDiscardable, wNoInit, wDestructor, wCodegenDecl, - wGensym, wInject, wRaises, wTags, wUses, wOperator, wDelegator, wGcSafe} + wGensym, wInject, wRaises, wTags, wLocks, wDelegator, wGcSafe, + wOverride} converterPragmas* = procPragmas methodPragmas* = procPragmas templatePragmas* = {wImmediate, wDeprecated, wError, wGensym, wInject, wDirty, @@ -35,8 +36,8 @@ const iteratorPragmas* = {FirstCallConv..LastCallConv, wNosideeffect, wSideeffect, wImportc, wExportc, wNodecl, wMagic, wDeprecated, wBorrow, wExtern, wImportCpp, wImportObjC, wError, wDiscardable, wGensym, wInject, wRaises, - wTags, wUses, wOperator, wGcSafe} - exprPragmas* = {wLine} + wTags, wLocks, wGcSafe} + exprPragmas* = {wLine, wLocks} stmtPragmas* = {wChecks, wObjChecks, wFieldChecks, wRangechecks, wBoundchecks, wOverflowchecks, wNilchecks, wAssertions, wWarnings, wHints, wLinedir, wStacktrace, wLinetrace, wOptimization, wHint, wWarning, wError, @@ -44,27 +45,27 @@ const wBreakpoint, wWatchPoint, wPassl, wPassc, wDeadCodeElim, wDeprecated, wFloatchecks, wInfChecks, wNanChecks, wPragma, wEmit, wUnroll, wLinearScanEnd, wPatterns, wEffects, wNoForward, wComputedGoto, - wInjectStmt} + wInjectStmt, wDeprecated} lambdaPragmas* = {FirstCallConv..LastCallConv, wImportc, wExportc, wNodecl, wNosideeffect, wSideeffect, wNoreturn, wDynlib, wHeader, wDeprecated, wExtern, wThread, wImportCpp, wImportObjC, wAsmNoStackFrame, - wRaises, wUses, wTags, wGcSafe} + wRaises, wLocks, wTags, wGcSafe} typePragmas* = {wImportc, wExportc, wDeprecated, wMagic, wAcyclic, wNodecl, wPure, wHeader, wCompilerproc, wFinal, wSize, wExtern, wShallow, wImportCpp, wImportObjC, wError, wIncompleteStruct, wByCopy, wByRef, wInheritable, wGensym, wInject, wRequiresInit, wUnchecked, wUnion, wPacked, wBorrow, wGcSafe} fieldPragmas* = {wImportc, wExportc, wDeprecated, wExtern, - wImportCpp, wImportObjC, wError} + wImportCpp, wImportObjC, wError, wGuard} varPragmas* = {wImportc, wExportc, wVolatile, wRegister, wThreadVar, wNodecl, wMagic, wHeader, wDeprecated, wCompilerproc, wDynlib, wExtern, wImportCpp, wImportObjC, wError, wNoInit, wCompileTime, wGlobal, - wGensym, wInject, wCodegenDecl} + wGensym, wInject, wCodegenDecl, wGuard} constPragmas* = {wImportc, wExportc, wHeader, wDeprecated, wMagic, wNodecl, wExtern, wImportCpp, wImportObjC, wError, wGensym, wInject} letPragmas* = varPragmas procTypePragmas* = {FirstCallConv..LastCallConv, wVarargs, wNosideeffect, - wThread, wRaises, wUses, wTags, wGcSafe} + wThread, wRaises, wLocks, wTags, wGcSafe} allRoutinePragmas* = procPragmas + iteratorPragmas + lambdaPragmas proc pragma*(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords) @@ -127,12 +128,16 @@ proc processImportCpp(s: PSym, extname: string) = incl(s.flags, sfImportc) incl(s.flags, sfInfixCall) excl(s.flags, sfForward) + let m = s.getModule() + incl(m.flags, sfCompileToCpp) proc processImportObjC(s: PSym, extname: string) = setExternName(s, extname) 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)) @@ -513,27 +518,6 @@ proc pragmaRaisesOrTags(c: PContext, n: PNode) = else: invalidPragma(n) -proc pragmaUses(c: PContext, n: PNode) = - proc processExc(c: PContext, x: PNode): PNode = - if x.kind in {nkAccQuoted, nkIdent, nkSym, - nkOpenSymChoice, nkClosedSymChoice}: - if considerQuotedIdent(x).s == "*": - return newSymNode(ast.anyGlobal) - result = c.semExpr(c, x) - if result.kind != nkSym or sfGlobal notin result.sym.flags: - localError(x.info, "'$1' is not a global variable" % result.renderTree) - result = newSymNode(ast.anyGlobal) - - if n.kind == nkExprColonExpr: - let it = n.sons[1] - if it.kind notin {nkCurly, nkBracket}: - n.sons[1] = processExc(c, it) - else: - for i in 0 .. <it.len: - it.sons[i] = processExc(c, it.sons[i]) - else: - invalidPragma(n) - proc typeBorrow(sym: PSym, n: PNode) = if n.kind == nkExprColonExpr: let it = n.sons[1] @@ -541,11 +525,50 @@ proc typeBorrow(sym: PSym, n: PNode) = localError(n.info, "a type can only borrow `.` for now") incl(sym.typ.flags, tfBorrowDot) +proc markCompilerProc(s: PSym) = + makeExternExport(s, "$1", s.info) + incl(s.flags, sfCompilerProc) + incl(s.flags, sfUsed) + registerCompilerProc(s) + +proc deprecatedStmt(c: PContext; pragma: PNode) = + let pragma = pragma[1] + if pragma.kind != nkBracket: + localError(pragma.info, "list of key:value pairs expected"); return + for n in pragma: + if n.kind in {nkExprColonExpr, nkExprEqExpr}: + let dest = qualifiedLookUp(c, n[1]) + let src = considerQuotedIdent(n[0]) + let alias = newSym(skAlias, src, dest, n[0].info) + incl(alias.flags, sfExported) + if sfCompilerProc in dest.flags: markCompilerProc(alias) + addInterfaceDecl(c, alias) + else: + localError(n.info, "key:value pair expected") + +proc pragmaGuard(c: PContext; it: PNode; kind: TSymKind): PSym = + if it.kind != nkExprColonExpr: + invalidPragma(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(n), nil, n.info) + else: + result = qualifiedLookUp(c, 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: + if key.kind == nkIdent: var userPragma = strTableGet(c.userPragmas, key.ident) if userPragma != nil: inc c.instCounter @@ -577,11 +600,11 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, of wAlign: if sym.typ == nil: invalidPragma(it) var align = expectIntLit(c, it) - if not isPowerOfTwo(align) and align != 0: + if (not isPowerOfTwo(align) and align != 0) or align >% high(int16): localError(it.info, errPowerOfTwoExpected) else: - sym.typ.align = align - of wSize: + sym.typ.align = align.int16 + of wSize: if sym.typ == nil: invalidPragma(it) var size = expectIntLit(c, it) if not isPowerOfTwo(size) or size <= 0 or size > 8: @@ -628,11 +651,12 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, # 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: + sym.flags.incl sfOverriden + if sym.name.s.normalize != "destroy": + localError(n.info, errGenerated, "destructor has to be named 'destroy'") + of wOverride: + sym.flags.incl sfOverriden + of wNosideeffect: noVal(it) incl(sym.flags, sfNoSideEffect) if sym.typ != nil: incl(sym.typ.flags, tfNoSideEffect) @@ -646,17 +670,13 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, processDynLib(c, it, sym) of wCompilerproc: noVal(it) # compilerproc may not get a string! - if sfFromGeneric notin sym.flags: - makeExternExport(sym, "$1", it.info) - incl(sym.flags, sfCompilerProc) - incl(sym.flags, sfUsed) # suppress all those stupid warnings - registerCompilerProc(sym) - of wProcVar: + if sfFromGeneric notin sym.flags: markCompilerProc(sym) + of wProcVar: noVal(it) incl(sym.flags, sfProcvar) - of wDeprecated: - noVal(it) - if sym != nil: incl(sym.flags, sfDeprecated) + of wDeprecated: + if it.kind == nkExprColonExpr: deprecatedStmt(c, it) + elif sym != nil: incl(sym.flags, sfDeprecated) else: incl(c.module.flags, sfDeprecated) of wVarargs: noVal(it) @@ -787,10 +807,11 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, if sym == nil: invalidPragma(it) of wLine: pragmaLine(c, it) of wRaises, wTags: pragmaRaisesOrTags(c, it) - of wUses: pragmaUses(c, it) - of wOperator: - if sym == nil: invalidPragma(it) - else: sym.position = expectIntLit(c, it) + of wGuard: + if sym == nil or sym.kind notin {skVar, skLet, skField}: + invalidPragma(it) + else: + sym.guard = pragmaGuard(c, it, sym.kind) of wInjectStmt: if it.kind != nkExprColonExpr: localError(it.info, errExprExpected) diff --git a/compiler/procfind.nim b/compiler/procfind.nim index 0354d585d..9f52cc117 100644 --- a/compiler/procfind.nim +++ b/compiler/procfind.nim @@ -70,8 +70,15 @@ proc searchForProcNew(c: PContext, scope: PScope, fn: PSym): PSym = var it: TIdentIter result = initIdentIter(it, scope.symbols, fn.name) while result != nil: - if result.kind in skProcKinds and - sameType(result.typ, fn.typ, flags): return + if result.kind in skProcKinds and sameType(result.typ, fn.typ, flags): + case equalParams(result.typ.n, fn.typ.n) + of paramsEqual: + return + of paramsIncompatible: + localError(fn.info, errNotOverloadable, fn.name.s) + return + of paramsNotEqual: + discard result = nextIdentIter(it, scope.symbols) diff --git a/compiler/renderer.nim b/compiler/renderer.nim index 0b1312ccc..c97b2f321 100644 --- a/compiler/renderer.nim +++ b/compiler/renderer.nim @@ -925,7 +925,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = of nkCheckedFieldExpr, nkHiddenAddr, nkHiddenDeref: gsub(g, n.sons[0]) of nkLambda: - putWithSpace(g, tkLambda, "proc") + putWithSpace(g, tkProc, "proc") gsub(g, n.sons[paramsPos]) gsub(g, n.sons[pragmasPos]) put(g, tkSpaces, Space) diff --git a/compiler/sem.nim b/compiler/sem.nim index 8025ef70d..26a59334c 100644 --- a/compiler/sem.nim +++ b/compiler/sem.nim @@ -16,7 +16,7 @@ import procfind, lookups, rodread, pragmas, passes, semdata, semtypinst, sigmatch, intsets, transf, vmdef, vm, idgen, aliases, cgmeth, lambdalifting, evaltempl, patterns, parampatterns, sempass2, pretty, semmacrosanity, - semparallel + semparallel, lowerings # implementation diff --git a/compiler/semcall.nim b/compiler/semcall.nim index 65a2d7ab8..927b23cf2 100644 --- a/compiler/semcall.nim +++ b/compiler/semcall.nim @@ -81,6 +81,8 @@ proc notFoundError*(c: PContext, n: PNode, errors: seq[string]) = if c.inCompilesContext > 0: # fail fast: globalError(n.info, errTypeMismatch, "") + if errors.len == 0: + localError(n.info, errExprXCannotBeCalled, n[0].renderTree) var result = msgKindToString(errTypeMismatch) add(result, describeArgs(c, n, 1)) add(result, ')') diff --git a/compiler/semdestruct.nim b/compiler/semdestruct.nim index 791bef823..3c30dc1bd 100644 --- a/compiler/semdestruct.nim +++ b/compiler/semdestruct.nim @@ -125,8 +125,7 @@ proc instantiateDestructor(c: PContext, typ: PType): PType = # The destructor is either user-defined or automatically # generated by the compiler in a member-wise fashion. var t = skipTypes(typ, {tyConst, tyMutable}).skipGenericAlias - let typeHoldingUserDefinition = if t.kind == tyGenericInst: t.base - else: t + let typeHoldingUserDefinition = if t.kind == tyGenericInst: t.base else: t if typeHoldingUserDefinition.destructor != nil: # XXX: This is not entirely correct for recursive types, but we need diff --git a/compiler/semexprs.nim b/compiler/semexprs.nim index 7deb46af9..58cef36f9 100644 --- a/compiler/semexprs.nim +++ b/compiler/semexprs.nim @@ -185,13 +185,15 @@ proc isCastable(dst, src: PType): bool = # castableTypeKinds = {tyInt, tyPtr, tyRef, tyCstring, tyString, # tySequence, tyPointer, tyNil, tyOpenArray, # tyProc, tySet, tyEnum, tyBool, tyChar} + if skipTypes(dst, abstractInst-{tyOpenArray}).kind == tyOpenArray: + return false var dstSize, srcSize: BiggestInt dstSize = computeSize(dst) srcSize = computeSize(src) if dstSize < 0: result = false - elif srcSize < 0: + elif srcSize < 0: result = false elif not typeAllowed(dst, skParam): result = false @@ -199,6 +201,8 @@ proc isCastable(dst, src: PType): bool = result = (dstSize >= srcSize) or (skipTypes(dst, abstractInst).kind in IntegralTypes) or (skipTypes(src, abstractInst-{tyTypeDesc}).kind in IntegralTypes) + if result and src.kind == tyNil: + result = dst.size <= platform.ptrSize proc isSymChoice(n: PNode): bool {.inline.} = result = n.kind in nkSymChoices @@ -592,7 +596,7 @@ proc analyseIfAddressTakenInCall(c: PContext, n: PNode) = const FakeVarParams = {mNew, mNewFinalize, mInc, ast.mDec, mIncl, mExcl, mSetLengthStr, mSetLengthSeq, mAppendStrCh, mAppendStrStr, mSwap, - mAppendSeqElem, mNewSeq, mReset, mShallowCopy} + mAppendSeqElem, mNewSeq, mReset, mShallowCopy, mDeepCopy} # get the real type of the callee # it may be a proc var with a generic alias type, so we skip over them @@ -658,7 +662,7 @@ proc evalAtCompileTime(c: PContext, n: PNode): PNode = # optimization pass: not necessary for correctness of the semantic pass if {sfNoSideEffect, sfCompileTime} * callee.flags != {} and - {sfForward, sfImportc} * callee.flags == {}: + {sfForward, sfImportc} * callee.flags == {} and n.typ != nil: if sfCompileTime notin callee.flags and optImplicitStatic notin gOptions: return @@ -1370,20 +1374,19 @@ proc lookUpForDefined(c: PContext, n: PNode, onlyCurrentScope: bool): PSym = 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) + if m != nil and m.kind == skModule: + let ident = considerQuotedIdent(n[1]) + if m == c.module: + result = strTableGet(c.topLevelScope.symbols, ident) else: - localError(n.sons[1].info, errIdentifierExpected, "") + result = strTableGet(m.tab, ident) of nkAccQuoted: result = lookUpForDefined(c, considerQuotedIdent(n), onlyCurrentScope) of nkSym: result = n.sym - else: + of nkOpenSymChoice, nkClosedSymChoice: + result = n.sons[0].sym + else: localError(n.info, errIdentifierExpected, renderTree(n)) result = nil @@ -1391,10 +1394,16 @@ proc semDefined(c: PContext, n: PNode, onlyCurrentScope: bool): PNode = checkSonsLen(n, 2) # 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): + if not onlyCurrentScope and considerQuotedIdent(n[0]).s == "defined": + if n.sons[1].kind != nkIdent: + localError(n.info, "obsolete usage of 'defined', use 'declared' instead") + elif condsyms.isDefined(n.sons[1].ident): + result.intVal = 1 + elif not condsyms.isDeclared(n.sons[1].ident): + message(n.info, warnUser, + "undeclared conditional symbol; use --symbol to declare it: " & + n[1].ident.s) + elif lookUpForDefined(c, n.sons[1], onlyCurrentScope) != nil: result.intVal = 1 result.info = n.info result.typ = getSysType(tyBool) @@ -1605,6 +1614,11 @@ proc instantiateCreateFlowVarCall(c: PContext; t: PType; initIdTable(bindings) bindings.idTablePut(sym.ast[genericParamsPos].sons[0].typ, t) result = c.semGenerateInstance(c, sym, bindings, info) + # since it's an instantiation, we unmark it as a compilerproc. Otherwise + # codegen would fail: + if sfCompilerProc in result.flags: + result.flags = result.flags - {sfCompilerProc, sfExportC, sfImportC} + result.loc.r = nil proc setMs(n: PNode, s: PSym): PNode = result = n @@ -1643,10 +1657,10 @@ proc semMagic(c: PContext, n: PNode, s: PSym, flags: TExprFlags): PNode = result = setMs(n, s) result.sons[1] = semExpr(c, n.sons[1]) if not result[1].typ.isEmptyType: - if c.inParallelStmt > 0: - result.typ = result[1].typ - else: + if spawnResult(result[1].typ, c.inParallelStmt > 0) == srFlowVar: result.typ = createFlowVar(c, result[1].typ, n.info) + else: + result.typ = result[1].typ result.add instantiateCreateFlowVarCall(c, result[1].typ, n.info).newSymNode else: result = semDirectOp(c, n, flags) @@ -1758,8 +1772,9 @@ proc checkPar(n: PNode): TParKind = var length = sonsLen(n) if length == 0: result = paTuplePositions # () - elif length == 1: - result = paSingle # (expr) + elif length == 1: + if n.sons[0].kind == nkExprColonExpr: result = paTupleFields + else: result = paSingle # (expr) else: if n.sons[0].kind == nkExprColonExpr: result = paTupleFields else: result = paTuplePositions @@ -1920,11 +1935,13 @@ proc semExport(c: PContext, n: PNode): PNode = while s != nil: if s.kind in ExportableSymKinds+{skModule}: x.add(newSymNode(s, a.info)) + strTableAdd(c.module.tab, s) 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 + when false: + 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 proc setGenericParams(c: PContext, n: PNode) = diff --git a/compiler/semgnrc.nim b/compiler/semgnrc.nim index 934434951..a004d1465 100644 --- a/compiler/semgnrc.nim +++ b/compiler/semgnrc.nim @@ -36,10 +36,11 @@ proc semGenericStmtScope(c: PContext, n: PNode, template macroToExpand(s: expr): expr = s.kind in {skMacro, skTemplate} and (s.typ.len == 1 or sfImmediate in s.flags) -proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym): PNode = +proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym, + ctx: var TIntSet): PNode = incl(s.flags, sfUsed) case s.kind - of skUnknown: + of skUnknown: # Introduced in this pass! Leave it as an identifier. result = n of skProc, skMethod, skIterators, skConverter: @@ -48,11 +49,13 @@ proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym): PNode = if macroToExpand(s): let n = fixImmediateParams(n) result = semTemplateExpr(c, n, s, {efNoSemCheck}) + result = semGenericStmt(c, result, {}, ctx) else: result = symChoice(c, n, s, scOpen) of skMacro: if macroToExpand(s): result = semMacroExpr(c, n, n, s, {efNoSemCheck}) + result = semGenericStmt(c, result, {}, ctx) else: result = symChoice(c, n, s, scOpen) of skGenericParam: @@ -80,7 +83,7 @@ proc lookup(c: PContext, n: PNode, flags: TSemGenericFlags, elif s.name.id in ctx: result = symChoice(c, n, s, scForceOpen) else: - result = semGenericStmtSymbol(c, n, s) + result = semGenericStmtSymbol(c, n, s, ctx) # else: leave as nkIdent proc newDot(n, b: PNode): PNode = @@ -95,8 +98,9 @@ proc fuzzyLookup(c: PContext, n: PNode, flags: TSemGenericFlags, var s = qualifiedLookUp(c, n, luf) if s != nil: - result = semGenericStmtSymbol(c, n, s) + result = semGenericStmtSymbol(c, n, s, ctx) else: + n.sons[0] = semGenericStmt(c, n.sons[0], flags, ctx) result = n let n = n[1] let ident = considerQuotedIdent(n) @@ -107,7 +111,7 @@ proc fuzzyLookup(c: PContext, n: PNode, flags: TSemGenericFlags, elif s.name.id in ctx: result = newDot(result, symChoice(c, n, s, scForceOpen)) else: - let sym = semGenericStmtSymbol(c, n, s) + let sym = semGenericStmtSymbol(c, n, s, ctx) if sym.kind == nkSym: result = newDot(result, symChoice(c, n, s, scForceOpen)) else: @@ -158,6 +162,7 @@ proc semGenericStmt(c: PContext, n: PNode, of skMacro: if macroToExpand(s): result = semMacroExpr(c, n, n, s, {efNoSemCheck}) + result = semGenericStmt(c, result, {}, ctx) else: n.sons[0] = symChoice(c, n.sons[0], s, scOption) result = n @@ -165,6 +170,7 @@ proc semGenericStmt(c: PContext, n: PNode, if macroToExpand(s): let n = fixImmediateParams(n) result = semTemplateExpr(c, n, s, {efNoSemCheck}) + result = semGenericStmt(c, result, {}, ctx) else: n.sons[0] = symChoice(c, n.sons[0], s, scOption) result = n diff --git a/compiler/seminst.nim b/compiler/seminst.nim index b93d7ca15..b205eb09a 100644 --- a/compiler/seminst.nim +++ b/compiler/seminst.nim @@ -33,7 +33,8 @@ proc instantiateGenericParamList(c: PContext, n: PNode, pt: TIdTable, localError(a.info, errCannotInstantiateX, s.name.s) t = errorType(c) elif t.kind == tyGenericParam: - internalError(a.info, "instantiateGenericParamList: " & q.name.s) + localError(a.info, errCannotInstantiateX, q.name.s) + t = errorType(c) elif t.kind == tyGenericInvokation: #t = instGenericContainer(c, a, t) t = generateTypeInstance(c, pt, a, t) diff --git a/compiler/semmagic.nim b/compiler/semmagic.nim index f943e7006..d4aeba32a 100644 --- a/compiler/semmagic.nim +++ b/compiler/semmagic.nim @@ -126,7 +126,7 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, result.typ = getSysType(tyString) of mInstantiationInfo: result = semInstantiationInfo(c, n) of mOrd: result = semOrd(c, n) - of mHigh: result = semLowHigh(c, n, mHigh) + 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) diff --git a/compiler/semparallel.nim b/compiler/semparallel.nim index c594a4788..7c489c3b6 100644 --- a/compiler/semparallel.nim +++ b/compiler/semparallel.nim @@ -23,7 +23,7 @@ import ast, astalgo, idents, lowerings, magicsys, guards, sempass2, msgs, - renderer + renderer, types from trees import getMagic from strutils import `%` @@ -406,12 +406,17 @@ proc transformSpawn(owner: PSym; n, barrier: PNode): PNode = if result.isNil: result = newNodeI(nkStmtList, n.info) result.add n - result.add wrapProcForSpawn(owner, m, b.typ, barrier, it[0]) - it.sons[it.len-1] = emptyNode + let t = b[1][0].typ.sons[0] + if spawnResult(t, true) == srByVar: + result.add wrapProcForSpawn(owner, m, b.typ, barrier, it[0]) + it.sons[it.len-1] = emptyNode + else: + it.sons[it.len-1] = wrapProcForSpawn(owner, m, b.typ, barrier, nil) if result.isNil: result = n of nkAsgn, nkFastAsgn: let b = n[1] - if getMagic(b) == mSpawn: + if getMagic(b) == mSpawn and (let t = b[1][0].typ.sons[0]; + spawnResult(t, true) == srByVar): let m = transformSlices(b) return wrapProcForSpawn(owner, m, b.typ, barrier, n[0]) result = transformSpawnSons(owner, n, barrier) @@ -462,4 +467,3 @@ proc liftParallel*(owner: PSym; n: PNode): PNode = result.add callCodeGenProc("openBarrier", barrier) result.add transformSpawn(owner, body, barrier) result.add callCodeGenProc("closeBarrier", barrier) - diff --git a/compiler/sempass2.nim b/compiler/sempass2.nim index c8ce5e787..da4adcf49 100644 --- a/compiler/sempass2.nim +++ b/compiler/sempass2.nim @@ -115,7 +115,7 @@ proc useVar(a: PEffects, n: PNode) = a.addUse(copyNode(n)) if (tfHasGCedMem in s.typ.flags or s.typ.isGCedMem) and tfGcSafe notin s.typ.flags: - message(n.info, warnGcUnsafe, renderTree(n)) + if warnGcUnsafe in gNotes: message(n.info, warnGcUnsafe, renderTree(n)) a.gcUnsafe = true type @@ -315,7 +315,6 @@ 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) - documentEffect(n, n.sons[pragmasPos], wUses, usesEffects) template notGcSafe(t): expr = {tfGcSafe, tfNoSideEffect} * t.flags == {} @@ -332,13 +331,9 @@ proc propagateEffects(tracked: PEffects, n: PNode, s: PSym) = mergeTags(tracked, tagSpec, n) if notGcSafe(s.typ) and sfImportc notin s.flags: - message(n.info, warnGcUnsafe, renderTree(n)) + if warnGcUnsafe in gNotes: message(n.info, warnGcUnsafe, renderTree(n)) tracked.gcUnsafe = true - when trackGlobals: - let usesSpec = effectSpec(pragma, wUses) - mergeUses(tracked, usesSpec, n) - proc notNilCheck(tracked: PEffects, n: PNode, paramType: PType) = let n = n.skipConv if paramType != nil and tfNotNil in paramType.flags and @@ -358,7 +353,7 @@ proc notNilCheck(tracked: PEffects, n: PNode, paramType: PType) = of impYes: discard proc trackOperand(tracked: PEffects, n: PNode, paramType: PType) = - let op = n.typ + let op = skipConvAndClosure(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] @@ -367,21 +362,24 @@ proc trackOperand(tracked: PEffects, n: PNode, paramType: PType) = propagateEffects(tracked, n, s.sym) elif effectList.len == 0: 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: + # we have no explicit effects so assume the worst: addEffect(tracked, createRaise(n)) addTag(tracked, createTag(n)) when trackGlobals: addUse(tracked, createAnyGlobal(n)) - # assume GcUnsafe unless in its type: - if notGcSafe(op): - message(n.info, warnGcUnsafe, renderTree(n)) + # assume GcUnsafe unless in its type; 'forward' does not matter: + if notGcSafe(op): + if warnGcUnsafe in gNotes: message(n.info, warnGcUnsafe, renderTree(n)) tracked.gcUnsafe = true else: mergeEffects(tracked, effectList.sons[exceptionEffects], n) mergeTags(tracked, effectList.sons[tagEffects], n) when trackGlobals: mergeUses(tracked, effectList.sons[usesEffects], n) if notGcSafe(op): - message(n.info, warnGcUnsafe, renderTree(n)) + if warnGcUnsafe in gNotes: message(n.info, warnGcUnsafe, renderTree(n)) tracked.gcUnsafe = true notNilCheck(tracked, n, paramType) @@ -510,9 +508,6 @@ proc track(tracked: PEffects, n: PNode) = if op != nil and op.kind == tyProc and op.n.sons[0].kind == nkEffectList: if a.kind == nkSym and a.sym == tracked.owner: tracked.isRecursive = true - elif notGcSafe(op) and not importedFromC(a): - message(n.info, warnGcUnsafe, renderTree(n)) - tracked.gcUnsafe = true var effectList = op.n.sons[0] if a.kind == nkSym and a.sym.kind == skMethod: propagateEffects(tracked, n, a.sym) @@ -528,6 +523,11 @@ proc track(tracked: PEffects, n: PNode) = mergeEffects(tracked, effectList.sons[exceptionEffects], n) mergeTags(tracked, effectList.sons[tagEffects], n) when trackGlobals: mergeUses(tracked, effectList.sons[usesEffects], n) + if notGcSafe(op) and not importedFromC(a): + # and it's not a recursive call: + if not (a.kind == nkSym and a.sym == tracked.owner): + message(n.info, warnGcUnsafe, renderTree(n)) + tracked.gcUnsafe = true 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}: # may not look like an assignment, but it is: @@ -636,10 +636,6 @@ proc checkMethodEffects*(disp, branch: PSym) = if not isNil(tagsSpec): checkRaisesSpec(tagsSpec, actual.sons[tagEffects], "can have an unlisted effect: ", hints=off, subtypeRelation) - let usesSpec = effectSpec(p, wUses) - if not isNil(usesSpec): - checkRaisesSpec(usesSpec, actual.sons[usesEffects], - "may use an unlisted global variable: ", hints=off, symbolPredicate) if sfThread in disp.flags and notGcSafe(branch.typ): localError(branch.info, "base method is GC-safe, but '$1' is not" % branch.name.s) @@ -651,16 +647,13 @@ proc setEffectsForProcType*(t: PType, n: PNode) = let raisesSpec = effectSpec(n, wRaises) tagsSpec = effectSpec(n, wTags) - usesSpec = effectSpec(n, wUses) - if not isNil(raisesSpec) or not isNil(tagsSpec) or not isNil(usesSpec): + if not isNil(raisesSpec) or not isNil(tagsSpec): internalAssert effects.len == 0 newSeq(effects.sons, effectListLen) if not isNil(raisesSpec): effects.sons[exceptionEffects] = raisesSpec if not isNil(tagsSpec): effects.sons[tagEffects] = tagsSpec - if not isNil(usesSpec): - effects.sons[usesEffects] = usesSpec proc initEffects(effects: PNode; s: PSym; t: var TEffects) = newSeq(effects.sons, effectListLen) @@ -705,16 +698,10 @@ proc trackProc*(s: PSym, body: PNode) = # after the check, use the formal spec: effects.sons[tagEffects] = tagsSpec - when trackGlobals: - let usesSpec = effectSpec(p, wUses) - if not isNil(usesSpec): - checkRaisesSpec(usesSpec, t.uses, - "uses an unlisted global variable: ", hints=on, symbolPredicate) - effects.sons[usesEffects] = usesSpec if optThreadAnalysis in gGlobalOptions: if sfThread in s.flags and t.gcUnsafe: - localError(s.info, warnGcUnsafe2, s.name.s) - #localError(s.info, "'$1' is not GC-safe" % s.name.s) + #localError(s.info, warnGcUnsafe2, s.name.s) + localError(s.info, "'$1' is not GC-safe" % s.name.s) if not t.gcUnsafe: s.typ.flags.incl tfGcSafe proc trackTopLevelStmt*(module: PSym; n: PNode) = diff --git a/compiler/semstmts.nim b/compiler/semstmts.nim index 4d06b201e..d394a2ae5 100644 --- a/compiler/semstmts.nim +++ b/compiler/semstmts.nim @@ -22,20 +22,23 @@ proc semDiscard(c: PContext, n: PNode): PNode = 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.info, s) + if n.sons[0].kind != nkEmpty: + if n.kind != nkContinueStmt: + var s: PSym + case n.sons[0].kind + of nkIdent: s = lookUp(c, n.sons[0]) + of nkSym: s = n.sons[0].sym + 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.info, s) + else: + localError(n.info, errInvalidControlFlowX, s.name.s) else: - localError(n.info, errInvalidControlFlowX, s.name.s) + localError(n.info, errGenerated, "'continue' cannot have a label") elif (c.p.nestedLoopCounter <= 0) and (c.p.nestedBlockCounter <= 0): localError(n.info, errInvalidControlFlowX, renderTree(n, {renderNoComments})) @@ -1009,6 +1012,31 @@ proc maybeAddResult(c: PContext, s: PSym, n: PNode) = addResult(c, s.typ.sons[0], n.info, s.kind) addResultNode(c, n) +proc semOverride(c: PContext, s: PSym, n: PNode) = + case s.name.s.normalize + of "destroy": doDestructorStuff(c, s, n) + of "deepcopy": + if s.typ.len == 2 and + s.typ.sons[1].skipTypes(abstractInst).kind in {tyRef, tyPtr} and + sameType(s.typ.sons[1], s.typ.sons[0]): + # Note: we store the deepCopy in the base of the pointer to mitigate + # the problem that pointers are structural types: + let t = s.typ.sons[1].skipTypes(abstractInst).lastSon.skipTypes(abstractInst) + if t.kind in {tyObject, tyDistinct, tyEnum}: + if t.deepCopy.isNil: t.deepCopy = s + else: + localError(n.info, errGenerated, + "cannot bind another 'deepCopy' to: " & typeToString(t)) + else: + localError(n.info, errGenerated, + "cannot bind 'deepCopy' to: " & typeToString(t)) + else: + localError(n.info, errGenerated, + "signature for 'deepCopy' must be proc[T: ptr|ref](x: T): T") + of "=": discard + else: localError(n.info, errGenerated, + "'destroy' or 'deepCopy' expected for 'override'") + type TProcCompilationSteps = enum stepRegisterSymbol, @@ -1125,7 +1153,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, popOwner() pushOwner(s) s.options = gOptions - if sfDestructor in s.flags: doDestructorStuff(c, s, n) + if sfOverriden in s.flags: semOverride(c, s, n) if n.sons[bodyPos].kind != nkEmpty: # for DLL generation it is annoying to check for sfImportc! if sfBorrow in s.flags: diff --git a/compiler/semtypinst.nim b/compiler/semtypinst.nim index 33de40f34..9f0a4100d 100644 --- a/compiler/semtypinst.nim +++ b/compiler/semtypinst.nim @@ -137,7 +137,7 @@ proc hasGenericArguments*(n: PNode): bool = return false proc reResolveCallsWithTypedescParams(cl: var TReplTypeVars, n: PNode): PNode = - # This is needed fo tgenericshardcases + # This is needed for tgenericshardcases # It's possible that a generic param will be used in a proc call to a # typedesc accepting proc. After generic param substitution, such procs # should be optionally instantiated with the correct type. In order to @@ -216,12 +216,16 @@ proc replaceTypeVarsS(cl: var TReplTypeVars, s: PSym): PSym = result.typ = replaceTypeVarsT(cl, s.typ) result.ast = replaceTypeVarsN(cl, s.ast) -proc lookupTypeVar(cl: TReplTypeVars, t: PType): PType = +proc lookupTypeVar(cl: var TReplTypeVars, t: PType): PType = result = PType(idTableGet(cl.typeMap, t)) if result == nil: if cl.allowMetaTypes or tfRetType in t.flags: return localError(t.sym.info, errCannotInstantiateX, typeToString(t)) result = errorType(cl.c) + # 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 nimrod check + idTablePut(cl.typeMap, t, result) elif result.kind == tyGenericParam and not cl.allowMetaTypes: internalError(cl.info, "substitution with generic parameter") @@ -353,7 +357,7 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = of tyGenericBody: localError(cl.info, errCannotInstantiateX, typeToString(t)) - result = t + result = errorType(cl.c) #result = replaceTypeVarsT(cl, lastSon(t)) of tyFromExpr: diff --git a/compiler/testability.nim b/compiler/testability.nim index ceefd0a5e..4587a5344 100644 --- a/compiler/testability.nim +++ b/compiler/testability.nim @@ -1,5 +1,5 @@ template tests*(body: stmt) {.immediate.} = when defined(selftest): - when not defined(unittest): import unittest + when not declared(unittest): import unittest body diff --git a/compiler/transf.nim b/compiler/transf.nim index dece1ac18..b9b06675e 100644 --- a/compiler/transf.nim +++ b/compiler/transf.nim @@ -1,7 +1,7 @@ # # # The Nimrod Compiler -# (c) Copyright 2013 Andreas Rumpf +# (c) Copyright 2014 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -13,7 +13,7 @@ # * inlines iterators # * inlines constants # * performes constant folding -# * converts "continue" to "break" +# * converts "continue" to "break"; disambiguates "break" # * introduces method dispatchers # * performs lambda lifting for closure support @@ -44,7 +44,6 @@ type 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 proc newTransNode(a: PNode): PTransNode {.inline.} = @@ -201,6 +200,18 @@ proc newLabel(c: PTransf, n: PNode): PSym = result = newSym(skLabel, nil, getCurrOwner(c), n.info) result.name = getIdent(genPrefix & $result.id) +proc freshLabels(c: PTransf, n: PNode; symMap: var TIdTable) = + if n.kind in {nkBlockStmt, nkBlockExpr}: + if n.sons[0].kind == nkSym: + let x = newLabel(c, n[0]) + idTablePut(symMap, n[0].sym, x) + n.sons[0].sym = x + if n.kind == nkSym and n.sym.kind == skLabel: + let x = PSym(idTableGet(symMap, n.sym)) + if x != nil: n.sym = x + else: + for i in 0 .. <safeLen(n): freshLabels(c, n.sons[i], symMap) + proc transformBlock(c: PTransf, n: PNode): PTransNode = var labl: PSym if n.sons[0].kind != nkEmpty: @@ -213,14 +224,6 @@ proc transformBlock(c: PTransf, n: PNode): PTransNode = 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 - proc transformLoopBody(c: PTransf, n: PNode): PTransNode = # What if it contains "continue" and "break"? "break" needs # an explicit label too, but not the same! @@ -239,6 +242,37 @@ proc transformLoopBody(c: PTransf, n: PNode): PTransNode = else: result = transform(c, n) +proc transformWhile(c: PTransf; n: PNode): PTransNode = + if c.inlining > 0: + result = transformSons(c, n) + else: + let labl = newLabel(c, n) + c.breakSyms.add(labl) + result = newTransNode(nkBlockStmt, n.info, 2) + result[0] = newSymNode(labl).PTransNode + + var body = newTransNode(n) + for i in 0..n.len-2: + body[i] = transform(c, n.sons[i]) + body[<n.len] = transformLoopBody(c, n.sons[<n.len]) + result[1] = body + discard c.breakSyms.pop + +proc transformBreak(c: PTransf, n: PNode): PTransNode = + if n.sons[0].kind != nkEmpty or c.inlining > 0: + result = n.PTransNode + when false: + let lablCopy = idNodeTableGet(c.transCon.mapping, n.sons[0].sym) + if lablCopy.isNil: + result = n.PTransNode + else: + result = newTransNode(n.kind, n.info, 1) + result[0] = lablCopy.PTransNode + else: + let labl = c.breakSyms[c.breakSyms.high] + result = transformSons(c, n) + result[0] = newSymNode(labl).PTransNode + 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): @@ -424,20 +458,32 @@ proc transformFor(c: PTransf, n: PNode): PTransNode = var length = sonsLen(n) var call = n.sons[length - 2] + + let labl = newLabel(c, n) + c.breakSyms.add(labl) + result = newTransNode(nkBlockStmt, n.info, 2) + result[0] = newSymNode(labl).PTransNode + if call.typ.kind != tyIter and (call.kind notin nkCallKinds or call.sons[0].kind != nkSym 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") + result[1] = lambdalifting.liftForLoop(n).PTransNode + discard c.breakSyms.pop + return result #echo "transforming: ", renderTree(n) - result = newTransNode(nkStmtList, n.info, 0) + var stmtList = newTransNode(nkStmtList, n.info, 0) + var loopBody = transformLoopBody(c, n.sons[length-1]) + + result[1] = stmtList + discard c.breakSyms.pop + 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) + add(stmtList, v.PTransNode) # Bugfix: inlined locals belong to the invoking routine, not to the invoked # iterator! @@ -453,27 +499,32 @@ proc transformFor(c: PTransf, n: PNode): PTransNode = var formal = skipTypes(iter.typ, abstractInst).n.sons[i].sym if arg.typ.kind == tyIter: continue case putArgInto(arg, formal.typ) - of paDirectMapping: + of paDirectMapping: idNodeTablePut(newC.mapping, formal, arg) - of paFastAsgn: + of paFastAsgn: # 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)) + add(stmtList, newAsgnStmt(c, newSymNode(temp), arg.PTransNode)) idNodeTablePut(newC.mapping, formal, newSymNode(temp)) of paVarAsgn: assert(skipTypes(formal.typ, abstractInst).kind == tyVar) idNodeTablePut(newC.mapping, formal, arg) # XXX BUG still not correct if the arg has a side effect! - var body = iter.getBody + var body = iter.getBody.copyTree pushInfoContext(n.info) + # XXX optimize this somehow. But the check "c.inlining" is not correct: + var symMap: TIdTable + initIdTable symMap + freshLabels(c, body, symMap) + inc(c.inlining) - add(result, transform(c, body)) - #findWrongOwners(c, result.pnode) + add(stmtList, transform(c, body)) + #findWrongOwners(c, stmtList.pnode) dec(c.inlining) popInfoContext() popTransCon(c) - # echo "transformed: ", result.PNode.renderTree + # echo "transformed: ", stmtList.PNode.renderTree proc getMagicOp(call: PNode): TMagic = if call.sons[0].kind == nkSym and @@ -643,25 +694,16 @@ proc transform(c: PTransf, n: PNode): PTransNode = if n.kind == nkMethodDef: methodDef(s, false) result = PTransNode(n) of nkForStmt: - inc c.inLoop 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 nkContinueStmt: result = PTransNode(newNodeI(nkBreakStmt, n.info)) var labl = c.contSyms[c.contSyms.high] add(result, PTransNode(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 nkWhileStmt: result = transformWhile(c, n) of nkCall, nkHiddenCallConv, nkCommand, nkInfix, nkPrefix, nkPostfix, nkCallStrLit: result = transformCall(c, n) @@ -740,6 +782,8 @@ proc transformBody*(module: PSym, n: PNode, prc: PSym): PNode = # result = lambdalifting.liftIterator(prc, result) incl(result.flags, nfTransf) when useEffectSystem: trackProc(prc, result) + if prc.name.s == "testbody": + echo renderTree(result) proc transformStmt*(module: PSym, n: PNode): PNode = if nfTransf in n.flags: diff --git a/compiler/types.nim b/compiler/types.nim index 786eea14e..c04413857 100644 --- a/compiler/types.nim +++ b/compiler/types.nim @@ -99,7 +99,7 @@ proc isPureObject(typ: PType): bool = proc getOrdValue(n: PNode): BiggestInt = case n.kind - of nkCharLit..nkInt64Lit: result = n.intVal + of nkCharLit..nkUInt64Lit: result = n.intVal of nkNilLit: result = 0 of nkHiddenStdConv: result = getOrdValue(n.sons[1]) else: @@ -582,7 +582,10 @@ proc firstOrd(t: PType): BiggestInt = of tyGenericInst, tyDistinct, tyConst, tyMutable, tyTypeDesc, tyFieldAccessor: result = firstOrd(lastSon(t)) - else: + of tyOrdinal: + if t.len > 0: result = firstOrd(lastSon(t)) + else: internalError("invalid kind for first(" & $t.kind & ')') + else: internalError("invalid kind for first(" & $t.kind & ')') result = 0 @@ -617,7 +620,10 @@ proc lastOrd(t: PType): BiggestInt = tyTypeDesc, tyFieldAccessor: result = lastOrd(lastSon(t)) of tyProxy: result = 0 - else: + of tyOrdinal: + if t.len > 0: result = lastOrd(lastSon(t)) + else: internalError("invalid kind for last(" & $t.kind & ')') + else: internalError("invalid kind for last(" & $t.kind & ')') result = 0 @@ -907,9 +913,11 @@ proc sameTypeAux(x, y: PType, c: var TSameTypeClosure): bool = result = sameTypeAux(a.sons[0], b.sons[0], c) else: result = sameTypeAux(a.sons[0], b.sons[0], c) and sameFlags(a, b) - of tyEnum, tyForward, tyProxy: + 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) @@ -1363,3 +1371,35 @@ proc containsCompileTimeOnly*(t: PType): bool = if t.sons[i] != nil and isCompileTimeOnly(t.sons[i]): return true return false + +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.sons[0].typ.classify == n.typ.classify: + result = n.sons[0] + of nkHiddenStdConv, nkHiddenSubConv, nkConv: + if n.sons[1].typ.classify == n.typ.classify: + result = n.sons[1] + else: discard + +proc skipConvTakeType*(n: PNode): PNode = + result = n.skipConv + result.typ = n.typ diff --git a/compiler/vm.nim b/compiler/vm.nim index aedbb92b4..e40acca6c 100644 --- a/compiler/vm.nim +++ b/compiler/vm.nim @@ -87,9 +87,7 @@ proc bailOut(c: PCtx; tos: PStackFrame) = when not defined(nimComputedGoto): {.pragma: computedGoto.} -proc myreset(n: var TFullReg) = - when defined(system.reset): - reset(n) +proc myreset(n: var TFullReg) = reset(n) template ensureKind(k: expr) {.immediate, dirty.} = if regs[ra].kind != k: @@ -1080,6 +1078,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcNKind: decodeB(rkInt) regs[ra].intVal = ord(regs[rb].node.kind) + c.comesFromHeuristic = regs[rb].node.info of opcNIntVal: decodeB(rkInt) let a = regs[rb].node @@ -1255,8 +1254,16 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = internalError(c.debug[pc], "request to create a NimNode of invalid kind") let cc = regs[rc].node + regs[ra].node = newNodeI(TNodeKind(int(k)), - if cc.kind == nkNilLit: c.debug[pc] else: cc.info) + if cc.kind != nkNilLit: + cc.info + elif c.comesFromHeuristic.line > -1: + c.comesFromHeuristic + elif c.callsite != nil and c.callsite.safeLen > 1: + c.callsite[1].info + else: + c.debug[pc]) regs[ra].node.flags.incl nfIsRef of opcNCopyNimNode: decodeB(rkNode) diff --git a/compiler/vmdef.nim b/compiler/vmdef.nim index 873d8eebd..cad48abea 100644 --- a/compiler/vmdef.nim +++ b/compiler/vmdef.nim @@ -188,6 +188,7 @@ type features*: TSandboxFlags traceActive*: bool loopIterations*: int + comesFromHeuristic*: TLineInfo # Heuristic for better macro stack traces TPosition* = distinct int @@ -196,7 +197,8 @@ type proc newCtx*(module: PSym): PCtx = PCtx(code: @[], debug: @[], globals: newNode(nkStmtListExpr), constants: newNode(nkStmtList), types: @[], - prc: PProc(blocks: @[]), module: module, loopIterations: MaxLoopIterations) + prc: PProc(blocks: @[]), module: module, loopIterations: MaxLoopIterations, + comesFromHeuristic: unknownLineInfo()) proc refresh*(c: PCtx, module: PSym) = c.module = module diff --git a/compiler/vmdeps.nim b/compiler/vmdeps.nim index 9a213d813..fdd8276cc 100644 --- a/compiler/vmdeps.nim +++ b/compiler/vmdeps.nim @@ -12,11 +12,11 @@ import ast, types, msgs, osproc, streams, options proc readOutput(p: PProcess): string = result = "" var output = p.outputStream - discard p.waitForExit while not output.atEnd: result.add(output.readLine) result.add("\n") result.setLen(result.len - "\n".len) + discard p.waitForExit proc opGorge*(cmd, input: string): string = var p = startCmd(cmd) diff --git a/compiler/vmgen.nim b/compiler/vmgen.nim index fd0c3fc69..a4ddc2e15 100644 --- a/compiler/vmgen.nim +++ b/compiler/vmgen.nim @@ -43,18 +43,19 @@ type proc debugInfo(info: TLineInfo): string = result = info.toFilename.splitFile.name & ":" & $info.line -proc codeListing(c: PCtx, result: var string, start=0) = +proc codeListing(c: PCtx, result: var string, start=0; last = -1) = # first iteration: compute all necessary labels: var jumpTargets = initIntSet() - for i in start.. < c.code.len: + 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) # for debugging purposes var i = start - while i < c.code.len: + while i <= last: if i in jumpTargets: result.addf("L$1:\n", i) let x = c.code[i] @@ -82,9 +83,9 @@ proc codeListing(c: PCtx, result: var string, start=0) = result.add("\n") inc i -proc echoCode*(c: PCtx, start=0) {.deprecated.} = +proc echoCode*(c: PCtx, start=0; last = -1) {.deprecated.} = var buf = "" - codeListing(c, buf, start) + codeListing(c, buf, start, last) echo buf proc gABC(ctx: PCtx; n: PNode; opc: TOpcode; a, b, c: TRegister = 0) = @@ -495,6 +496,7 @@ proc genCall(c: PCtx; n: PNode; dest: var TDest) = 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, @@ -637,8 +639,10 @@ proc genBinaryStmt(c: PCtx; n: PNode; opc: TOpcode) = c.freeTemp(tmp) proc genBinaryStmtVar(c: PCtx; n: PNode; opc: TOpcode) = + var x = n.sons[1] + if x.kind in {nkAddr, nkHiddenAddr}: x = x.sons[0] let - dest = c.genx(n.sons[1], {gfAddrOf}) + dest = c.genx(x) tmp = c.genx(n.sons[2]) c.gABC(n, opc, dest, tmp, 0) #c.genAsgnPatch(n.sons[1], dest) @@ -1053,6 +1057,8 @@ proc genAddrDeref(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode; # nkAddr we must not use 'unneededIndirection', but for deref we use it. if not isAddr and unneededIndirection(n.sons[0]): gen(c, n.sons[0], dest, newflags) + elif isAddr and isGlobal(n.sons[0]): + gen(c, n.sons[0], dest, flags+{gfAddrOf}) else: let tmp = c.genx(n.sons[0], newflags) if dest < 0: dest = c.getTemp(n.typ) @@ -1093,6 +1099,8 @@ proc setSlot(c: PCtx; v: PSym) = # XXX generate type initialization here? if v.position == 0: if c.prc.maxSlots == 0: c.prc.maxSlots = 1 + if c.prc.maxSlots >= high(TRegister): + internalError(v.info, "cannot generate code; too many registers required") v.position = c.prc.maxSlots c.prc.slots[v.position] = (inUse: true, kind: if v.kind == skLet: slotFixedLet else: slotFixedVar) @@ -1116,10 +1124,9 @@ 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 s.position == 0: - if s.kind in {skVar, skTemp, skLet, skParam, skResult} and - not s.isOwnedBy(c.prc.sym) and s.owner != c.module: - cannotEval(n) + if s.kind in {skVar, skTemp, skLet, skParam, skResult} and + not s.isOwnedBy(c.prc.sym) and s.owner != c.module: + cannotEval(n) proc isTemp(c: PCtx; dest: TDest): bool = result = dest >= 0 and c.prc.slots[dest].kind >= slotTempUnknown @@ -1246,6 +1253,8 @@ proc genRdVar(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = c.gABx(n, opcLdGlobal, cc, s.position) c.gABC(n, opcNodeToReg, dest, cc) c.freeTemp(cc) + elif gfAddrOf in flags: + c.gABx(n, opcLdGlobalAddr, dest, s.position) else: c.gABx(n, opcLdGlobal, dest, s.position) else: diff --git a/compiler/wordrecg.nim b/compiler/wordrecg.nim index fbe005031..d81031917 100644 --- a/compiler/wordrecg.nim +++ b/compiler/wordrecg.nim @@ -27,7 +27,7 @@ type 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, + wInclude, wInterface, wIs, wIsnot, wIterator, wLet, wMacro, wMethod, wMixin, wMod, wNil, wNot, wNotin, wObject, wOf, wOr, wOut, wProc, wPtr, wRaise, wRef, wReturn, wShl, wShr, wStatic, wTemplate, wTry, wTuple, wType, wUsing, wVar, @@ -39,7 +39,7 @@ type wDestroy, - wImmediate, wDestructor, wDelegator, + wImmediate, wDestructor, wDelegator, wOverride, wImportCpp, wImportObjC, wImportCompilerProc, wImportc, wExportc, wIncompleteStruct, wRequiresInit, @@ -64,7 +64,7 @@ type wAcyclic, wShallow, wUnroll, wLinearScanEnd, wComputedGoto, wInjectStmt, wWrite, wGensym, wInject, wDirty, wInheritable, wThreadVar, wEmit, wAsmNoStackFrame, - wImplicitStatic, wGlobal, wCodegenDecl, wUnchecked, wGuard, wUses, + wImplicitStatic, wGlobal, wCodegenDecl, wUnchecked, wGuard, wLocks, wAuto, wBool, wCatch, wChar, wClass, wConst_cast, wDefault, wDelete, wDouble, wDynamic_cast, @@ -107,7 +107,7 @@ const "elif", "else", "end", "enum", "except", "export", "finally", "for", "from", "generic", "if", "import", "in", "include", "interface", "is", "isnot", "iterator", - "lambda", "let", + "let", "macro", "method", "mixin", "mod", "nil", "not", "notin", "object", "of", "or", "out", "proc", "ptr", "raise", "ref", "return", @@ -122,7 +122,7 @@ const "destroy", - "immediate", "destructor", "delegator", + "immediate", "destructor", "delegator", "override", "importcpp", "importobjc", "importcompilerproc", "importc", "exportc", "incompletestruct", "requiresinit", "align", "nodecl", "pure", "sideeffect", @@ -147,7 +147,7 @@ const "computedgoto", "injectstmt", "write", "gensym", "inject", "dirty", "inheritable", "threadvar", "emit", "asmnostackframe", "implicitstatic", "global", "codegendecl", "unchecked", - "guard", "uses", + "guard", "locks", "auto", "bool", "catch", "char", "class", "const_cast", "default", "delete", "double", |