diff options
Diffstat (limited to 'compiler')
74 files changed, 3971 insertions, 2267 deletions
diff --git a/compiler/ast.nim b/compiler/ast.nim index 25958f580..acd72479d 100644 --- a/compiler/ast.nim +++ b/compiler/ast.nim @@ -298,6 +298,7 @@ const sfWrittenTo* = sfBorrow # param is assigned to sfEscapes* = sfProcvar # param escapes sfBase* = sfDiscriminant + sfIsSelf* = sfOverriden # param is 'self' const # getting ready for the future expr/stmt merge @@ -458,11 +459,11 @@ type tfByCopy, # pass object/tuple by copy (C backend) tfByRef, # pass object/tuple by reference (C backend) tfIterator, # type is really an iterator, not a tyProc - tfShared, # type is 'shared' + tfPartial, # type is declared as 'partial' tfNotNil, # type cannot be 'nil' tfNeedsInit, # type constains a "not nil" constraint somewhere or some - # other type so that it requires initalization + # other type so that it requires initialization tfVarIsPtr, # 'var' type is translated like 'ptr' even in C++ mode tfHasMeta, # type contains "wildcard" sub-types such as generic params # or other type classes @@ -500,8 +501,7 @@ type skResult, # special 'result' variable skProc, # a proc skMethod, # a method - skIterator, # an inline iterator - skClosureIterator, # a resumable closure iterator + skIterator, # an iterator skConverter, # a type converter skMacro, # a macro skTemplate, # a template; currently also misused for user-defined @@ -518,7 +518,7 @@ type TSymKinds* = set[TSymKind] const - routineKinds* = {skProc, skMethod, skIterator, skClosureIterator, + routineKinds* = {skProc, skMethod, skIterator, skConverter, skMacro, skTemplate} tfIncompleteStruct* = tfVarargs tfUncheckedArray* = tfVarargs @@ -534,7 +534,7 @@ const skError* = skUnknown # type flags that are essential for type equality: - eqTypeFlags* = {tfIterator, tfShared, tfNotNil, tfVarIsPtr} + eqTypeFlags* = {tfIterator, tfNotNil, tfVarIsPtr} type TMagic* = enum # symbols that require compiler magic: @@ -754,7 +754,6 @@ type TScope* = object depthLevel*: int symbols*: TStrTable - usingSyms*: seq[PNode] parent*: PScope PScope* = ref TScope @@ -819,6 +818,8 @@ type constraint*: PNode # additional constraints like 'lit|result'; also # misused for the codegenDecl pragma in the hope # it won't cause problems + when defined(nimsuggest): + allUsages*: seq[TLineInfo] TTypeSeq* = seq[PType] TLockLevel* = distinct int16 @@ -903,7 +904,7 @@ type # the poor naming choices in the standard library. const - OverloadableSyms* = {skProc, skMethod, skIterator, skClosureIterator, + OverloadableSyms* = {skProc, skMethod, skIterator, skConverter, skModule, skTemplate, skMacro} GenericTypes*: TTypeKinds = {tyGenericInvocation, tyGenericBody, @@ -927,11 +928,11 @@ const NilableTypes*: TTypeKinds = {tyPointer, tyCString, tyRef, tyPtr, tySequence, tyProc, tyString, tyError} ExportableSymKinds* = {skVar, skConst, skProc, skMethod, skType, - skIterator, skClosureIterator, + skIterator, skMacro, skTemplate, skConverter, skEnumField, skLet, skStub, skAlias} PersistentNodeFlags*: TNodeFlags = {nfBase2, nfBase8, nfBase16, nfDotSetter, nfDotField, - nfIsRef, nfIsCursor} + nfIsRef, nfIsCursor, nfLL} namePos* = 0 patternPos* = 1 # empty except for term rewriting macros genericParamsPos* = 2 @@ -956,12 +957,13 @@ const nkStrKinds* = {nkStrLit..nkTripleStrLit} skLocalVars* = {skVar, skLet, skForVar, skParam, skResult} - skProcKinds* = {skProc, skTemplate, skMacro, skIterator, skClosureIterator, + skProcKinds* = {skProc, skTemplate, skMacro, skIterator, skMethod, skConverter} - skIterators* = {skIterator, skClosureIterator} - var ggDebug* {.deprecated.}: bool ## convenience switch for trying out things +var + gMainPackageId*: int + gMainPackageNotes*: TNoteKinds proc isCallExpr*(n: PNode): bool = result = n.kind in nkCallKinds @@ -1011,6 +1013,10 @@ proc newNode*(kind: TNodeKind): PNode = writeStackTrace() inc gNodeId +proc newTree*(kind: TNodeKind; children: varargs[PNode]): PNode = + result = newNode(kind) + result.sons = @children + proc newIntNode*(kind: TNodeKind, intVal: BiggestInt): PNode = result = newNode(kind) result.intVal = intVal @@ -1552,12 +1558,13 @@ proc isGenericRoutine*(s: PSym): bool = else: discard proc skipGenericOwner*(s: PSym): PSym = - internalAssert s.kind in skProcKinds ## Generic instantiations are owned by their originating generic ## symbol. This proc skips such owners and goes straight to the owner ## of the generic itself (the module or the enclosing proc). - result = if sfFromGeneric in s.flags: s.owner.owner - else: s.owner + result = if s.kind in skProcKinds and sfFromGeneric in s.flags: + s.owner.owner + else: + s.owner proc originatingModule*(s: PSym): PSym = result = s.owner diff --git a/compiler/astalgo.nim b/compiler/astalgo.nim index 3ba43b4c5..3ca44ea7e 100644 --- a/compiler/astalgo.nim +++ b/compiler/astalgo.nim @@ -137,7 +137,7 @@ proc sameValue*(a, b: PNode): bool = of nkStrLit..nkTripleStrLit: if b.kind in {nkStrLit..nkTripleStrLit}: result = a.strVal == b.strVal else: - # don't raise an internal error for 'nimrod check': + # don't raise an internal error for 'nim check': #InternalError(a.info, "SameValue") discard @@ -152,7 +152,7 @@ proc leValue*(a, b: PNode): bool = of nkStrLit..nkTripleStrLit: if b.kind in {nkStrLit..nkTripleStrLit}: result = a.strVal <= b.strVal else: - # don't raise an internal error for 'nimrod check': + # don't raise an internal error for 'nim check': #InternalError(a.info, "leValue") discard @@ -448,20 +448,20 @@ proc debugTree(n: PNode, indent: int, maxRecDepth: int; proc debug(n: PSym) = if n == nil: - msgWriteln("null") + echo("null") elif n.kind == skUnknown: - msgWriteln("skUnknown") + echo("skUnknown") else: #writeLine(stdout, $symToYaml(n, 0, 1)) - msgWriteln("$1_$2: $3, $4, $5, $6" % [ + echo("$1_$2: $3, $4, $5, $6" % [ n.name.s, $n.id, $flagsToStr(n.flags), $flagsToStr(n.loc.flags), $lineInfoToStr(n.info), $n.kind]) proc debug(n: PType) = - msgWriteln($debugType(n)) + echo($debugType(n)) proc debug(n: PNode) = - msgWriteln($debugTree(n, 0, 100)) + echo($debugTree(n, 0, 100)) const EmptySeq = @[] @@ -635,7 +635,7 @@ proc reallySameIdent(a, b: string): bool {.inline.} = else: result = true -proc strTableIncl*(t: var TStrTable, n: PSym): bool {.discardable.} = +proc strTableIncl*(t: var TStrTable, n: PSym; onConflictKeepOld=false): bool {.discardable.} = # returns true if n is already in the string table: # It is essential that `n` is written nevertheless! # This way the newest redefinition is picked by the semantic analyses! @@ -654,7 +654,8 @@ proc strTableIncl*(t: var TStrTable, n: PSym): bool {.discardable.} = replaceSlot = h h = nextTry(h, high(t.data)) if replaceSlot >= 0: - t.data[replaceSlot] = n # overwrite it with newer definition! + if not onConflictKeepOld: + t.data[replaceSlot] = n # overwrite it with newer definition! return true # found it elif mustRehash(len(t.data), t.counter): strTableEnlarge(t) diff --git a/compiler/canonicalizer.nim b/compiler/canonicalizer.nim index dc6445035..089bce302 100644 --- a/compiler/canonicalizer.nim +++ b/compiler/canonicalizer.nim @@ -11,7 +11,7 @@ import strutils, db_sqlite, md5 -var db: TDbConn +var db: DbConn # We *hash* the relevant information into 128 bit hashes. This should be good # enough to prevent any collisions. @@ -33,7 +33,7 @@ type const cb64 = [ "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", - "O", "P", "Q", "R", "S", "T" "U", "V", "W", "X", "Y", "Z", + "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", @@ -158,7 +158,6 @@ proc hashType(c: var MD5Context, t: PType) = if tfThread in t.flags: c &= ".thread" else: for i in 0.. <t.len: c.hashType(t.sons[i]) - if tfShared in t.flags: c &= "shared" if tfNotNil in t.flags: c &= "not nil" proc canonConst(n: PNode): TUid = @@ -276,7 +275,7 @@ proc encodeType(w: PRodWriter, t: PType, result: var string) = return # we need no surrounding [] here because the type is in a line of its own if t.kind == tyForward: internalError("encodeType: tyForward") - # for the new rodfile viewer we use a preceeding [ so that the data section + # for the new rodfile viewer we use a preceding [ so that the data section # can easily be disambiguated: add(result, '[') encodeVInt(ord(t.kind), result) diff --git a/compiler/ccgcalls.nim b/compiler/ccgcalls.nim index 86ecc9db8..bd17f85e4 100644 --- a/compiler/ccgcalls.nim +++ b/compiler/ccgcalls.nim @@ -118,6 +118,14 @@ proc openArrayLoc(p: BProc, n: PNode): Rope = result = "$1->data, $1->$2" % [a.rdLoc, lenField(p)] of tyArray, tyArrayConstr: result = "$1, $2" % [rdLoc(a), rope(lengthOrd(a.t))] + of tyPtr, tyRef: + case lastSon(a.t).kind + of tyString, tySequence: + result = "(*$1)->data, (*$1)->$2" % [a.rdLoc, lenField(p)] + of tyArray, tyArrayConstr: + result = "$1, $2" % [rdLoc(a), rope(lengthOrd(lastSon(a.t)))] + else: + internalError("openArrayLoc: " & typeToString(a.t)) else: internalError("openArrayLoc: " & typeToString(a.t)) proc genArgStringToCString(p: BProc, n: PNode): Rope {.inline.} = @@ -515,7 +523,7 @@ proc genNamedParamCall(p: BProc, ri: PNode, d: var TLoc) = line(p, cpsStmts, pl) proc genCall(p: BProc, e: PNode, d: var TLoc) = - if e.sons[0].typ.callConv == ccClosure: + if e.sons[0].typ.skipTypes({tyGenericInst}).callConv == ccClosure: genClosureCall(p, nil, e, d) elif e.sons[0].kind == nkSym and sfInfixCall in e.sons[0].sym.flags: genInfixCall(p, nil, e, d) @@ -528,7 +536,7 @@ proc genCall(p: BProc, e: PNode, d: var TLoc) = if d.s == onStack and containsGarbageCollectedRef(d.t): keepAlive(p, d) proc genAsgnCall(p: BProc, le, ri: PNode, d: var TLoc) = - if ri.sons[0].typ.callConv == ccClosure: + if ri.sons[0].typ.skipTypes({tyGenericInst}).callConv == ccClosure: genClosureCall(p, le, ri, d) elif ri.sons[0].kind == nkSym and sfInfixCall in ri.sons[0].sym.flags: genInfixCall(p, le, ri, d) diff --git a/compiler/ccgexprs.nim b/compiler/ccgexprs.nim index 388b6d047..9f4beda9e 100644 --- a/compiler/ccgexprs.nim +++ b/compiler/ccgexprs.nim @@ -672,9 +672,13 @@ proc genDeref(p: BProc, e: PNode, d: var TLoc; enforceDeref=false) = expr(p, e.sons[0], d) else: var a: TLoc - initLocExprSingleUse(p, e.sons[0], a) + let typ = skipTypes(e.sons[0].typ, abstractInst) + if typ.kind == tyVar and tfVarIsPtr notin typ.flags and p.module.compileToCpp and e.sons[0].kind == nkHiddenAddr: + initLocExprSingleUse(p, e[0][0], d) + return + else: + initLocExprSingleUse(p, e.sons[0], a) if d.k == locNone: - let typ = skipTypes(a.t, abstractInst) # dest = *a; <-- We do not know that 'dest' is on the heap! # It is completely wrong to set 'd.s' here, unless it's not yet # been assigned to. @@ -689,9 +693,9 @@ proc genDeref(p: BProc, e: PNode, d: var TLoc; enforceDeref=false) = return of tyPtr: d.s = OnUnknown # BUGFIX! - else: internalError(e.info, "genDeref " & $a.t.kind) + else: + internalError(e.info, "genDeref " & $typ.kind) elif p.module.compileToCpp: - let typ = skipTypes(a.t, abstractInst) if typ.kind == tyVar and tfVarIsPtr notin typ.flags and e.kind == nkHiddenDeref: putIntoDest(p, d, e.typ, rdLoc(a), a.s) @@ -959,6 +963,7 @@ proc genEcho(p: BProc, n: PNode) = addf(args, ", $1? ($1)->data:\"nil\"", [rdLoc(a)]) linefmt(p, cpsStmts, "printf($1$2);$n", makeCString(repeat("%s", n.len) & tnl), args) + linefmt(p, cpsStmts, "fflush(stdout);$n") proc gcUsage(n: PNode) = if gSelectedGC == gcNone: message(n.info, warnGcMem, n.renderTree) @@ -1055,12 +1060,15 @@ proc genSeqElemAppend(p: BProc, e: PNode, d: var TLoc) = var a, b, dest: TLoc initLocExpr(p, e.sons[1], a) initLocExpr(p, e.sons[2], b) + let bt = skipTypes(e.sons[2].typ, abstractVar) lineCg(p, cpsStmts, seqAppendPattern, [ rdLoc(a), getTypeDesc(p.module, skipTypes(e.sons[1].typ, abstractVar)), - getTypeDesc(p.module, skipTypes(e.sons[2].typ, abstractVar))]) + getTypeDesc(p.module, bt)]) keepAlive(p, a) - initLoc(dest, locExpr, b.t, OnHeap) + #if bt != b.t: + # echo "YES ", e.info, " new: ", typeToString(bt), " old: ", typeToString(b.t) + initLoc(dest, locExpr, bt, OnHeap) dest.r = rfmt(nil, "$1->data[$1->$2]", rdLoc(a), lenField(p)) genAssignment(p, dest, b, {needToCopy, afDestIsNil}) lineCg(p, cpsStmts, "++$1->$2;$n", rdLoc(a), lenField(p)) @@ -1227,7 +1235,7 @@ proc genOfHelper(p: BProc; dest: PType; a: Rope): Rope = # unfortunately 'genTypeInfo' sets tfObjHasKids as a side effect, so we # have to call it here first: let ti = genTypeInfo(p.module, dest) - if tfFinal in dest.flags or (p.module.objHasKidsValid and + if tfFinal in dest.flags or (objHasKidsValid in p.module.flags and tfObjHasKids notin dest.flags): result = "$1.m_type == $2" % [a, ti] else: @@ -1285,7 +1293,7 @@ proc genRepr(p: BProc, e: PNode, d: var TLoc) = putIntoDest(p, d, e.typ, ropecg(p.module, "#reprChar($1)", [rdLoc(a)]), a.s) of tyEnum, tyOrdinal: putIntoDest(p, d, e.typ, - ropecg(p.module, "#reprEnum($1, $2)", [ + ropecg(p.module, "#reprEnum((NI)$1, $2)", [ rdLoc(a), genTypeInfo(p.module, t)]), a.s) of tyString: putIntoDest(p, d, e.typ, ropecg(p.module, "#reprStr($1)", [rdLoc(a)]), a.s) @@ -1415,11 +1423,11 @@ proc binaryExprIn(p: BProc, e: PNode, a, b, d: var TLoc, frmt: string) = proc genInExprAux(p: BProc, e: PNode, a, b, d: var TLoc) = case int(getSize(skipTypes(e.sons[1].typ, abstractVar))) - of 1: binaryExprIn(p, e, a, b, d, "(($1 &(1<<(($2)&7)))!=0)") - of 2: binaryExprIn(p, e, a, b, d, "(($1 &(1<<(($2)&15)))!=0)") - of 4: binaryExprIn(p, e, a, b, d, "(($1 &(1<<(($2)&31)))!=0)") - of 8: binaryExprIn(p, e, a, b, d, "(($1 &(IL64(1)<<(($2)&IL64(63))))!=0)") - else: binaryExprIn(p, e, a, b, d, "(($1[$2/8] &(1<<($2%8)))!=0)") + of 1: binaryExprIn(p, e, a, b, d, "(($1 &(1U<<((NU)($2)&7U)))!=0)") + of 2: binaryExprIn(p, e, a, b, d, "(($1 &(1U<<((NU)($2)&15U)))!=0)") + of 4: binaryExprIn(p, e, a, b, d, "(($1 &(1U<<((NU)($2)&31U)))!=0)") + of 8: binaryExprIn(p, e, a, b, d, "(($1 &((NU64)1<<((NU)($2)&63U)))!=0)") + else: binaryExprIn(p, e, a, b, d, "(($1[(NU)($2)>>3] &(1U<<((NU)($2)&7U)))!=0)") proc binaryStmtInExcl(p: BProc, e: PNode, d: var TLoc, frmt: string) = var a, b: TLoc @@ -1500,8 +1508,8 @@ proc genSetOp(p: BProc, e: PNode, d: var TLoc, op: TMagic) = else: internalError(e.info, "genSetOp()") else: case op - of mIncl: binaryStmtInExcl(p, e, d, "$1[$2/8] |=(1<<($2%8));$n") - of mExcl: binaryStmtInExcl(p, e, d, "$1[$2/8] &= ~(1<<($2%8));$n") + of mIncl: binaryStmtInExcl(p, e, d, "$1[(NU)($2)>>3] |=(1U<<($2&7U));$n") + of mExcl: binaryStmtInExcl(p, e, d, "$1[(NU)($2)>>3] &= ~(1U<<($2&7U));$n") of mCard: unaryExprChar(p, e, d, "#cardSet($1, " & $size & ')') of mLtSet, mLeSet: getTemp(p, getSysType(tyInt), i) # our counter @@ -1713,7 +1721,7 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = genArrayLen(p, e, d, op) of mXLenStr, mXLenSeq: if not p.module.compileToCpp: - unaryExpr(p, e, d, "($1->Sup.len-1)") + unaryExpr(p, e, d, "($1->Sup.len)") else: unaryExpr(p, e, d, "$1->len") of mGCref: unaryStmt(p, e, d, "#nimGCref($1);$n") @@ -1733,8 +1741,6 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = of mEcho: genEcho(p, e[1].skipConv) of mArrToSeq: genArrToSeq(p, e, d) of mNLen..mNError, mSlurp..mQuoteAst: - echo "from here ", p.prc.name.s, " ", p.prc.info - writestacktrace() localError(e.info, errXMustBeCompileTime, e.sons[0].sym.name.s) of mSpawn: let n = lowerings.wrapProcForSpawn(p.module.module, e, e.typ, nil, nil) @@ -1788,11 +1794,11 @@ proc genSetConstr(p: BProc, e: PNode, d: var TLoc) = initLocExpr(p, e.sons[i].sons[0], a) initLocExpr(p, e.sons[i].sons[1], b) lineF(p, cpsStmts, "for ($1 = $3; $1 <= $4; $1++) $n" & - "$2[$1/8] |=(1<<($1%8));$n", [rdLoc(idx), rdLoc(d), + "$2[(NU)($1)>>3] |=(1U<<((NU)($1)&7U));$n", [rdLoc(idx), rdLoc(d), rdSetElemLoc(a, e.typ), rdSetElemLoc(b, e.typ)]) else: initLocExpr(p, e.sons[i], a) - lineF(p, cpsStmts, "$1[$2/8] |=(1<<($2%8));$n", + lineF(p, cpsStmts, "$1[(NU)($2)>>3] |=(1U<<((NU)($2)&7U));$n", [rdLoc(d), rdSetElemLoc(a, e.typ)]) else: # small set @@ -1839,19 +1845,27 @@ proc genClosure(p: BProc, n: PNode, d: var TLoc) = assert n.kind == nkClosure if isConstClosure(n): - inc(p.labels) - var tmp = "LOC" & rope(p.labels) - addf(p.module.s[cfsData], "NIM_CONST $1 $2 = $3;$n", + inc(p.module.labels) + var tmp = "CNSTCLOSURE" & rope(p.module.labels) + addf(p.module.s[cfsData], "static NIM_CONST $1 $2 = $3;$n", [getTypeDesc(p.module, n.typ), tmp, genConstExpr(p, n)]) putIntoDest(p, d, n.typ, tmp, OnStatic) else: var tmp, a, b: TLoc initLocExpr(p, n.sons[0], a) initLocExpr(p, n.sons[1], b) - getTemp(p, n.typ, tmp) - linefmt(p, cpsStmts, "$1.ClPrc = $2; $1.ClEnv = $3;$n", - tmp.rdLoc, a.rdLoc, b.rdLoc) - putLocIntoDest(p, d, tmp) + if n.sons[0].skipConv.kind == nkClosure: + internalError(n.info, "closure to closure created") + # tasyncawait.nim breaks with this optimization: + when false: + if d.k != locNone: + linefmt(p, cpsStmts, "$1.ClPrc = $2; $1.ClEnv = $3;$n", + d.rdLoc, a.rdLoc, b.rdLoc) + else: + getTemp(p, n.typ, tmp) + linefmt(p, cpsStmts, "$1.ClPrc = $2; $1.ClEnv = $3;$n", + tmp.rdLoc, a.rdLoc, b.rdLoc) + putLocIntoDest(p, d, tmp) proc genArrayConstr(p: BProc, n: PNode, d: var TLoc) = var arr: TLoc @@ -1966,7 +1980,9 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = else: genProc(p.module, sym) putLocIntoDest(p, d, sym.loc) - of skProc, skConverter, skIterators: + of skProc, skConverter, skIterator: + #if sym.kind == skIterator: + # echo renderTree(sym.getBody, {renderIds}) if sfCompileTime in sym.flags: localError(n.info, "request to generate code for .compileTime proc: " & sym.name.s) @@ -1988,6 +2004,7 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = if sfGlobal in sym.flags: genVarPrototype(p.module, sym) if sym.loc.r == nil or sym.loc.t == nil: #echo "FAILED FOR PRCO ", p.prc.name.s + #echo renderTree(p.prc.ast, {renderIds}) internalError n.info, "expr: var not init " & sym.name.s & "_" & $sym.id if sfThread in sym.flags: accessThreadLocalVar(p, sym) @@ -2005,9 +2022,9 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = putLocIntoDest(p, d, sym.loc) of skParam: if sym.loc.r == nil or sym.loc.t == nil: - #echo "FAILED FOR PRCO ", p.prc.name.s - #debug p.prc.typ.n - #echo renderTree(p.prc.ast, {renderIds}) + # echo "FAILED FOR PRCO ", p.prc.name.s + # debug p.prc.typ.n + # echo renderTree(p.prc.ast, {renderIds}) 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") @@ -2104,8 +2121,10 @@ proc expr(p: BProc, n: PNode, d: var TLoc) = initLocExpr(p, n.sons[0], a) of nkAsmStmt: genAsmStmt(p, n) of nkTryStmt: - if p.module.compileToCpp: genTryCpp(p, n, d) - else: genTry(p, n, d) + if p.module.compileToCpp and optNoCppExceptions notin gGlobalOptions: + genTryCpp(p, n, d) + else: + genTry(p, n, d) of nkRaiseStmt: genRaiseStmt(p, n) of nkTypeSection: # we have to emit the type information for object types here to support diff --git a/compiler/ccgmerge.nim b/compiler/ccgmerge.nim index 2a37257b6..2e77cd2a6 100644 --- a/compiler/ccgmerge.nim +++ b/compiler/ccgmerge.nim @@ -107,8 +107,8 @@ proc genMergeInfo*(m: BModule): Rope = writeIntSet(m.typeInfoMarker, s) s.add("labels:") encodeVInt(m.labels, s) - s.add(" hasframe:") - encodeVInt(ord(m.frameDeclared), s) + s.add(" flags:") + encodeVInt(cast[int](m.flags), s) s.add(tnl) s.add("*/") result = s.rope @@ -222,7 +222,8 @@ proc processMergeInfo(L: var TBaseLexer, m: BModule) = of "declared": readIntSet(L, m.declaredThings) of "typeInfo": readIntSet(L, m.typeInfoMarker) of "labels": m.labels = decodeVInt(L.buf, L.bufpos) - of "hasframe": m.frameDeclared = decodeVInt(L.buf, L.bufpos) != 0 + of "flags": + m.flags = cast[set[CodegenFlag]](decodeVInt(L.buf, L.bufpos) != 0) else: internalError("ccgmerge: unknown key: " & k) when not defined(nimhygiene): diff --git a/compiler/ccgstmts.nim b/compiler/ccgstmts.nim index f4a7c4400..61412ad67 100644 --- a/compiler/ccgstmts.nim +++ b/compiler/ccgstmts.nim @@ -16,13 +16,13 @@ const # above X strings a hash-switch for strings is generated proc registerGcRoot(p: BProc, v: PSym) = - if gSelectedGC in {gcMarkAndSweep, gcGenerational} and + if gSelectedGC in {gcMarkAndSweep, gcGenerational, gcV2, gcRefc} and containsGarbageCollectedRef(v.loc.t): # we register a specialized marked proc here; this has the advantage # that it works out of the box for thread local storage then :-) let prc = genTraverseProcForGlobal(p.module, v) - linefmt(p.module.initProc, cpsStmts, - "#nimRegisterGlobalMarker($1);$n", prc) + appcg(p.module, p.module.initProc.procSec(cpsStmts), + "#nimRegisterGlobalMarker($1);$n", [prc]) proc isAssignedImmediately(n: PNode): bool {.inline.} = if n.kind == nkEmpty: return false @@ -928,8 +928,10 @@ proc genTry(p: BProc, t: PNode, d: var TLoc) = for j in countup(0, blen - 2): assert(t.sons[i].sons[j].kind == nkType) if orExpr != nil: add(orExpr, "||") - appcg(p.module, orExpr, - "#isObj(#getCurrentException()->Sup.m_type, $1)", + let isObjFormat = if not p.module.compileToCpp: + "#isObj(#getCurrentException()->Sup.m_type, $1)" + else: "#isObj(#getCurrentException()->m_type, $1)" + appcg(p.module, orExpr, isObjFormat, [genTypeInfo(p.module, t.sons[i].sons[j].typ)]) if i > 1: line(p, cpsStmts, "else ") startBlock(p, "if ($1) {$n", [orExpr]) @@ -955,10 +957,12 @@ proc genAsmOrEmitStmt(p: BProc, t: PNode, isAsmStmt=false): Rope = res.add(t.sons[i].strVal) of nkSym: var sym = t.sons[i].sym - if sym.kind in {skProc, skIterator, skClosureIterator, skMethod}: + if sym.kind in {skProc, skIterator, skMethod}: var a: TLoc initLocExpr(p, t.sons[i], a) res.add($rdLoc(a)) + elif sym.kind == skType: + res.add($getTypeDesc(p.module, sym.typ)) else: var r = sym.loc.r if r == nil: diff --git a/compiler/ccgthreadvars.nim b/compiler/ccgthreadvars.nim index d741c47a9..81af89249 100644 --- a/compiler/ccgthreadvars.nim +++ b/compiler/ccgthreadvars.nim @@ -18,13 +18,13 @@ proc emulatedThreadVars(): bool = proc accessThreadLocalVar(p: BProc, s: PSym) = if emulatedThreadVars() and not p.threadVarAccessed: p.threadVarAccessed = true - p.module.usesThreadVars = true + incl p.module.flags, usesThreadVars addf(p.procSec(cpsLocals), "\tNimThreadVars* NimTV;$n", []) add(p.procSec(cpsInit), ropecg(p.module, "\tNimTV = (NimThreadVars*) #GetThreadLocalVars();$n")) var - nimtv: Rope # nimrod thread vars; the struct body + nimtv: Rope # Nim thread vars; the struct body nimtvDeps: seq[PType] = @[] # type deps: every module needs whole struct nimtvDeclared = initIntSet() # so that every var/field exists only once # in the struct @@ -51,7 +51,7 @@ proc declareThreadVar(m: BModule, s: PSym, isExtern: bool) = addf(m.s[cfsVars], " $1;$n", [s.loc.r]) proc generateThreadLocalStorage(m: BModule) = - if nimtv != nil and (m.usesThreadVars or sfMainModule in m.module.flags): + if nimtv != nil and (usesThreadVars in m.flags or sfMainModule in m.module.flags): for t in items(nimtvDeps): discard getTypeDesc(m, t) addf(m.s[cfsSeqTypes], "typedef struct {$1} NimThreadVars;$n", [nimtv]) diff --git a/compiler/ccgtrav.nim b/compiler/ccgtrav.nim index 5f59702e5..0da6396ea 100644 --- a/compiler/ccgtrav.nim +++ b/compiler/ccgtrav.nim @@ -57,6 +57,8 @@ proc parentObj(accessor: Rope; m: BModule): Rope {.inline.} = proc genTraverseProc(c: var TTraversalClosure, accessor: Rope, typ: PType) = if typ == nil: return + + let typ = getUniqueType(typ) var p = c.p case typ.kind of tyGenericInst, tyGenericBody, tyTypeDesc: diff --git a/compiler/ccgtypes.nim b/compiler/ccgtypes.nim index 1ed9ce113..6553deb66 100644 --- a/compiler/ccgtypes.nim +++ b/compiler/ccgtypes.nim @@ -1,7 +1,7 @@ # # # The Nim Compiler -# (c) Copyright 2013 Andreas Rumpf +# (c) Copyright 2016 Andreas Rumpf # # See the file "copying.txt", included in this # distribution, for details about the copyright. @@ -11,6 +11,8 @@ # ------------------------- Name Mangling -------------------------------- +import debuginfo + proc isKeyword(w: PIdent): bool = # Nim and C++ share some keywords # it's more efficient to test the whole Nim keywords range @@ -26,67 +28,66 @@ proc mangleField(name: PIdent): string = result[0] = result[0].toUpper # Mangling makes everything lowercase, # but some identifiers are C keywords +proc hashOwner(s: PSym): FilenameHash = + var m = s + while m.kind != skModule: m = m.owner + let p = m.owner + assert p.kind == skPackage + result = gDebugInfo.register(p.name.s, m.name.s) + proc mangleName(s: PSym): Rope = result = s.loc.r if result == nil: - when oKeepVariableNames: - let keepOrigName = s.kind in skLocalVars - {skForVar} and - {sfFromGeneric, sfGlobal, sfShadowed, sfGenSym} * s.flags == {} and - not isKeyword(s.name) - # XXX: This is still very experimental - # - # Even with all these inefficient checks, the bootstrap - # time is actually improved. This is probably because so many - # rope concatenations are now eliminated. - # - # Future notes: - # sfFromGeneric seems to be needed in order to avoid multiple - # definitions of certain variables generated in transf with - # names such as: - # `r`, `res` - # I need to study where these come from. - # - # about sfShadowed: - # consider the following nimrod code: - # var x = 10 - # block: - # var x = something(x) - # The generated C code will be: - # NI x; - # x = 10; - # { - # NI x; - # x = something(x); // Oops, x is already shadowed here - # } - # Right now, we work-around by not keeping the original name - # of the shadowed variable, but we can do better - we can - # create an alternative reference to it in the outer scope and - # use that in the inner scope. - # - # about isCKeyword: - # nimrod variable names can be C keywords. - # We need to avoid such names in the generated code. - # XXX: Study whether mangleName is called just once per variable. - # Otherwise, there might be better place to do this. - # - # about sfGlobal: - # This seems to be harder - a top level extern variable from - # another modules can have the same name as a local one. - # Maybe we should just implement sfShadowed for them too. - # - # about skForVar: - # These are not properly scoped now - we need to add blocks - # around for loops in transf - if keepOrigName: - result = s.name.s.mangle.rope - else: - add(result, rope(mangle(s.name.s))) - add(result, ~"_") - add(result, rope(s.id)) + let keepOrigName = s.kind in skLocalVars - {skForVar} and + {sfFromGeneric, sfGlobal, sfShadowed, sfGenSym} * s.flags == {} and + not isKeyword(s.name) + # Even with all these inefficient checks, the bootstrap + # time is actually improved. This is probably because so many + # rope concatenations are now eliminated. + # + # sfFromGeneric is needed in order to avoid multiple + # definitions of certain variables generated in transf with + # names such as: + # `r`, `res` + # I need to study where these come from. + # + # about sfShadowed: + # consider the following Nim code: + # var x = 10 + # block: + # var x = something(x) + # The generated C code will be: + # NI x; + # x = 10; + # { + # NI x; + # x = something(x); // Oops, x is already shadowed here + # } + # Right now, we work-around by not keeping the original name + # of the shadowed variable, but we can do better - we can + # create an alternative reference to it in the outer scope and + # use that in the inner scope. + # + # about isCKeyword: + # Nim variable names can be C keywords. + # We need to avoid such names in the generated code. + # + # about sfGlobal: + # This seems to be harder - a top level extern variable from + # another modules can have the same name as a local one. + # Maybe we should just implement sfShadowed for them too. + # + # about skForVar: + # These are not properly scoped now - we need to add blocks + # around for loops in transf + result = s.name.s.mangle.rope + if keepOrigName: + result.add "0" else: - add(result, rope(mangle(s.name.s))) add(result, ~"_") add(result, rope(s.id)) + add(result, ~"_") + add(result, rope(hashOwner(s).BiggestInt)) s.loc.r = result proc typeName(typ: PType): Rope = @@ -242,18 +243,6 @@ proc getSimpleTypeDesc(m: BModule, typ: PType): Rope = case typ.kind of tyPointer: result = typeNameOrLiteral(typ, "void*") - of tyEnum: - if firstOrd(typ) < 0: - result = typeNameOrLiteral(typ, "NI32") - else: - case int(getSize(typ)) - of 1: result = typeNameOrLiteral(typ, "NU8") - of 2: result = typeNameOrLiteral(typ, "NU16") - of 4: result = typeNameOrLiteral(typ, "NI32") - of 8: result = typeNameOrLiteral(typ, "NI64") - else: - internalError(typ.sym.info, "getSimpleTypeDesc: " & $(getSize(typ))) - result = nil of tyString: discard cgsym(m, "NimStringDesc") result = typeNameOrLiteral(typ, "NimStringDesc*") @@ -536,8 +525,8 @@ proc getTypeDescAux(m: BModule, typ: PType, check: var IntSet): Rope = result = getTypePre(m, t) if result != nil: return if containsOrIncl(check, t.id): - if isImportedCppType(typ) or isImportedCppType(t): return - internalError("cannot generate C type for: " & typeToString(typ)) + if not (isImportedCppType(typ) or isImportedCppType(t)): + internalError("cannot generate C type for: " & typeToString(typ)) # XXX: this BUG is hard to fix -> we need to introduce helper structs, # but determining when this needs to be done is hard. We should split # C type generation into an analysis and a code generation phase somehow. @@ -576,8 +565,35 @@ proc getTypeDescAux(m: BModule, typ: PType, check: var IntSet): Rope = result = getTypeDescAux(m, et, check) & star idTablePut(m.typeCache, t, result) of tyOpenArray, tyVarargs: - result = getTypeDescAux(m, t.sons[0], check) & "*" + result = getTypeDescWeak(m, t.sons[0], check) & "*" idTablePut(m.typeCache, t, result) + of tyRange, tyEnum: + let t = if t.kind == tyRange: t.lastSon else: t + result = getTypeName(t) + if not (isImportedCppType(t) or + (sfImportc in t.sym.flags and t.sym.magic == mNone)): + idTablePut(m.typeCache, t, result) + var size: int + if firstOrd(t) < 0: + addf(m.s[cfsTypes], "typedef NI32 $1;$n", [result]) + size = 4 + else: + size = int(getSize(t)) + case size + of 1: addf(m.s[cfsTypes], "typedef NU8 $1;$n", [result]) + of 2: addf(m.s[cfsTypes], "typedef NU16 $1;$n", [result]) + of 4: addf(m.s[cfsTypes], "typedef NI32 $1;$n", [result]) + of 8: addf(m.s[cfsTypes], "typedef NI64 $1;$n", [result]) + else: internalError(t.sym.info, "getTypeDescAux: enum") + let owner = hashOwner(t.sym) + if not gDebugInfo.hasEnum(t.sym.name.s, t.sym.info.line, owner): + var vals: seq[(string, int)] = @[] + for i in countup(0, t.n.len - 1): + assert(t.n.sons[i].kind == nkSym) + let field = t.n.sons[i].sym + vals.add((field.name.s, field.position.int)) + gDebugInfo.registerEnum(EnumDesc(size: size, owner: owner, id: t.sym.id, + name: t.sym.name.s, values: vals)) of tyProc: result = getTypeName(t) idTablePut(m.typeCache, t, result) @@ -654,7 +670,7 @@ proc getTypeDescAux(m: BModule, typ: PType, check: var IntSet): Rope = else: result = cppName & "<" for i in 1 .. typ.len-2: - if i > 1: result.add(", ") + if i > 1: result.add(" COMMA ") result.add(getTypeDescAux(m, typ.sons[i], check)) result.add("> ") # always call for sideeffects: @@ -673,16 +689,13 @@ proc getTypeDescAux(m: BModule, typ: PType, check: var IntSet): Rope = else: getTupleDesc(m, t, result, check) if not isImportedType(t): add(m.s[cfsTypes], recdesc) of tySet: - case int(getSize(t)) - of 1: result = rope("NU8") - of 2: result = rope("NU16") - of 4: result = rope("NU32") - of 8: result = rope("NU64") - else: - result = getTypeName(t) - idTablePut(m.typeCache, t, result) - if not isImportedType(t): - addf(m.s[cfsTypes], "typedef NU8 $1[$2];$n", + result = getTypeName(t.lastSon) & "Set" + idTablePut(m.typeCache, t, result) + if not isImportedType(t): + let s = int(getSize(t)) + case s + of 1, 2, 4, 8: addf(m.s[cfsTypes], "typedef NU$2 $1;$n", [result, rope(s*8)]) + else: addf(m.s[cfsTypes], "typedef NU8 $1[$2];$n", [result, rope(getSize(t))]) of tyGenericInst, tyDistinct, tyOrdinal, tyConst, tyMutable, tyIter, tyTypeDesc: @@ -739,7 +752,7 @@ proc genProcHeader(m: BModule, prc: PSym): Rope = genCLineDir(result, prc.info) # using static is needed for inline procs if lfExportLib in prc.loc.flags: - if m.isHeaderFile: + if isHeaderFile in m.flags: result.add "N_LIB_IMPORT " else: result.add "N_LIB_EXPORT " diff --git a/compiler/cgen.nim b/compiler/cgen.nim index f63134b66..77be125b6 100644 --- a/compiler/cgen.nim +++ b/compiler/cgen.nim @@ -64,8 +64,8 @@ proc isSimpleConst(typ: PType): bool = (t.kind == tyProc and t.callConv == ccClosure) proc useStringh(m: BModule) = - if not m.includesStringh: - m.includesStringh = true + if includesStringh notin m.flags: + incl m.flags, includesStringh discard lists.includeStr(m.headerFiles, "<string.h>") proc useHeader(m: BModule, sym: PSym) = @@ -301,7 +301,8 @@ proc resetLoc(p: BProc, loc: var TLoc) = proc constructLoc(p: BProc, loc: TLoc, isTemp = false) = let typ = skipTypes(loc.t, abstractRange) if not isComplexValueType(typ): - linefmt(p, cpsStmts, "$1 = 0;$n", rdLoc(loc)) + linefmt(p, cpsStmts, "$1 = ($2)0;$n", rdLoc(loc), + getTypeDesc(p.module, typ)) else: if not isTemp or containsGarbageCollectedRef(loc.t): # don't use memset for temporary values for performance if we can @@ -330,7 +331,8 @@ proc getTemp(p: BProc, t: PType, result: var TLoc; needsInit=false) = linefmt(p, cpsLocals, "$1 $2;$n", getTypeDesc(p.module, t), result.r) result.k = locTemp #result.a = - 1 - result.t = getUniqueType(t) + result.t = t + #result.t = getUniqueType(t) result.s = OnStack result.flags = {} constructLoc(p, result, not needsInit) @@ -594,7 +596,7 @@ proc cgsym(m: BModule, name: string): Rope = var sym = magicsys.getCompilerProc(name) if sym != nil: case sym.kind - of skProc, skMethod, skConverter, skIterators: genProc(m, sym) + of skProc, skMethod, skConverter, skIterator: genProc(m, sym) of skVar, skResult, skLet: genVarPrototype(m, sym) of skType: discard getTypeDesc(m, sym.typ) else: internalError("cgsym: " & name & ": " & $sym.kind) @@ -1009,11 +1011,11 @@ proc genInitCode(m: BModule) = add(prc, m.postInitProc.s(cpsLocals)) add(prc, genSectionEnd(cpsLocals)) - if optStackTrace in m.initProc.options and not m.frameDeclared: + if optStackTrace in m.initProc.options and frameDeclared notin m.flags: # BUT: the generated init code might depend on a current frame, so # declare it nevertheless: - m.frameDeclared = true - if not m.preventStackTrace: + incl m.flags, frameDeclared + if preventStackTrace notin m.flags: var procname = makeCString(m.module.name.s) add(prc, initFrame(m.initProc, procname, m.module.info.quotedFilename)) else: @@ -1030,7 +1032,7 @@ proc genInitCode(m: BModule) = add(prc, m.initProc.s(cpsStmts)) add(prc, m.postInitProc.s(cpsStmts)) add(prc, genSectionEnd(cpsStmts)) - if optStackTrace in m.initProc.options and not m.preventStackTrace: + if optStackTrace in m.initProc.options and preventStackTrace notin m.flags: add(prc, deinitFrame(m.initProc)) add(prc, deinitGCFrame(m.initProc)) addf(prc, "}$N$N", []) @@ -1059,9 +1061,8 @@ proc genModule(m: BModule, cfile: string): Rope = result = getFileHeader(cfile) result.add(genMergeInfo(m)) - generateHeaders(m) - generateThreadLocalStorage(m) + generateHeaders(m) for i in countup(cfsHeaders, cfsProcs): add(result, genSectionStart(i)) add(result, m.s[i]) @@ -1104,7 +1105,7 @@ proc rawNewModule(module: PSym, filename: string): BModule = # no line tracing for the init sections of the system module so that we # don't generate a TFrame which can confuse the stack botton initialization: if sfSystemModule in module.flags: - result.preventStackTrace = true + incl result.flags, preventStackTrace excl(result.preInitProc.options, optStackTrace) excl(result.postInitProc.options, optStackTrace) @@ -1127,9 +1128,11 @@ proc resetModule*(m: BModule) = m.forwardedProcs = @[] m.typeNodesName = getTempName() m.nimTypesName = getTempName() - m.preventStackTrace = sfSystemModule in m.module.flags + if sfSystemModule in m.module.flags: + incl m.flags, preventStackTrace + else: + excl m.flags, preventStackTrace nullify m.s - m.usesThreadVars = false m.typeNodes = 0 m.nimTypes = 0 nullify m.extensionLoaders @@ -1174,7 +1177,7 @@ proc myOpen(module: PSym): PPassContext = let f = if headerFile.len > 0: headerFile else: gProjectFull generatedHeader = rawNewModule(module, changeFileExt(completeCFilePath(f), hExt)) - generatedHeader.isHeaderFile = true + incl generatedHeader.flags, isHeaderFile proc writeHeader(m: BModule) = var result = getCopyright(m.filename) @@ -1306,7 +1309,7 @@ proc myClose(b: PPassContext, n: PNode): PNode = registerModuleToMain(m.module) if sfMainModule in m.module.flags: - m.objHasKidsValid = true + incl m.flags, objHasKidsValid var disp = generateMethodDispatchers() for i in 0..sonsLen(disp)-1: genProcAux(m, disp.sons[i].sym) genMainProc(m) diff --git a/compiler/cgendata.nim b/compiler/cgendata.nim index 187186373..c098902a6 100644 --- a/compiler/cgendata.nim +++ b/compiler/cgendata.nim @@ -92,17 +92,20 @@ type gcFrameType*: Rope # the struct {} we put the GC markers into TTypeSeq* = seq[PType] + + Codegenflag* = enum + preventStackTrace, # true if stack traces need to be prevented + usesThreadVars, # true if the module uses a thread var + frameDeclared, # hack for ROD support so that we don't declare + # a frame var twice in an init proc + isHeaderFile, # C source file is the header file + includesStringh, # C source file already includes ``<string.h>`` + objHasKidsValid # whether we can rely on tfObjHasKids TCGen = object of TPassContext # represents a C source file module*: PSym filename*: string s*: TCFileSections # sections of the C file - preventStackTrace*: bool # true if stack traces need to be prevented - usesThreadVars*: bool # true if the module uses a thread var - frameDeclared*: bool # hack for ROD support so that we don't declare - # a frame var twice in an init proc - isHeaderFile*: bool # C source file is the header file - includesStringh*: bool # C source file already includes ``<string.h>`` - objHasKidsValid*: bool # whether we can rely on tfObjHasKids + flags*: set[Codegenflag] cfilename*: string # filename of the module (including path, # without extension) typeCache*: TIdTable # cache the generated types diff --git a/compiler/cgmeth.nim b/compiler/cgmeth.nim index d2358b84a..312afec1a 100644 --- a/compiler/cgmeth.nim +++ b/compiler/cgmeth.nim @@ -18,8 +18,10 @@ proc genConv(n: PNode, d: PType, downcast: bool): PNode = var source = skipTypes(n.typ, abstractPtrs) if (source.kind == tyObject) and (dest.kind == tyObject): var diff = inheritanceDiff(dest, source) - if diff == high(int): internalError(n.info, "cgmeth.genConv") - if diff < 0: + if diff == high(int): + # no subtype relation, nothing to do + result = n + elif diff < 0: result = newNodeIT(nkObjUpConv, n.info, d) addSon(result, n) if downcast: internalError(n.info, "cgmeth.genConv: no upcast allowed") @@ -66,15 +68,16 @@ proc sameMethodBucket(a, b: PSym): MethodResult = bb = bb.lastSon else: break - if sameType(aa, bb): discard + if sameType(aa, bb): + if aa.kind == tyObject and result != Invalid: result = Yes elif aa.kind == tyObject and bb.kind == tyObject: let diff = inheritanceDiff(bb, aa) - if diff < 0: discard "Ok" + if diff < 0: + if result != Invalid: result = Yes elif diff != high(int): result = Invalid else: return No - if result != Invalid: result = Yes proc attachDispatcher(s: PSym, dispatcher: PNode) = var L = s.ast.len-1 @@ -231,7 +234,7 @@ proc genDispatcher(methods: TSymSeq, relevantCols: IntSet): PSym = curr.typ.sons[col], false)) var ret: PNode if base.typ.sons[0] != nil: - var a = newNodeI(nkAsgn, base.info) + var a = newNodeI(nkFastAsgn, base.info) addSon(a, newSymNode(base.ast.sons[resultPos].sym)) addSon(a, call) ret = newNodeI(nkReturnStmt, base.info) @@ -256,4 +259,3 @@ proc generateMethodDispatchers*(): PNode = sortBucket(gMethods[bucket].methods, relevantCols) addSon(result, newSymNode(genDispatcher(gMethods[bucket].methods, relevantCols))) - diff --git a/compiler/commands.nim b/compiler/commands.nim index 6b2f074e8..dc04993a7 100644 --- a/compiler/commands.nim +++ b/compiler/commands.nim @@ -53,7 +53,7 @@ proc processSwitch*(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) const HelpMessage = "Nim Compiler Version $1 (" & CompileDate & ") [$2: $3]\n" & - "Copyright (c) 2006-2015 by Andreas Rumpf\n" + "Copyright (c) 2006-" & CompileDate.substr(0, 3) & " by Andreas Rumpf\n" const Usage = slurp"doc/basicopt.txt".replace("//", "") @@ -65,14 +65,15 @@ proc getCommandLineDesc(): string = proc helpOnError(pass: TCmdLinePass) = if pass == passCmd1: - msgWriteln(getCommandLineDesc()) + msgWriteln(getCommandLineDesc(), {msgStdout}) msgQuit(0) proc writeAdvancedUsage(pass: TCmdLinePass) = if pass == passCmd1: msgWriteln(`%`(HelpMessage, [VersionAsString, platform.OS[platform.hostOS].name, - CPU[platform.hostCPU].name]) & AdvancedUsage) + CPU[platform.hostCPU].name]) & AdvancedUsage, + {msgStdout}) msgQuit(0) proc writeVersionInfo(pass: TCmdLinePass) = @@ -95,7 +96,7 @@ var proc writeCommandLineUsage() = if not helpWritten: - msgWriteln(getCommandLineDesc()) + msgWriteln(getCommandLineDesc(), {msgStdout}) helpWritten = true proc addPrefix(switch: string): string = @@ -204,6 +205,7 @@ proc testCompileOptionArg*(switch, arg: string, info: TLineInfo): bool = of "generational": result = gSelectedGC == gcGenerational of "go": result = gSelectedGC == gcGo of "none": result = gSelectedGC == gcNone + of "stack": result = gSelectedGC == gcStack else: localError(info, errNoneBoehmRefcExpectedButXFound, arg) of "opt": case arg.normalize @@ -211,6 +213,7 @@ proc testCompileOptionArg*(switch, arg: string, info: TLineInfo): bool = of "size": result = contains(gOptions, optOptimizeSize) of "none": result = gOptions * {optOptimizeSpeed, optOptimizeSize} == {} else: localError(info, errNoneSpeedOrSizeExpectedButXFound, arg) + of "verbosity": result = $gVerbosity == arg else: invalidCmdLineOption(passCmd1, switch, info) proc testCompileOption*(switch: string, info: TLineInfo): bool = @@ -251,20 +254,24 @@ proc testCompileOption*(switch: string, info: TLineInfo): bool = of "experimental": result = gExperimentalMode else: invalidCmdLineOption(passCmd1, switch, info) -proc processPath(path: string, notRelativeToProj = false, - cfginfo = unknownLineInfo()): string = +proc processPath(path: string, info: TLineInfo, + notRelativeToProj = false): string = let p = if notRelativeToProj or os.isAbsolute(path) or '$' in path or path[0] == '.': path else: options.gProjectPath / path - result = unixToNativePath(p % ["nimrod", getPrefixDir(), - "nim", getPrefixDir(), - "lib", libpath, - "home", removeTrailingDirSep(os.getHomeDir()), - "config", cfginfo.toFullPath().splitFile().dir, - "projectname", options.gProjectName, - "projectpath", options.gProjectPath]) + try: + result = unixToNativePath(p % ["nimrod", getPrefixDir(), + "nim", getPrefixDir(), + "lib", libpath, + "home", removeTrailingDirSep(os.getHomeDir()), + "config", info.toFullPath().splitFile().dir, + "projectname", options.gProjectName, + "projectpath", options.gProjectPath]) + except ValueError: + localError(info, "invalid path: " & p) + result = p proc trackDirty(arg: string, info: TLineInfo) = var a = arg.split(',') @@ -305,19 +312,19 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = case switch.normalize of "path", "p": expectArg(switch, arg, pass, info) - addPath(processPath(arg, cfginfo=info), info) + addPath(processPath(arg, info), info) of "nimblepath", "babelpath": # keep the old name for compat if pass in {passCmd2, passPP} and not options.gNoNimblePath: expectArg(switch, arg, pass, info) - let path = processPath(arg, notRelativeToProj=true) + let path = processPath(arg, info, notRelativeToProj=true) nimblePath(path, info) of "nonimblepath", "nobabelpath": expectNoArg(switch, arg, pass, info) options.gNoNimblePath = true of "excludepath": expectArg(switch, arg, pass, info) - let path = processPath(arg) + let path = processPath(arg, info) lists.excludePath(options.searchPaths, path) lists.excludePath(options.lazyPaths, path) if (len(path) > 0) and (path[len(path) - 1] == DirSep): @@ -326,7 +333,7 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = lists.excludePath(options.lazyPaths, strippedPath) of "nimcache": expectArg(switch, arg, pass, info) - options.nimcacheDir = processPath(arg) + options.nimcacheDir = processPath(arg, info, true) of "out", "o": expectArg(switch, arg, pass, info) options.outFile = arg @@ -393,6 +400,9 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = of "none": gSelectedGC = gcNone defineSymbol("nogc") + of "stack": + gSelectedGC= gcStack + defineSymbol("gcstack") else: localError(info, errNoneBoehmRefcExpectedButXFound, arg) of "warnings", "w": if processOnOffSwitchOrList({optWarns}, arg, pass, info): listWarnings() @@ -434,6 +444,8 @@ 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 "reportconceptfailures": + processOnOffSwitchG({optReportConceptFailures}, arg, pass, info) of "threads": processOnOffSwitchG({optThreads}, arg, pass, info) #if optThreads in gGlobalOptions: incl(gNotes, warnGcUnsafe) @@ -486,13 +498,13 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = if pass in {passCmd2, passPP}: extccomp.addLinkOption(arg) of "cincludes": expectArg(switch, arg, pass, info) - if pass in {passCmd2, passPP}: cIncludes.add arg.processPath + if pass in {passCmd2, passPP}: cIncludes.add arg.processPath(info) of "clibdir": expectArg(switch, arg, pass, info) - if pass in {passCmd2, passPP}: cLibs.add arg.processPath + if pass in {passCmd2, passPP}: cLibs.add arg.processPath(info) of "clib": expectArg(switch, arg, pass, info) - if pass in {passCmd2, passPP}: cLinkedLibs.add arg.processPath + if pass in {passCmd2, passPP}: cLinkedLibs.add arg.processPath(info) of "header": headerFile = arg incl(gGlobalOptions, optGenIndex) @@ -565,7 +577,7 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = of "colors": processOnOffSwitchG({optUseColors}, arg, pass, info) of "lib": expectArg(switch, arg, pass, info) - libpath = processPath(arg, notRelativeToProj=true) + libpath = processPath(arg, info, notRelativeToProj=true) of "putenv": expectArg(switch, arg, pass, info) splitSwitch(arg, key, val, pass, info) @@ -616,6 +628,10 @@ proc processSwitch(switch, arg: string, pass: TCmdLinePass, info: TLineInfo) = cAssembler = nameToCC(arg) if cAssembler notin cValidAssemblers: localError(info, errGenerated, "'$1' is not a valid assembler." % [arg]) + of "nocppexceptions": + expectNoArg(switch, arg, pass, info) + incl(gGlobalOptions, optNoCppExceptions) + defineSymbol("noCppExceptions") else: if strutils.find(switch, '.') >= 0: options.setConfigVar(switch, arg) else: invalidCmdLineOption(pass, switch, info) diff --git a/compiler/debuginfo.nim b/compiler/debuginfo.nim new file mode 100644 index 000000000..8589730b9 --- /dev/null +++ b/compiler/debuginfo.nim @@ -0,0 +1,81 @@ +# +# +# The Nim Compiler +# (c) Copyright 2016 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## The compiler can generate debuginfo to help debuggers in translating back from C/C++/JS code +## to Nim. The data structure has been designed to produce something useful with Nim's marshal +## module. + +type + FilenameHash* = uint32 + FilenameMapping* = object + package*, file*: string + mangled*: FilenameHash + EnumDesc* = object + size*: int + owner*: FilenameHash + id*: int + name*: string + values*: seq[(string, int)] + DebugInfo* = object + version*: int + files*: seq[FilenameMapping] + enums*: seq[EnumDesc] + conflicts*: bool + +proc sdbmHash(hash: FilenameHash, c: char): FilenameHash {.inline.} = + return FilenameHash(c) + (hash shl 6) + (hash shl 16) - hash + +proc sdbmHash(package, file: string): FilenameHash = + template `&=`(x, c) = x = sdbmHash(x, c) + result = 0 + for i in 0..<package.len: + result &= package[i] + result &= '.' + for i in 0..<file.len: + result &= file[i] + +proc register*(self: var DebugInfo; package, file: string): FilenameHash = + result = sdbmHash(package, file) + for f in self.files: + if f.mangled == result: + if f.package == package and f.file == file: return + self.conflicts = true + break + self.files.add(FilenameMapping(package: package, file: file, mangled: result)) + +proc hasEnum*(self: DebugInfo; ename: string; id: int; owner: FilenameHash): bool = + for en in self.enums: + if en.owner == owner and en.name == ename and en.id == id: return true + +proc registerEnum*(self: var DebugInfo; ed: EnumDesc) = + self.enums.add ed + +proc init*(self: var DebugInfo) = + self.version = 1 + self.files = @[] + self.enums = @[] + +var gDebugInfo*: DebugInfo +debuginfo.init gDebugInfo + +import marshal, streams + +proc writeDebugInfo*(self: var DebugInfo; file: string) = + let s = newFileStream(file, fmWrite) + store(s, self) + s.close + +proc writeDebugInfo*(file: string) = writeDebugInfo(gDebugInfo, file) + +proc loadDebugInfo*(self: var DebugInfo; file: string) = + let s = newFileStream(file, fmRead) + load(s, self) + s.close + +proc loadDebugInfo*(file: string) = loadDebugInfo(gDebugInfo, file) diff --git a/compiler/docgen.nim b/compiler/docgen.nim index 8ae32492a..8555ec4f0 100644 --- a/compiler/docgen.nim +++ b/compiler/docgen.nim @@ -149,16 +149,16 @@ proc ropeFormatNamedVars(frmt: FormatStr, varnames: openArray[string], proc genComment(d: PDoc, n: PNode): string = result = "" var dummyHasToc: bool - if n.comment != nil and startsWith(n.comment, "##"): + if n.comment != nil: renderRstToOut(d[], parseRst(n.comment, toFilename(n.info), toLinenumber(n.info), toColumn(n.info), - dummyHasToc, d.options + {roSkipPounds}), result) + dummyHasToc, d.options), result) proc genRecComment(d: PDoc, n: PNode): Rope = if n == nil: return nil result = genComment(d, n).rope if result == nil: - if n.kind notin {nkEmpty..nkNilLit}: + if n.kind notin {nkEmpty..nkNilLit, nkEnumTy}: for i in countup(0, len(n)-1): result = genRecComment(d, n.sons[i]) if result != nil: return @@ -537,7 +537,7 @@ proc generateJson(d: PDoc, n: PNode, jArray: JsonNode = nil): JsonNode = proc genSection(d: PDoc, kind: TSymKind) = const sectionNames: array[skModule..skTemplate, string] = [ "Imports", "Types", "Vars", "Lets", "Consts", "Vars", "Procs", "Methods", - "Iterators", "Iterators", "Converters", "Macros", "Templates" + "Iterators", "Converters", "Macros", "Templates" ] if d.section[kind] == nil: return var title = sectionNames[kind].rope diff --git a/compiler/evalffi.nim b/compiler/evalffi.nim new file mode 100644 index 000000000..75394c2f3 --- /dev/null +++ b/compiler/evalffi.nim @@ -0,0 +1,496 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## This file implements the FFI part of the evaluator for Nim code. + +import ast, astalgo, ropes, types, options, tables, dynlib, libffi, msgs, os + +when defined(windows): + const libcDll = "msvcrt.dll" +else: + const libcDll = "libc.so(.6|.5|)" + +type + TDllCache = tables.TTable[string, TLibHandle] +var + gDllCache = initTable[string, TLibHandle]() + +when defined(windows): + var gExeHandle = loadLib(os.getAppFilename()) +else: + var gExeHandle = loadLib() + +proc getDll(cache: var TDllCache; dll: string; info: TLineInfo): pointer = + result = cache[dll] + if result.isNil: + var libs: seq[string] = @[] + libCandidates(dll, libs) + for c in libs: + result = loadLib(c) + if not result.isNil: break + if result.isNil: + globalError(info, "cannot load: " & dll) + cache[dll] = result + +const + nkPtrLit = nkIntLit # hopefully we can get rid of this hack soon + +var myerrno {.importc: "errno", header: "<errno.h>".}: cint ## error variable + +proc importcSymbol*(sym: PSym): PNode = + let name = ropeToStr(sym.loc.r) + + # the AST does not support untyped pointers directly, so we use an nkIntLit + # that contains the address instead: + result = newNodeIT(nkPtrLit, sym.info, sym.typ) + case name + of "stdin": result.intVal = cast[ByteAddress](system.stdin) + of "stdout": result.intVal = cast[ByteAddress](system.stdout) + of "stderr": result.intVal = cast[ByteAddress](system.stderr) + of "vmErrnoWrapper": result.intVal = cast[ByteAddress](myerrno) + else: + let lib = sym.annex + if lib != nil and lib.path.kind notin {nkStrLit..nkTripleStrLit}: + globalError(sym.info, "dynlib needs to be a string lit for the REPL") + var theAddr: pointer + if lib.isNil and not gExehandle.isNil: + # first try this exe itself: + theAddr = gExehandle.symAddr(name) + # then try libc: + if theAddr.isNil: + let dllhandle = gDllCache.getDll(libcDll, sym.info) + theAddr = dllhandle.symAddr(name) + elif not lib.isNil: + let dllhandle = gDllCache.getDll(if lib.kind == libHeader: libcDll + else: lib.path.strVal, sym.info) + theAddr = dllhandle.symAddr(name) + if theAddr.isNil: globalError(sym.info, "cannot import: " & sym.name.s) + result.intVal = cast[ByteAddress](theAddr) + +proc mapType(t: ast.PType): ptr libffi.TType = + if t == nil: return addr libffi.type_void + + case t.kind + of tyBool, tyEnum, tyChar, tyInt..tyInt64, tyUInt..tyUInt64, tySet: + case t.getSize + of 1: result = addr libffi.type_uint8 + of 2: result = addr libffi.type_sint16 + of 4: result = addr libffi.type_sint32 + of 8: result = addr libffi.type_sint64 + else: result = nil + of tyFloat, tyFloat64: result = addr libffi.type_double + of tyFloat32: result = addr libffi.type_float + of tyVar, tyPointer, tyPtr, tyRef, tyCString, tySequence, tyString, tyExpr, + tyStmt, tyTypeDesc, tyProc, tyArray, tyArrayConstr, tyStatic, tyNil: + result = addr libffi.type_pointer + of tyDistinct: + result = mapType(t.sons[0]) + else: + result = nil + # too risky: + #of tyFloat128: result = addr libffi.type_longdouble + +proc mapCallConv(cc: TCallingConvention, info: TLineInfo): TABI = + case cc + of ccDefault: result = DEFAULT_ABI + of ccStdCall: result = when defined(windows): STDCALL else: DEFAULT_ABI + of ccCDecl: result = DEFAULT_ABI + else: + globalError(info, "cannot map calling convention to FFI") + +template rd(T, p: expr): expr {.immediate.} = (cast[ptr T](p))[] +template wr(T, p, v: expr) {.immediate.} = (cast[ptr T](p))[] = v +template `+!`(x, y: expr): expr {.immediate.} = + cast[pointer](cast[ByteAddress](x) + y) + +proc packSize(v: PNode, typ: PType): int = + ## computes the size of the blob + case typ.kind + of tyPtr, tyRef, tyVar: + if v.kind in {nkNilLit, nkPtrLit}: + result = sizeof(pointer) + else: + result = sizeof(pointer) + packSize(v.sons[0], typ.lastSon) + of tyDistinct, tyGenericInst: + result = packSize(v, typ.sons[0]) + of tyArray, tyArrayConstr: + # consider: ptr array[0..1000_000, int] which is common for interfacing; + # we use the real length here instead + if v.kind in {nkNilLit, nkPtrLit}: + result = sizeof(pointer) + elif v.len != 0: + result = v.len * packSize(v.sons[0], typ.sons[1]) + else: + result = typ.getSize.int + +proc pack(v: PNode, typ: PType, res: pointer) + +proc getField(n: PNode; position: int): PSym = + case n.kind + of nkRecList: + for i in countup(0, sonsLen(n) - 1): + result = getField(n.sons[i], position) + if result != nil: return + of nkRecCase: + result = getField(n.sons[0], position) + if result != nil: return + for i in countup(1, sonsLen(n) - 1): + case n.sons[i].kind + of nkOfBranch, nkElse: + result = getField(lastSon(n.sons[i]), position) + if result != nil: return + else: internalError(n.info, "getField(record case branch)") + of nkSym: + if n.sym.position == position: result = n.sym + else: discard + +proc packObject(x: PNode, typ: PType, res: pointer) = + internalAssert x.kind in {nkObjConstr, nkPar} + # compute the field's offsets: + discard typ.getSize + for i in countup(ord(x.kind == nkObjConstr), sonsLen(x) - 1): + var it = x.sons[i] + if it.kind == nkExprColonExpr: + internalAssert it.sons[0].kind == nkSym + let field = it.sons[0].sym + pack(it.sons[1], field.typ, res +! field.offset) + elif typ.n != nil: + let field = getField(typ.n, i) + pack(it, field.typ, res +! field.offset) + else: + # XXX: todo + globalError(x.info, "cannot pack unnamed tuple") + +const maxPackDepth = 20 +var packRecCheck = 0 + +proc pack(v: PNode, typ: PType, res: pointer) = + template awr(T, v: expr) {.immediate, dirty.} = + wr(T, res, v) + + case typ.kind + of tyBool: awr(bool, v.intVal != 0) + of tyChar: awr(char, v.intVal.chr) + of tyInt: awr(int, v.intVal.int) + of tyInt8: awr(int8, v.intVal.int8) + of tyInt16: awr(int16, v.intVal.int16) + of tyInt32: awr(int32, v.intVal.int32) + of tyInt64: awr(int64, v.intVal.int64) + of tyUInt: awr(uint, v.intVal.uint) + of tyUInt8: awr(uint8, v.intVal.uint8) + of tyUInt16: awr(uint16, v.intVal.uint16) + of tyUInt32: awr(uint32, v.intVal.uint32) + of tyUInt64: awr(uint64, v.intVal.uint64) + of tyEnum, tySet: + case v.typ.getSize + of 1: awr(uint8, v.intVal.uint8) + of 2: awr(uint16, v.intVal.uint16) + of 4: awr(int32, v.intVal.int32) + of 8: awr(int64, v.intVal.int64) + else: + globalError(v.info, "cannot map value to FFI (tyEnum, tySet)") + of tyFloat: awr(float, v.floatVal) + of tyFloat32: awr(float32, v.floatVal) + of tyFloat64: awr(float64, v.floatVal) + + of tyPointer, tyProc, tyCString, tyString: + if v.kind == nkNilLit: + # nothing to do since the memory is 0 initialized anyway + discard + elif v.kind == nkPtrLit: + awr(pointer, cast[pointer](v.intVal)) + elif v.kind in {nkStrLit..nkTripleStrLit}: + awr(cstring, cstring(v.strVal)) + else: + globalError(v.info, "cannot map pointer/proc value to FFI") + of tyPtr, tyRef, tyVar: + if v.kind == nkNilLit: + # nothing to do since the memory is 0 initialized anyway + discard + elif v.kind == nkPtrLit: + awr(pointer, cast[pointer](v.intVal)) + else: + if packRecCheck > maxPackDepth: + packRecCheck = 0 + globalError(v.info, "cannot map value to FFI " & typeToString(v.typ)) + inc packRecCheck + pack(v.sons[0], typ.lastSon, res +! sizeof(pointer)) + dec packRecCheck + awr(pointer, res +! sizeof(pointer)) + of tyArray, tyArrayConstr: + let baseSize = typ.sons[1].getSize + for i in 0 .. <v.len: + pack(v.sons[i], typ.sons[1], res +! i * baseSize) + of tyObject, tyTuple: + packObject(v, typ, res) + of tyNil: + discard + of tyDistinct, tyGenericInst: + pack(v, typ.sons[0], res) + else: + globalError(v.info, "cannot map value to FFI " & typeToString(v.typ)) + +proc unpack(x: pointer, typ: PType, n: PNode): PNode + +proc unpackObjectAdd(x: pointer, n, result: PNode) = + case n.kind + of nkRecList: + for i in countup(0, sonsLen(n) - 1): + unpackObjectAdd(x, n.sons[i], result) + of nkRecCase: + globalError(result.info, "case objects cannot be unpacked") + of nkSym: + var pair = newNodeI(nkExprColonExpr, result.info, 2) + pair.sons[0] = n + pair.sons[1] = unpack(x +! n.sym.offset, n.sym.typ, nil) + #echo "offset: ", n.sym.name.s, " ", n.sym.offset + result.add pair + else: discard + +proc unpackObject(x: pointer, typ: PType, n: PNode): PNode = + # compute the field's offsets: + discard typ.getSize + + # iterate over any actual field of 'n' ... if n is nil we need to create + # the nkPar node: + if n.isNil: + result = newNode(nkPar) + result.typ = typ + if typ.n.isNil: + internalError("cannot unpack unnamed tuple") + unpackObjectAdd(x, typ.n, result) + else: + result = n + if result.kind notin {nkObjConstr, nkPar}: + globalError(n.info, "cannot map value from FFI") + if typ.n.isNil: + globalError(n.info, "cannot unpack unnamed tuple") + for i in countup(ord(n.kind == nkObjConstr), sonsLen(n) - 1): + var it = n.sons[i] + if it.kind == nkExprColonExpr: + internalAssert it.sons[0].kind == nkSym + let field = it.sons[0].sym + it.sons[1] = unpack(x +! field.offset, field.typ, it.sons[1]) + else: + let field = getField(typ.n, i) + n.sons[i] = unpack(x +! field.offset, field.typ, it) + +proc unpackArray(x: pointer, typ: PType, n: PNode): PNode = + if n.isNil: + result = newNode(nkBracket) + result.typ = typ + newSeq(result.sons, lengthOrd(typ).int) + else: + result = n + if result.kind != nkBracket: + globalError(n.info, "cannot map value from FFI") + let baseSize = typ.sons[1].getSize + for i in 0 .. < result.len: + result.sons[i] = unpack(x +! i * baseSize, typ.sons[1], result.sons[i]) + +proc canonNodeKind(k: TNodeKind): TNodeKind = + case k + of nkCharLit..nkUInt64Lit: result = nkIntLit + of nkFloatLit..nkFloat128Lit: result = nkFloatLit + of nkStrLit..nkTripleStrLit: result = nkStrLit + else: result = k + +proc unpack(x: pointer, typ: PType, n: PNode): PNode = + template aw(k, v, field: expr) {.immediate, dirty.} = + if n.isNil: + result = newNode(k) + result.typ = typ + else: + # check we have the right field: + result = n + if result.kind.canonNodeKind != k.canonNodeKind: + #echo "expected ", k, " but got ", result.kind + #debug result + return newNodeI(nkExceptBranch, n.info) + #globalError(n.info, "cannot map value from FFI") + result.field = v + + template setNil() = + if n.isNil: + result = newNode(nkNilLit) + result.typ = typ + else: + reset n[] + result = n + result.kind = nkNilLit + result.typ = typ + + template awi(kind, v: expr) {.immediate, dirty.} = aw(kind, v, intVal) + template awf(kind, v: expr) {.immediate, dirty.} = aw(kind, v, floatVal) + template aws(kind, v: expr) {.immediate, dirty.} = aw(kind, v, strVal) + + case typ.kind + of tyBool: awi(nkIntLit, rd(bool, x).ord) + of tyChar: awi(nkCharLit, rd(char, x).ord) + of tyInt: awi(nkIntLit, rd(int, x)) + of tyInt8: awi(nkInt8Lit, rd(int8, x)) + of tyInt16: awi(nkInt16Lit, rd(int16, x)) + of tyInt32: awi(nkInt32Lit, rd(int32, x)) + of tyInt64: awi(nkInt64Lit, rd(int64, x)) + of tyUInt: awi(nkUIntLit, rd(uint, x).BiggestInt) + of tyUInt8: awi(nkUInt8Lit, rd(uint8, x).BiggestInt) + of tyUInt16: awi(nkUInt16Lit, rd(uint16, x).BiggestInt) + of tyUInt32: awi(nkUInt32Lit, rd(uint32, x).BiggestInt) + of tyUInt64: awi(nkUInt64Lit, rd(uint64, x).BiggestInt) + of tyEnum: + case typ.getSize + of 1: awi(nkIntLit, rd(uint8, x).BiggestInt) + of 2: awi(nkIntLit, rd(uint16, x).BiggestInt) + of 4: awi(nkIntLit, rd(int32, x).BiggestInt) + of 8: awi(nkIntLit, rd(int64, x).BiggestInt) + else: + globalError(n.info, "cannot map value from FFI (tyEnum, tySet)") + of tyFloat: awf(nkFloatLit, rd(float, x)) + of tyFloat32: awf(nkFloat32Lit, rd(float32, x)) + of tyFloat64: awf(nkFloat64Lit, rd(float64, x)) + of tyPointer, tyProc: + let p = rd(pointer, x) + if p.isNil: + setNil() + elif n != nil and n.kind == nkStrLit: + # we passed a string literal as a pointer; however strings are already + # in their unboxed representation so nothing it to be unpacked: + result = n + else: + awi(nkPtrLit, cast[ByteAddress](p)) + of tyPtr, tyRef, tyVar: + let p = rd(pointer, x) + if p.isNil: + setNil() + elif n == nil or n.kind == nkPtrLit: + awi(nkPtrLit, cast[ByteAddress](p)) + elif n != nil and n.len == 1: + internalAssert n.kind == nkRefTy + n.sons[0] = unpack(p, typ.lastSon, n.sons[0]) + result = n + else: + globalError(n.info, "cannot map value from FFI " & typeToString(typ)) + of tyObject, tyTuple: + result = unpackObject(x, typ, n) + of tyArray, tyArrayConstr: + result = unpackArray(x, typ, n) + of tyCString, tyString: + let p = rd(cstring, x) + if p.isNil: + setNil() + else: + aws(nkStrLit, $p) + of tyNil: + setNil() + of tyDistinct, tyGenericInst: + result = unpack(x, typ.sons[0], n) + else: + # XXX what to do with 'array' here? + globalError(n.info, "cannot map value from FFI " & typeToString(typ)) + +proc fficast*(x: PNode, destTyp: PType): PNode = + if x.kind == nkPtrLit and x.typ.kind in {tyPtr, tyRef, tyVar, tyPointer, + tyProc, tyCString, tyString, + tySequence}: + result = newNodeIT(x.kind, x.info, destTyp) + result.intVal = x.intVal + elif x.kind == nkNilLit: + result = newNodeIT(x.kind, x.info, destTyp) + else: + # we play safe here and allocate the max possible size: + let size = max(packSize(x, x.typ), packSize(x, destTyp)) + var a = alloc0(size) + pack(x, x.typ, a) + # cast through a pointer needs a new inner object: + let y = if x.kind == nkRefTy: newNodeI(nkRefTy, x.info, 1) + else: x.copyTree + y.typ = x.typ + result = unpack(a, destTyp, y) + dealloc a + +proc callForeignFunction*(call: PNode): PNode = + internalAssert call.sons[0].kind == nkPtrLit + + var cif: TCif + var sig: TParamList + # use the arguments' types for varargs support: + for i in 1..call.len-1: + sig[i-1] = mapType(call.sons[i].typ) + if sig[i-1].isNil: + globalError(call.info, "cannot map FFI type") + + let typ = call.sons[0].typ + if prep_cif(cif, mapCallConv(typ.callConv, call.info), cuint(call.len-1), + mapType(typ.sons[0]), sig) != OK: + globalError(call.info, "error in FFI call") + + var args: TArgList + let fn = cast[pointer](call.sons[0].intVal) + for i in 1 .. call.len-1: + var t = call.sons[i].typ + args[i-1] = alloc0(packSize(call.sons[i], t)) + pack(call.sons[i], t, args[i-1]) + let retVal = if isEmptyType(typ.sons[0]): pointer(nil) + else: alloc(typ.sons[0].getSize.int) + + libffi.call(cif, fn, retVal, args) + + if retVal.isNil: + result = emptyNode + else: + result = unpack(retVal, typ.sons[0], nil) + result.info = call.info + + if retVal != nil: dealloc retVal + for i in 1 .. call.len-1: + call.sons[i] = unpack(args[i-1], typ.sons[i], call[i]) + dealloc args[i-1] + +proc callForeignFunction*(fn: PNode, fntyp: PType, + args: var TNodeSeq, start, len: int, + info: TLineInfo): PNode = + internalAssert fn.kind == nkPtrLit + + var cif: TCif + var sig: TParamList + for i in 0..len-1: + var aTyp = args[i+start].typ + if aTyp.isNil: + internalAssert i+1 < fntyp.len + aTyp = fntyp.sons[i+1] + args[i+start].typ = aTyp + sig[i] = mapType(aTyp) + if sig[i].isNil: globalError(info, "cannot map FFI type") + + if prep_cif(cif, mapCallConv(fntyp.callConv, info), cuint(len), + mapType(fntyp.sons[0]), sig) != OK: + globalError(info, "error in FFI call") + + var cargs: TArgList + let fn = cast[pointer](fn.intVal) + for i in 0 .. len-1: + let t = args[i+start].typ + cargs[i] = alloc0(packSize(args[i+start], t)) + pack(args[i+start], t, cargs[i]) + let retVal = if isEmptyType(fntyp.sons[0]): pointer(nil) + else: alloc(fntyp.sons[0].getSize.int) + + libffi.call(cif, fn, retVal, cargs) + + if retVal.isNil: + result = emptyNode + else: + result = unpack(retVal, fntyp.sons[0], nil) + result.info = info + + if retVal != nil: dealloc retVal + for i in 0 .. len-1: + let t = args[i+start].typ + args[i+start] = unpack(cargs[i], t, args[i+start]) + dealloc cargs[i] diff --git a/compiler/evaltempl.nim b/compiler/evaltempl.nim index c33e5be86..e136265da 100644 --- a/compiler/evaltempl.nim +++ b/compiler/evaltempl.nim @@ -38,7 +38,8 @@ proc evalTemplateAux(templ, actual: PNode, c: var TemplCtx, result: PNode) = if s.owner.id == c.owner.id: if s.kind == skParam and sfGenSym notin s.flags: handleParam actual.sons[s.position] - elif s.kind == skGenericParam: + elif s.kind == skGenericParam or + s.kind == skType and s.typ != nil and s.typ.kind == tyGenericParam: handleParam actual.sons[s.owner.typ.len + s.position - 1] else: internalAssert sfGenSym in s.flags @@ -58,7 +59,7 @@ proc evalTemplateAux(templ, actual: PNode, c: var TemplCtx, result: PNode) = evalTemplateAux(templ.sons[i], actual, c, res) result.add res -proc evalTemplateArgs(n: PNode, s: PSym): PNode = +proc evalTemplateArgs(n: PNode, s: PSym; fromHlo: bool): PNode = # if the template has zero arguments, it can be called without ``()`` # `n` is then a nkSym or something similar var totalParams = case n.kind @@ -66,7 +67,7 @@ proc evalTemplateArgs(n: PNode, s: PSym): PNode = else: 0 var - # XXX: Since immediate templates are not subjected to the + # XXX: Since immediate templates are not subject to the # standard sigmatching algorithm, they will have a number # of deficiencies when it comes to generic params: # Type dependencies between the parameters won't be honoured @@ -74,7 +75,7 @@ proc evalTemplateArgs(n: PNode, s: PSym): PNode = # their bodies. We could try to fix this, but it may be # wiser to just deprecate immediate templates and macros # now that we have working untyped parameters. - genericParams = if sfImmediate in s.flags: 0 + genericParams = if sfImmediate in s.flags or fromHlo: 0 else: s.ast[genericParamsPos].len expectedRegularParams = <s.typ.len givenRegularParams = totalParams - genericParams @@ -103,14 +104,14 @@ proc evalTemplateArgs(n: PNode, s: PSym): PNode = var evalTemplateCounter* = 0 # to prevent endless recursion in templates instantiation -proc evalTemplate*(n: PNode, tmpl, genSymOwner: PSym): PNode = +proc evalTemplate*(n: PNode, tmpl, genSymOwner: PSym; fromHlo=false): PNode = inc(evalTemplateCounter) if evalTemplateCounter > 100: globalError(n.info, errTemplateInstantiationTooNested) result = n # replace each param by the corresponding node: - var args = evalTemplateArgs(n, tmpl) + var args = evalTemplateArgs(n, tmpl, fromHlo) var ctx: TemplCtx ctx.owner = tmpl ctx.genSymOwner = genSymOwner @@ -126,9 +127,9 @@ proc evalTemplate*(n: PNode, tmpl, genSymOwner: PSym): PNode = renderTree(result, {renderNoComments})) else: result = copyNode(body) - ctx.instLines = body.kind notin {nkStmtList, nkStmtListExpr, - nkBlockStmt, nkBlockExpr} - if ctx.instLines: result.info = n.info + #ctx.instLines = body.kind notin {nkStmtList, nkStmtListExpr, + # nkBlockStmt, nkBlockExpr} + #if ctx.instLines: result.info = n.info for i in countup(0, safeLen(body) - 1): evalTemplateAux(body.sons[i], args, ctx, result) diff --git a/compiler/extccomp.nim b/compiler/extccomp.nim index 3882bdd03..b2ee9c7f1 100644 --- a/compiler/extccomp.nim +++ b/compiler/extccomp.nim @@ -16,6 +16,8 @@ import lists, ropes, os, strutils, osproc, platform, condsyms, options, msgs, securehash, streams +from debuginfo import writeDebugInfo + type TSystemCC* = enum ccNone, ccGcc, ccLLVM_Gcc, ccCLang, ccLcc, ccBcc, ccDmc, ccWcc, ccVcc, @@ -731,9 +733,13 @@ proc callCCompiler*(projectfile: string) = builddll = "" if options.outFile.len > 0: exefile = options.outFile.expandTilde + if not exefile.isAbsolute(): + exefile = getCurrentDir() / exefile if not noAbsolutePaths(): if not exefile.isAbsolute(): exefile = joinPath(splitFile(projectfile).dir, exefile) + if optCDebug in gGlobalOptions: + writeDebugInfo(exefile.changeFileExt("ndb")) exefile = quoteShell(exefile) let linkOptions = getLinkOptions() & " " & getConfigVar(cCompiler, ".options.linker") diff --git a/compiler/filter_tmpl.nim b/compiler/filter_tmpl.nim index 21810adb9..9e123e3a1 100644 --- a/compiler/filter_tmpl.nim +++ b/compiler/filter_tmpl.nim @@ -67,7 +67,7 @@ proc parseLine(p: var TTmplParser) = keyw: string j = 0 while p.x[j] == ' ': inc(j) - if p.x[0] == p.nimDirective and p.x[1] in {'?', '!'}: + if p.x[0] == p.nimDirective and p.x[1] == '?': newLine(p) elif p.x[j] == p.nimDirective: newLine(p) @@ -213,6 +213,9 @@ proc filterTmpl(stdin: PLLStream, filename: string, call: PNode): PLLStream = p.conc = strArg(call, "conc", 4, " & ") p.toStr = strArg(call, "tostring", 5, "$") p.x = newStringOfCap(120) + # do not process the first line which contains the directive: + if llStreamReadLine(p.inp, p.x): + p.info.line = p.info.line + int16(1) while llStreamReadLine(p.inp, p.x): p.info.line = p.info.line + int16(1) parseLine(p) diff --git a/compiler/hlo.nim b/compiler/hlo.nim index 6cc9567af..de0fa6216 100644 --- a/compiler/hlo.nim +++ b/compiler/hlo.nim @@ -24,7 +24,7 @@ proc evalPattern(c: PContext, n, orig: PNode): PNode = of skMacro: result = semMacroExpr(c, n, orig, s) of skTemplate: - result = semTemplateExpr(c, n, s) + result = semTemplateExpr(c, n, s, {efFromHlo}) else: result = semDirectOp(c, n, {}) if optHints in gOptions and hintPattern in gNotes: diff --git a/compiler/idgen.nim b/compiler/idgen.nim index c07782fb2..906c16546 100644 --- a/compiler/idgen.nim +++ b/compiler/idgen.nim @@ -44,7 +44,7 @@ proc toGid(f: string): string = # we used to use ``f.addFileExt("gid")`` (aka ``$project.gid``), but this # will cause strange bugs if multiple projects are in the same folder, so # we simply use a project independent name: - result = options.completeGeneratedFilePath("nimrod.gid") + result = options.completeGeneratedFilePath("nim.gid") proc saveMaxIds*(project: string) = var f = open(project.toGid, fmWrite) diff --git a/compiler/importer.nim b/compiler/importer.nim index c121059fd..86993358b 100644 --- a/compiler/importer.nim +++ b/compiler/importer.nim @@ -163,6 +163,7 @@ proc myImportModule(c: PContext, n: PNode): PSym = localError(n.info, errGenerated, "A module cannot import itself") if sfDeprecated in result.flags: message(n.info, warnDeprecated, result.name.s) + #suggestSym(n.info, result, false) proc evalImport(c: PContext, n: PNode): PNode = result = n diff --git a/compiler/installer.ini b/compiler/installer.ini index 729c13503..12d9baf82 100644 --- a/compiler/installer.ini +++ b/compiler/installer.ini @@ -62,7 +62,7 @@ Files: "icons/koch_icon.o" Files: "compiler/readme.txt" Files: "compiler/installer.ini" -Files: "compiler/nim.nim.cfg" +Files: "compiler/*.cfg" Files: "compiler/*.nim" Files: "doc/*.txt" Files: "doc/manual/*.txt" @@ -73,7 +73,7 @@ Files: "compiler/nimfix/*.cfg" Files: "compiler/nimsuggest/*.nim" Files: "compiler/nimsuggest/*.cfg" Files: "compiler/plugins/locals/*.nim" -Files: "compiler/plugins/active.nim" +Files: "compiler/plugins/*.nim" Files: "tools/*.nim" Files: "tools/*.cfg" Files: "tools/*.tmpl" @@ -84,11 +84,14 @@ Files: "tools/niminst/*.nsh" Files: "web/website.ini" Files: "web/*.nim" Files: "web/*.txt" +Files: "bin/nimblepkg/*.nim" +Files: "bin/nimblepkg/*.cfg" [Lib] Files: "lib/nimbase.h" Files: "lib/*.nim" Files: "lib/*.cfg" +Files: "lib/*.nimble" Files: "lib/system/*.nim" Files: "lib/core/*.nim" @@ -101,14 +104,12 @@ Files: "lib/pure/concurrency/*.cfg" Files: "lib/impure/*.nim" Files: "lib/impure/nre/private/*.nim" Files: "lib/wrappers/*.nim" +Files: "lib/arch/*.nim" Files: "lib/wrappers/readline/*.nim" Files: "lib/wrappers/linenoise/*.nim" Files: "lib/wrappers/linenoise/*.c" Files: "lib/wrappers/linenoise/*.h" -Files: "lib/wrappers/sdl/*.nim" -Files: "lib/wrappers/zip/*.nim" -Files: "lib/wrappers/zip/libzip_all.c" Files: "lib/windows/*.nim" Files: "lib/posix/*.nim" @@ -247,6 +248,7 @@ BinPath: r"bin;dist\mingw\bin;dist" ; Section | dir | zipFile | size hint (in KB) | url | exe start menu entry Download: r"Documentation|doc|docs.zip|13824|http://nim-lang.org/download/docs-${version}.zip|overview.html" Download: r"C Compiler (MingW)|dist|mingw.zip|82944|http://nim-lang.org/download/${mingw}.zip" +Download: r"Support DLL's|bin|nim_dlls.zip|479|http://nim-lang.org/download/dlls.zip" Download: r"Aporia IDE|dist|aporia.zip|97997|http://nim-lang.org/download/aporia-0.3.0.zip|aporia-0.3.0\bin\aporia.exe" ; for now only NSIS supports optional downloads diff --git a/compiler/jsgen.nim b/compiler/jsgen.nim index 36caf5e3e..124459306 100644 --- a/compiler/jsgen.nim +++ b/compiler/jsgen.nim @@ -8,7 +8,7 @@ # # This is the JavaScript code generator. -# Soon also a Luajit code generator. ;-) +# Soon also a PHP code generator. ;-) discard """ The JS code generator contains only 2 tricks: @@ -37,9 +37,10 @@ import type TTarget = enum - targetJS, targetLua + targetJS, targetPHP TJSGen = object of TPassContext module: PSym + target: TTarget BModule = ref TJSGen TJSTypeKind = enum # necessary JS "types" @@ -55,7 +56,8 @@ type TResKind = enum resNone, # not set resExpr, # is some complex expression - resVal # is a temporary/value/l-value + resVal, # is a temporary/value/l-value + resCallee # expression is callee TCompRes = object kind: TResKind typ: TJSTypeKind @@ -69,17 +71,19 @@ type isLoop: bool # whether it's a 'block' or 'while' TGlobals = object - typeInfo, code: Rope + typeInfo, constants, code: Rope forwarded: seq[PSym] generatedSyms: IntSet typeInfoGenerated: IntSet + classes: seq[(PType, Rope)] + unique: int # for temp identifier generation PGlobals = ref TGlobals PProc = ref TProc TProc = object procDef: PNode prc: PSym - locals, body: Rope + globals, locals, body: Rope options: TOptions module: BModule g: PGlobals @@ -88,6 +92,7 @@ type unique: int # for temp identifier generation blocks: seq[TBlock] up: PProc # up the call chain; required for closure support + declaredGlobals: IntSet template `|`(a, b: expr): expr {.immediate, dirty.} = (if p.target == targetJS: a else: b) @@ -97,6 +102,7 @@ proc newGlobals(): PGlobals = result.forwarded = @[] result.generatedSyms = initIntSet() result.typeInfoGenerated = initIntSet() + result.classes = @[] proc initCompRes(r: var TCompRes) = r.address = nil @@ -119,8 +125,15 @@ proc newProc(globals: PGlobals, module: BModule, procDef: PNode, options: options, module: module, procDef: procDef, - g: globals) + g: globals, + target: module.target) if procDef != nil: result.prc = procDef.sons[namePos].sym + if result.target == targetPHP: + result.declaredGlobals = initIntSet() + +proc declareGlobal(p: PProc; id: int; r: Rope) = + if p.prc != nil and not p.declaredGlobals.containsOrIncl(id): + p.locals.addf("global $1;$n", [r]) const MappedToObject = {tyObject, tyArray, tyArrayConstr, tyTuple, tyOpenArray, @@ -155,16 +168,60 @@ proc mapType(typ: PType): TJSTypeKind = of tyProc: result = etyProc of tyCString: result = etyString -proc mangleName(s: PSym): Rope = +proc mapType(p: PProc; typ: PType): TJSTypeKind = + if p.target == targetPHP: result = etyObject + else: result = mapType(typ) + +proc mangleName(s: PSym; target: TTarget): Rope = result = s.loc.r if result == nil: - result = rope(mangle(s.name.s)) - add(result, "_") - add(result, rope(s.id)) + if target == targetJS or s.kind == skTemp: + result = rope(mangle(s.name.s)) + else: + var x = newStringOfCap(s.name.s.len) + var i = 0 + while i < s.name.s.len: + let c = s.name.s[i] + case c + of 'A'..'Z': + if i > 0 and s.name.s[i-1] in {'a'..'z'}: + x.add '_' + x.add(chr(c.ord - 'A'.ord + 'a'.ord)) + of 'a'..'z', '_', '0'..'9': + x.add c + else: + x.add("HEX" & toHex(ord(c), 2)) + inc i + result = rope(x) + if s.name.s != "this" and s.kind != skField: + add(result, "_") + add(result, rope(s.id)) s.loc.r = result -proc makeJSString(s: string): Rope = - (if s.isNil: "null".rope else: strutils.escape(s).rope) +proc escapeJSString(s: string): string = + result = newStringOfCap(s.len + s.len shr 2) + result.add("\"") + for c in items(s): + case c + of '\l': result.add("\\n") + of '\r': result.add("\\r") + of '\t': result.add("\\t") + of '\b': result.add("\\b") + of '\a': result.add("\\a") + of '\e': result.add("\\e") + of '\v': result.add("\\v") + of '\\': result.add("\\\\") + of '\"': result.add("\\\"") + else: add(result, c) + result.add("\"") + +proc makeJSString(s: string, escapeNonAscii = true): Rope = + if s.isNil: + result = "null".rope + elif escapeNonAscii: + result = strutils.escape(s).rope + else: + result = escapeJSString(s).rope include jstypes @@ -179,7 +236,8 @@ proc useMagic(p: PProc, name: string) = if s != nil: internalAssert s.kind in {skProc, skMethod, skConverter} if not p.g.generatedSyms.containsOrIncl(s.id): - add(p.g.code, genProc(p, s)) + let code = genProc(p, s) + add(p.g.constants, code) else: # we used to exclude the system module from this check, but for DLL # generation support this sloppyness leads to hard to detect bugs, so @@ -187,29 +245,33 @@ proc useMagic(p: PProc, name: string) = if p.prc != nil: globalError(p.prc.info, errSystemNeeds, name) else: rawMessage(errSystemNeeds, name) -proc isSimpleExpr(n: PNode): bool = +proc isSimpleExpr(p: PProc; n: PNode): bool = # calls all the way down --> can stay expression based - if n.kind in nkCallKinds+{nkBracketExpr, nkBracket, nkCurly, nkDotExpr, nkPar, - nkObjConstr}: + if n.kind in nkCallKinds+{nkBracketExpr, nkDotExpr, nkPar} or + (p.target == targetJS and n.kind in {nkObjConstr, nkBracket, nkCurly}): for c in n: - if not c.isSimpleExpr: return false + if not p.isSimpleExpr(c): return false result = true elif n.isAtom: result = true -proc getTemp(p: PProc): Rope = +proc getTemp(p: PProc, defineInLocals: bool = true): Rope = inc(p.unique) - result = "Tmp$1" % [rope(p.unique)] - addf(p.locals, "var $1;$n" | "local $1;$n", [result]) + if p.target == targetJS: + result = "Tmp$1" % [rope(p.unique)] + if defineInLocals: + addf(p.locals, "var $1;$n", [result]) + else: + result = "$$Tmp$1" % [rope(p.unique)] proc genAnd(p: PProc, a, b: PNode, r: var TCompRes) = assert r.kind == resNone var x, y: TCompRes - if a.isSimpleExpr and b.isSimpleExpr: + if p.isSimpleExpr(a) and p.isSimpleExpr(b): gen(p, a, x) gen(p, b, y) r.kind = resExpr - r.res = ("($1 && $2)" | "($1 and $2)") % [x.rdLoc, y.rdLoc] + r.res = "($1 && $2)" % [x.rdLoc, y.rdLoc] else: r.res = p.getTemp r.kind = resVal @@ -223,29 +285,25 @@ proc genAnd(p: PProc, a, b: PNode, r: var TCompRes) = # tmp = b # tmp gen(p, a, x) - p.body.addf("if (!$1) $2 = false; else {" | - "if not $1 then $2 = false; else", [x.rdLoc, r.rdLoc]) + p.body.addf("if (!$1) $2 = false; else {", [x.rdLoc, r.rdLoc]) gen(p, b, y) - p.body.addf("$2 = $1; }" | - "$2 = $1 end", [y.rdLoc, r.rdLoc]) + p.body.addf("$2 = $1; }", [y.rdLoc, r.rdLoc]) proc genOr(p: PProc, a, b: PNode, r: var TCompRes) = assert r.kind == resNone var x, y: TCompRes - if a.isSimpleExpr and b.isSimpleExpr: + if p.isSimpleExpr(a) and p.isSimpleExpr(b): gen(p, a, x) gen(p, b, y) r.kind = resExpr - r.res = ("($1 || $2)" | "($1 or $2)") % [x.rdLoc, y.rdLoc] + r.res = "($1 || $2)" % [x.rdLoc, y.rdLoc] else: r.res = p.getTemp r.kind = resVal gen(p, a, x) - p.body.addf("if ($1) $2 = true; else {" | - "if $1 then $2 = true; else", [x.rdLoc, r.rdLoc]) + p.body.addf("if ($1) $2 = true; else {", [x.rdLoc, r.rdLoc]) gen(p, b, y) - p.body.addf("$2 = $1; }" | - "$2 = $1 end", [y.rdLoc, r.rdLoc]) + p.body.addf("$2 = $1; }", [y.rdLoc, r.rdLoc]) type TMagicFrmt = array[0..3, string] @@ -264,7 +322,7 @@ const # magic checked op; magic unchecked op; checked op; unchecked op ["", "", "($1 - $2)", "($1 - $2)"], # SubF64 ["", "", "($1 * $2)", "($1 * $2)"], # MulF64 ["", "", "($1 / $2)", "($1 / $2)"], # DivF64 - ["", "", "($1 >>> $2)", "($1 >>> $2)"], # ShrI + ["", "", "", ""], # ShrI ["", "", "($1 << $2)", "($1 << $2)"], # ShlI ["", "", "($1 & $2)", "($1 & $2)"], # BitandI ["", "", "($1 | $2)", "($1 | $2)"], # BitorI @@ -273,21 +331,21 @@ const # magic checked op; magic unchecked op; checked op; unchecked op ["nimMax", "nimMax", "nimMax($1, $2)", "nimMax($1, $2)"], # MaxI ["nimMin", "nimMin", "nimMin($1, $2)", "nimMin($1, $2)"], # MinF64 ["nimMax", "nimMax", "nimMax($1, $2)", "nimMax($1, $2)"], # MaxF64 - ["addU", "addU", "addU($1, $2)", "addU($1, $2)"], # addU - ["subU", "subU", "subU($1, $2)", "subU($1, $2)"], # subU - ["mulU", "mulU", "mulU($1, $2)", "mulU($1, $2)"], # mulU - ["divU", "divU", "divU($1, $2)", "divU($1, $2)"], # divU - ["modU", "modU", "modU($1, $2)", "modU($1, $2)"], # modU + ["", "", "", ""], # addU + ["", "", "", ""], # subU + ["", "", "", ""], # mulU + ["", "", "", ""], # divU + ["", "", "($1 % $2)", "($1 % $2)"], # modU ["", "", "($1 == $2)", "($1 == $2)"], # EqI ["", "", "($1 <= $2)", "($1 <= $2)"], # LeI ["", "", "($1 < $2)", "($1 < $2)"], # LtI ["", "", "($1 == $2)", "($1 == $2)"], # EqF64 ["", "", "($1 <= $2)", "($1 <= $2)"], # LeF64 ["", "", "($1 < $2)", "($1 < $2)"], # LtF64 - ["leU", "leU", "leU($1, $2)", "leU($1, $2)"], # leU - ["ltU", "ltU", "ltU($1, $2)", "ltU($1, $2)"], # ltU - ["leU64", "leU64", "leU64($1, $2)", "leU64($1, $2)"], # leU64 - ["ltU64", "ltU64", "ltU64($1, $2)", "ltU64($1, $2)"], # ltU64 + ["", "", "($1 <= $2)", "($1 <= $2)"], # leU + ["", "", "($1 < $2)", "($1 < $2)"], # ltU + ["", "", "($1 <= $2)", "($1 <= $2)"], # leU64 + ["", "", "($1 < $2)", "($1 < $2)"], # ltU64 ["", "", "($1 == $2)", "($1 == $2)"], # EqEnum ["", "", "($1 <= $2)", "($1 <= $2)"], # LeEnum ["", "", "($1 < $2)", "($1 < $2)"], # LtEnum @@ -336,90 +394,6 @@ const # magic checked op; magic unchecked op; checked op; unchecked op ["cstrToNimstr", "cstrToNimstr", "cstrToNimstr($1)", "cstrToNimstr($1)"], ["", "", "$1", "$1"]] - luaOps: TMagicOps = [ - ["addInt", "", "addInt($1, $2)", "($1 + $2)"], # AddI - ["subInt", "", "subInt($1, $2)", "($1 - $2)"], # SubI - ["mulInt", "", "mulInt($1, $2)", "($1 * $2)"], # MulI - ["divInt", "", "divInt($1, $2)", "Math.floor($1 / $2)"], # DivI - ["modInt", "", "modInt($1, $2)", "Math.floor($1 % $2)"], # ModI - ["addInt", "", "addInt($1, $2)", "($1 + $2)"], # Succ - ["subInt", "", "subInt($1, $2)", "($1 - $2)"], # Pred - ["", "", "($1 + $2)", "($1 + $2)"], # AddF64 - ["", "", "($1 - $2)", "($1 - $2)"], # SubF64 - ["", "", "($1 * $2)", "($1 * $2)"], # MulF64 - ["", "", "($1 / $2)", "($1 / $2)"], # DivF64 - ["", "", "($1 >>> $2)", "($1 >>> $2)"], # ShrI - ["", "", "($1 << $2)", "($1 << $2)"], # ShlI - ["", "", "($1 & $2)", "($1 & $2)"], # BitandI - ["", "", "($1 | $2)", "($1 | $2)"], # BitorI - ["", "", "($1 ^ $2)", "($1 ^ $2)"], # BitxorI - ["nimMin", "nimMin", "nimMin($1, $2)", "nimMin($1, $2)"], # MinI - ["nimMax", "nimMax", "nimMax($1, $2)", "nimMax($1, $2)"], # MaxI - ["nimMin", "nimMin", "nimMin($1, $2)", "nimMin($1, $2)"], # MinF64 - ["nimMax", "nimMax", "nimMax($1, $2)", "nimMax($1, $2)"], # MaxF64 - ["addU", "addU", "addU($1, $2)", "addU($1, $2)"], # addU - ["subU", "subU", "subU($1, $2)", "subU($1, $2)"], # subU - ["mulU", "mulU", "mulU($1, $2)", "mulU($1, $2)"], # mulU - ["divU", "divU", "divU($1, $2)", "divU($1, $2)"], # divU - ["modU", "modU", "modU($1, $2)", "modU($1, $2)"], # modU - ["", "", "($1 == $2)", "($1 == $2)"], # EqI - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeI - ["", "", "($1 < $2)", "($1 < $2)"], # LtI - ["", "", "($1 == $2)", "($1 == $2)"], # EqF64 - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeF64 - ["", "", "($1 < $2)", "($1 < $2)"], # LtF64 - ["leU", "leU", "leU($1, $2)", "leU($1, $2)"], # leU - ["ltU", "ltU", "ltU($1, $2)", "ltU($1, $2)"], # ltU - ["leU64", "leU64", "leU64($1, $2)", "leU64($1, $2)"], # leU64 - ["ltU64", "ltU64", "ltU64($1, $2)", "ltU64($1, $2)"], # ltU64 - ["", "", "($1 == $2)", "($1 == $2)"], # EqEnum - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeEnum - ["", "", "($1 < $2)", "($1 < $2)"], # LtEnum - ["", "", "($1 == $2)", "($1 == $2)"], # EqCh - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeCh - ["", "", "($1 < $2)", "($1 < $2)"], # LtCh - ["", "", "($1 == $2)", "($1 == $2)"], # EqB - ["", "", "($1 <= $2)", "($1 <= $2)"], # LeB - ["", "", "($1 < $2)", "($1 < $2)"], # LtB - ["", "", "($1 == $2)", "($1 == $2)"], # EqRef - ["", "", "($1 == $2)", "($1 == $2)"], # EqUntracedRef - ["", "", "($1 <= $2)", "($1 <= $2)"], # LePtr - ["", "", "($1 < $2)", "($1 < $2)"], # LtPtr - ["", "", "($1 == $2)", "($1 == $2)"], # EqCString - ["", "", "($1 != $2)", "($1 != $2)"], # Xor - ["", "", "($1 == $2)", "($1 == $2)"], # EqProc - ["negInt", "", "negInt($1)", "-($1)"], # UnaryMinusI - ["negInt64", "", "negInt64($1)", "-($1)"], # UnaryMinusI64 - ["absInt", "", "absInt($1)", "Math.abs($1)"], # AbsI - ["", "", "not ($1)", "not ($1)"], # Not - ["", "", "+($1)", "+($1)"], # UnaryPlusI - ["", "", "~($1)", "~($1)"], # BitnotI - ["", "", "+($1)", "+($1)"], # UnaryPlusF64 - ["", "", "-($1)", "-($1)"], # UnaryMinusF64 - ["", "", "Math.abs($1)", "Math.abs($1)"], # AbsF64 - ["Ze8ToI", "Ze8ToI", "Ze8ToI($1)", "Ze8ToI($1)"], # mZe8ToI - ["Ze8ToI64", "Ze8ToI64", "Ze8ToI64($1)", "Ze8ToI64($1)"], # mZe8ToI64 - ["Ze16ToI", "Ze16ToI", "Ze16ToI($1)", "Ze16ToI($1)"], # mZe16ToI - ["Ze16ToI64", "Ze16ToI64", "Ze16ToI64($1)", "Ze16ToI64($1)"], # mZe16ToI64 - ["Ze32ToI64", "Ze32ToI64", "Ze32ToI64($1)", "Ze32ToI64($1)"], # mZe32ToI64 - ["ZeIToI64", "ZeIToI64", "ZeIToI64($1)", "ZeIToI64($1)"], # mZeIToI64 - ["toU8", "toU8", "toU8($1)", "toU8($1)"], # toU8 - ["toU16", "toU16", "toU16($1)", "toU16($1)"], # toU16 - ["toU32", "toU32", "toU32($1)", "toU32($1)"], # toU32 - ["", "", "$1", "$1"], # ToFloat - ["", "", "$1", "$1"], # ToBiggestFloat - ["", "", "Math.floor($1)", "Math.floor($1)"], # ToInt - ["", "", "Math.floor($1)", "Math.floor($1)"], # ToBiggestInt - ["nimCharToStr", "nimCharToStr", "nimCharToStr($1)", "nimCharToStr($1)"], - ["nimBoolToStr", "nimBoolToStr", "nimBoolToStr($1)", "nimBoolToStr($1)"], [ - "cstrToNimstr", "cstrToNimstr", "cstrToNimstr(($1)+\"\")", - "cstrToNimstr(($1)+\"\")"], ["cstrToNimstr", "cstrToNimstr", - "cstrToNimstr(($1)+\"\")", - "cstrToNimstr(($1)+\"\")"], ["cstrToNimstr", - "cstrToNimstr", "cstrToNimstr(($1)+\"\")", "cstrToNimstr(($1)+\"\")"], - ["cstrToNimstr", "cstrToNimstr", "cstrToNimstr($1)", "cstrToNimstr($1)"], - ["", "", "$1", "$1"]] - proc binaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string) = var x, y: TCompRes useMagic(p, magic) @@ -428,6 +402,33 @@ proc binaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string) = r.res = frmt % [x.rdLoc, y.rdLoc] r.kind = resExpr +proc unsignedTrimmerJS(size: BiggestInt): Rope = + case size + of 1: rope"& 0xff" + of 2: rope"& 0xffff" + of 4: rope">>> 0" + else: rope"" + +proc unsignedTrimmerPHP(size: BiggestInt): Rope = + case size + of 1: rope"& 0xff" + of 2: rope"& 0xffff" + of 4: rope"& 0xffffffff" + else: rope"" + +template unsignedTrimmer(size: BiggestInt): Rope = + size.unsignedTrimmerJS | size.unsignedTrimmerPHP + +proc binaryUintExpr(p: PProc, n: PNode, r: var TCompRes, op: string, reassign: bool = false) = + var x, y: TCompRes + gen(p, n.sons[1], x) + gen(p, n.sons[2], y) + let trimmer = unsignedTrimmer(n[1].typ.skipTypes(abstractRange).size) + if reassign: + r.res = "$1 = (($1 $2 $3) $4)" % [x.rdLoc, rope op, y.rdLoc, trimmer] + else: + r.res = "(($1 $2 $3) $4)" % [x.rdLoc, rope op, y.rdLoc, trimmer] + proc ternaryExpr(p: PProc, n: PNode, r: var TCompRes, magic, frmt: string) = var x, y, z: TCompRes useMagic(p, magic) @@ -455,15 +456,62 @@ proc arithAux(p: PProc, n: PNode, r: var TCompRes, op: TMagic, ops: TMagicOps) = else: gen(p, n.sons[1], r) r.res = ops[op][i + 2] % [r.rdLoc] - r.kind = resExpr proc arith(p: PProc, n: PNode, r: var TCompRes, op: TMagic) = - arithAux(p, n, r, op, jsOps | luaOps) + case op + of mAddU: binaryUintExpr(p, n, r, "+") + of mSubU: binaryUintExpr(p, n, r, "-") + of mMulU: binaryUintExpr(p, n, r, "*") + of mDivU: binaryUintExpr(p, n, r, "/") + of mDivI: + if p.target == targetPHP: + var x, y: TCompRes + gen(p, n.sons[1], x) + gen(p, n.sons[2], y) + r.res = "intval($1 / $2)" % [x.rdLoc, y.rdLoc] + else: + arithAux(p, n, r, op, jsOps) + of mModI: + if p.target == targetPHP: + var x, y: TCompRes + gen(p, n.sons[1], x) + gen(p, n.sons[2], y) + r.res = "($1 % $2)" % [x.rdLoc, y.rdLoc] + else: + arithAux(p, n, r, op, jsOps) + of mShrI: + var x, y: TCompRes + gen(p, n.sons[1], x) + gen(p, n.sons[2], y) + let trimmer = unsignedTrimmer(n[1].typ.skipTypes(abstractRange).size) + if p.target == targetPHP: + # XXX prevent multi evaluations + r.res = "(($1 $2) >= 0) ? (($1 $2) >> $3) : ((($1 $2) & 0x7fffffff) >> $3) | (0x40000000 >> ($3 - 1))" % [x.rdLoc, trimmer, y.rdLoc] + else: + r.res = "(($1 $2) >>> $3)" % [x.rdLoc, trimmer, y.rdLoc] + of mCharToStr, mBoolToStr, mIntToStr, mInt64ToStr, mFloatToStr, + mCStrToStr, mStrToStr, mEnumToStr: + if p.target == targetPHP: + if op == mEnumToStr: + var x: TCompRes + gen(p, n.sons[1], x) + r.res = "$#[$#]" % [genEnumInfoPHP(p, n.sons[1].typ), x.rdLoc] + elif op == mCharToStr: + var x: TCompRes + gen(p, n.sons[1], x) + r.res = "chr($#)" % [x.rdLoc] + else: + gen(p, n.sons[1], r) + else: + arithAux(p, n, r, op, jsOps) + else: + arithAux(p, n, r, op, jsOps) + r.kind = resExpr proc genLineDir(p: PProc, n: PNode) = let line = toLinenumber(n.info) if optLineDir in p.options: - addf(p.body, "// line $2 \"$1\"$n" | "-- line $2 \"$1\"$n", + addf(p.body, "// line $2 \"$1\"$n", [rope(toFilename(n.info)), rope(line)]) if {optStackTrace, optEndb} * p.options == {optStackTrace, optEndb} and ((p.prc == nil) or sfPure notin p.prc.flags): @@ -472,7 +520,7 @@ proc genLineDir(p: PProc, n: PNode) = elif ({optLineTrace, optStackTrace} * p.options == {optLineTrace, optStackTrace}) and ((p.prc == nil) or not (sfPure in p.prc.flags)): - addf(p.body, "F.line = $1;$n", [rope(line)]) + addf(p.body, "F.line = $1;$n" | "$$F['line'] = $1;$n", [rope(line)]) proc genWhileStmt(p: PProc, n: PNode) = var @@ -485,12 +533,12 @@ proc genWhileStmt(p: PProc, n: PNode) = p.blocks[length].id = -p.unique p.blocks[length].isLoop = true let labl = p.unique.rope - addf(p.body, "L$1: while (true) {$n" | "while true do$n", [labl]) + addf(p.body, "L$1: while (true) {$n" | "while (true) {$n", [labl]) gen(p, n.sons[0], cond) - addf(p.body, "if (!$1) break L$2;$n" | "if not $1 then goto ::L$2:: end;$n", + addf(p.body, "if (!$1) break L$2;$n" | "if (!$1) goto L$2;$n", [cond.res, labl]) genStmt(p, n.sons[1]) - addf(p.body, "}$n" | "end ::L$#::$n", [labl]) + addf(p.body, "}$n" | "}L$#:;$n", [labl]) setLen(p.blocks, length) proc moveInto(p: PProc, src: var TCompRes, dest: TCompRes) = @@ -530,64 +578,65 @@ proc genTry(p: PProc, n: PNode, r: var TCompRes) = var i = 1 var length = sonsLen(n) var catchBranchesExist = length > 1 and n.sons[i].kind == nkExceptBranch - if catchBranchesExist: + if catchBranchesExist and p.target == targetJS: add(p.body, "++excHandler;" & tnl) var safePoint = "Tmp$1" % [rope(p.unique)] - addf(p.body, - "" | - "local $1 = pcall(", - [safePoint]) if optStackTrace in p.options: add(p.body, "framePtr = F;" & tnl) - addf(p.body, "try {$n" | "function()$n", []) + addf(p.body, "try {$n", []) + if p.target == targetPHP and p.globals == nil: + p.globals = "global $lastJSError; global $prevJSError;".rope var a: TCompRes gen(p, n.sons[0], a) moveInto(p, a, r) var generalCatchBranchExists = false + let dollar = rope(if p.target == targetJS: "" else: "$") if p.target == targetJS and catchBranchesExist: addf(p.body, "} catch (EXC) {$n var prevJSError = lastJSError;$n" & " lastJSError = EXC;$n --excHandler;$n", []) - elif p.target == targetLua: - addf(p.body, "end)$n", []) + elif p.target == targetPHP: + addf(p.body, "} catch (Exception $$EXC) {$n $$prevJSError = $$lastJSError;$n $$lastJSError = $$EXC;$n", []) while i < length and n.sons[i].kind == nkExceptBranch: let blen = sonsLen(n.sons[i]) if blen == 1: # general except section: generalCatchBranchExists = true - if i > 1: addf(p.body, "else {$n" | "else$n", []) + if i > 1: addf(p.body, "else {$n", []) gen(p, n.sons[i].sons[0], a) moveInto(p, a, r) - if i > 1: addf(p.body, "}$n" | "end$n", []) + if i > 1: addf(p.body, "}$n", []) else: var orExpr: Rope = nil useMagic(p, "isObj") for j in countup(0, blen - 2): if n.sons[i].sons[j].kind != nkType: internalError(n.info, "genTryStmt") - if orExpr != nil: add(orExpr, "||" | " or ") - addf(orExpr, "isObj(lastJSError.m_type, $1)", - [genTypeInfo(p, n.sons[i].sons[j].typ)]) + if orExpr != nil: add(orExpr, "||") + addf(orExpr, "isObj($2lastJSError.m_type, $1)", + [genTypeInfo(p, n.sons[i].sons[j].typ), dollar]) if i > 1: add(p.body, "else ") - addf(p.body, "if (lastJSError && ($2)) {$n" | "if $1.exc and ($2) then$n", - [safePoint, orExpr]) + addf(p.body, "if ($3lastJSError && ($2)) {$n", + [safePoint, orExpr, dollar]) gen(p, n.sons[i].sons[blen - 1], a) moveInto(p, a, r) - addf(p.body, "}$n" | "end$n", []) + addf(p.body, "}$n", []) inc(i) + if catchBranchesExist: + if not generalCatchBranchExists: + useMagic(p, "reraiseException") + add(p.body, "else {" & tnl & "reraiseException();" & tnl & "}" & tnl) + addf(p.body, "$1lastJSError = $1prevJSError;$n", [dollar]) if p.target == targetJS: - if catchBranchesExist: - if not generalCatchBranchExists: - useMagic(p, "reraiseException") - add(p.body, "else {" & tnl & "reraiseException();" & tnl & "}" & tnl) - add(p.body, "lastJSError = prevJSError;" & tnl) add(p.body, "} finally {" & tnl) + if p.target == targetPHP: + # XXX ugly hack for PHP codegen + add(p.body, "}" & tnl) if i < length and n.sons[i].kind == nkFinally: genStmt(p, n.sons[i].sons[0]) + if p.target == targetPHP: + # XXX ugly hack for PHP codegen + add(p.body, "if($lastJSError) throw($lastJSError);" & tnl) if p.target == targetJS: add(p.body, "}" & tnl) - if p.target == targetLua: - # we need to repeat the finally block for Lua ... - if i < length and n.sons[i].kind == nkFinally: - genStmt(p, n.sons[i].sons[0]) proc genRaiseStmt(p: PProc, n: PNode) = genLineDir(p, n) @@ -608,7 +657,7 @@ proc genCaseJS(p: PProc, n: PNode, r: var TCompRes) = genLineDir(p, n) gen(p, n.sons[0], cond) let stringSwitch = skipTypes(n.sons[0].typ, abstractVar).kind == tyString - if stringSwitch: + if stringSwitch and p.target == targetJS: useMagic(p, "toJSStr") addf(p.body, "switch (toJSStr($1)) {$n", [cond.rdLoc]) else: @@ -632,7 +681,7 @@ proc genCaseJS(p: PProc, n: PNode, r: var TCompRes) = if stringSwitch: case e.kind of nkStrLit..nkTripleStrLit: addf(p.body, "case $1: ", - [makeJSString(e.strVal)]) + [makeJSString(e.strVal, false)]) else: internalError(e.info, "jsgen.genCaseStmt: 2") else: gen(p, e, cond) @@ -648,52 +697,6 @@ proc genCaseJS(p: PProc, n: PNode, r: var TCompRes) = else: internalError(it.info, "jsgen.genCaseStmt") addf(p.body, "}$n", []) -proc genCaseLua(p: PProc, n: PNode, r: var TCompRes) = - var - cond, stmt: TCompRes - genLineDir(p, n) - gen(p, n.sons[0], cond) - let stringSwitch = skipTypes(n.sons[0].typ, abstractVar).kind == tyString - if stringSwitch: - useMagic(p, "eqStr") - let tmp = getTemp(p) - addf(p.body, "$1 = $2;$n", [tmp, cond.rdLoc]) - if not isEmptyType(n.typ): - r.kind = resVal - r.res = getTemp(p) - for i in countup(1, sonsLen(n) - 1): - let it = n.sons[i] - case it.kind - of nkOfBranch: - if i != 1: addf(p.body, "$nelsif ", []) - else: addf(p.body, "if ", []) - for j in countup(0, sonsLen(it) - 2): - if j != 0: add(p.body, " or ") - let e = it.sons[j] - if e.kind == nkRange: - var ia, ib: TCompRes - gen(p, e.sons[0], ia) - gen(p, e.sons[1], ib) - addf(p.body, "$1 >= $2 and $1 <= $3", [tmp, ia.rdLoc, ib.rdLoc]) - else: - if stringSwitch: - case e.kind - of nkStrLit..nkTripleStrLit: addf(p.body, "eqStr($1, $2)", - [tmp, makeJSString(e.strVal)]) - else: internalError(e.info, "jsgen.genCaseStmt: 2") - else: - gen(p, e, cond) - addf(p.body, "$1 == $2", [tmp, cond.rdLoc]) - addf(p.body, " then$n", []) - gen(p, lastSon(it), stmt) - moveInto(p, stmt, r) - of nkElse: - addf(p.body, "else$n", []) - gen(p, it.sons[0], stmt) - moveInto(p, stmt, r) - else: internalError(it.info, "jsgen.genCaseStmt") - addf(p.body, "$nend$n", []) - proc genBlock(p: PProc, n: PNode, r: var TCompRes) = inc(p.unique) let idx = len(p.blocks) @@ -708,7 +711,7 @@ proc genBlock(p: PProc, n: PNode, r: var TCompRes) = let labl = p.unique addf(p.body, "L$1: do {$n" | "", [labl.rope]) gen(p, n.sons[1], r) - addf(p.body, "} while(false);$n" | "$n::L$#::$n", [labl.rope]) + addf(p.body, "} while(false);$n" | "$nL$#:;$n", [labl.rope]) setLen(p.blocks, idx) proc genBreakStmt(p: PProc, n: PNode) = @@ -727,14 +730,18 @@ proc genBreakStmt(p: PProc, n: PNode) = if idx < 0 or not p.blocks[idx].isLoop: internalError(n.info, "no loop to break") p.blocks[idx].id = abs(p.blocks[idx].id) # label is used - addf(p.body, "break L$1;$n" | "goto ::L$1::;$n", [rope(p.blocks[idx].id)]) + addf(p.body, "break L$1;$n" | "goto L$1;$n", [rope(p.blocks[idx].id)]) proc genAsmOrEmitStmt(p: PProc, n: PNode) = genLineDir(p, n) for i in countup(0, sonsLen(n) - 1): case n.sons[i].kind of nkStrLit..nkTripleStrLit: add(p.body, n.sons[i].strVal) - of nkSym: add(p.body, mangleName(n.sons[i].sym)) + of nkSym: + let v = n.sons[i].sym + if p.target == targetPHP and v.kind in {skVar, skLet, skTemp, skConst, skResult, skParam, skForVar}: + add(p.body, "$") + add(p.body, mangleName(v, p.target)) else: internalError(n.sons[i].info, "jsgen: genAsmOrEmitStmt()") proc genIf(p: PProc, n: PNode, r: var TCompRes) = @@ -747,21 +754,18 @@ proc genIf(p: PProc, n: PNode, r: var TCompRes) = let it = n.sons[i] if sonsLen(it) != 1: if i > 0: - addf(p.body, "else {$n" | "else$n", []) + addf(p.body, "else {$n", []) inc(toClose) gen(p, it.sons[0], cond) - addf(p.body, "if ($1) {$n" | "if $# then$n", [cond.rdLoc]) + addf(p.body, "if ($1) {$n", [cond.rdLoc]) gen(p, it.sons[1], stmt) else: # else part: - addf(p.body, "else {$n" | "else$n", []) + addf(p.body, "else {$n", []) gen(p, it.sons[0], stmt) moveInto(p, stmt, r) - addf(p.body, "}$n" | "end$n", []) - if p.target == targetJS: - add(p.body, repeat('}', toClose) & tnl) - else: - for i in 1..toClose: addf(p.body, "end$n", []) + addf(p.body, "}$n", []) + add(p.body, repeat('}', toClose) & tnl) proc generateHeader(p: PProc, typ: PType): Rope = result = nil @@ -770,12 +774,25 @@ proc generateHeader(p: PProc, typ: PType): Rope = var param = typ.n.sons[i].sym if isCompileTimeOnly(param.typ): continue if result != nil: add(result, ", ") - var name = mangleName(param) - add(result, name) - if mapType(param.typ) == etyBaseIndex: - add(result, ", ") + var name = mangleName(param, p.target) + if p.target == targetJS: add(result, name) - add(result, "_Idx") + if mapType(param.typ) == etyBaseIndex: + add(result, ", ") + add(result, name) + add(result, "_Idx") + elif not (i == 1 and param.name.s == "this"): + let k = param.typ.skipTypes({tyGenericInst}).kind + if k in { tyVar, tyRef, tyPtr, tyPointer }: + add(result, "&") + add(result, "$") + add(result, name) + # XXX I think something like this is needed for PHP to really support + # ptr "inside" strings and seq + #if mapType(param.typ) == etyBaseIndex: + # add(result, ", $") + # add(result, name) + # add(result, "_Idx") const nodeKindsNeedNoCopy = {nkCharLit..nkInt64Lit, nkStrLit..nkTripleStrLit, @@ -783,32 +800,58 @@ const nkCStringToString, nkCall, nkPrefix, nkPostfix, nkInfix, nkCommand, nkHiddenCallConv, nkCallStrLit} -proc needsNoCopy(y: PNode): bool = +proc needsNoCopy(p: PProc; y: PNode): bool = result = (y.kind in nodeKindsNeedNoCopy) or - (skipTypes(y.typ, abstractInst).kind in {tyRef, tyPtr, tyVar}) + (skipTypes(y.typ, abstractInst).kind in {tyRef, tyPtr, tyVar}) or + p.target == targetPHP proc genAsgnAux(p: PProc, x, y: PNode, noCopyNeeded: bool) = var a, b: TCompRes - gen(p, x, a) + + if p.target == targetPHP and x.kind == nkBracketExpr and + x[0].typ.skipTypes(abstractVar).kind in {tyString, tyCString}: + var c: TCompRes + gen(p, x[0], a) + gen(p, x[1], b) + gen(p, y, c) + addf(p.body, "$#[$#] = chr($#);$n", [a.rdLoc, b.rdLoc, c.rdLoc]) + return + + let xtyp = mapType(p, x.typ) + + if x.kind == nkHiddenDeref and x.sons[0].kind == nkCall and xtyp != etyObject: + gen(p, x.sons[0], a) + let tmp = p.getTemp(false) + addf(p.body, "var $1 = $2;$n", [tmp, a.rdLoc]) + a.res = "$1[0][$1[1]]" % [tmp] + else: + gen(p, x, a) + gen(p, y, b) - case mapType(x.typ) + + case xtyp of etyObject: - if needsNoCopy(y) or noCopyNeeded: + if (needsNoCopy(p, y) and needsNoCopy(p, x)) or noCopyNeeded: addf(p.body, "$1 = $2;$n", [a.rdLoc, b.rdLoc]) else: useMagic(p, "nimCopy") - addf(p.body, "$1 = nimCopy($1, $2, $3);$n", + addf(p.body, "nimCopy($1, $2, $3);$n", [a.res, b.res, genTypeInfo(p, y.typ)]) of etyBaseIndex: if a.typ != etyBaseIndex or b.typ != etyBaseIndex: - internalError(x.info, "genAsgn") - addf(p.body, "$1 = $2; $3 = $4;$n", [a.address, b.address, a.res, b.res]) + if y.kind == nkCall: + let tmp = p.getTemp(false) + addf(p.body, "var $1 = $4; $2 = $1[0]; $3 = $1[1];$n", [tmp, a.address, a.res, b.rdLoc]) + else: + internalError(x.info, "genAsgn") + else: + addf(p.body, "$1 = $2; $3 = $4;$n", [a.address, b.address, a.res, b.res]) else: addf(p.body, "$1 = $2;$n", [a.res, b.res]) proc genAsgn(p: PProc, n: PNode) = genLineDir(p, n) - genAsgnAux(p, n.sons[0], n.sons[1], noCopyNeeded=false) + genAsgnAux(p, n.sons[0], n.sons[1], noCopyNeeded=p.target == targetPHP) proc genFastAsgn(p: PProc, n: PNode) = genLineDir(p, n) @@ -818,19 +861,17 @@ proc genSwap(p: PProc, n: PNode) = var a, b: TCompRes gen(p, n.sons[1], a) gen(p, n.sons[2], b) - inc(p.unique) - var tmp = "Tmp$1" % [rope(p.unique)] - if mapType(skipTypes(n.sons[1].typ, abstractVar)) == etyBaseIndex: - inc(p.unique) - let tmp2 = "Tmp$1" % [rope(p.unique)] + var tmp = p.getTemp(false) + if mapType(p, skipTypes(n.sons[1].typ, abstractVar)) == etyBaseIndex: + let tmp2 = p.getTemp(false) if a.typ != etyBaseIndex or b.typ != etyBaseIndex: internalError(n.info, "genSwap") addf(p.body, "var $1 = $2; $2 = $3; $3 = $1;$n" | - "local $1 = $2; $2 = $3; $3 = $1;$n", [ + "$1 = $2; $2 = $3; $3 = $1;$n", [ tmp, a.address, b.address]) tmp = tmp2 addf(p.body, "var $1 = $2; $2 = $3; $3 = $1;" | - "local $1 = $2; $2 = $3; $3 = $1;", [tmp, a.res, b.res]) + "$1 = $2; $2 = $3; $3 = $1;", [tmp, a.res, b.res]) proc getFieldPosition(f: PNode): int = case f.kind @@ -844,11 +885,14 @@ proc genFieldAddr(p: PProc, n: PNode, r: var TCompRes) = let b = if n.kind == nkHiddenAddr: n.sons[0] else: n gen(p, b.sons[0], a) if skipTypes(b.sons[0].typ, abstractVarRange).kind == tyTuple: - r.res = makeJSString("Field" & $getFieldPosition(b.sons[1])) + if p.target == targetJS: + r.res = makeJSString( "Field" & $getFieldPosition(b.sons[1]) ) + else: + r.res = getFieldPosition(b.sons[1]).rope else: if b.sons[1].kind != nkSym: internalError(b.sons[1].info, "genFieldAddr") var f = b.sons[1].sym - if f.loc.r == nil: f.loc.r = mangleName(f) + if f.loc.r == nil: f.loc.r = mangleName(f, p.target) r.res = makeJSString($f.loc.r) internalAssert a.typ != etyBaseIndex r.address = a.res @@ -857,19 +901,29 @@ proc genFieldAddr(p: PProc, n: PNode, r: var TCompRes) = proc genFieldAccess(p: PProc, n: PNode, r: var TCompRes) = r.typ = etyNone gen(p, n.sons[0], r) - if skipTypes(n.sons[0].typ, abstractVarRange).kind == tyTuple: - r.res = "$1.Field$2" % [r.res, getFieldPosition(n.sons[1]).rope] + let otyp = skipTypes(n.sons[0].typ, abstractVarRange) + if otyp.kind == tyTuple: + r.res = ("$1.Field$2" | "$1[$2]") % + [r.res, getFieldPosition(n.sons[1]).rope] else: if n.sons[1].kind != nkSym: internalError(n.sons[1].info, "genFieldAccess") var f = n.sons[1].sym - if f.loc.r == nil: f.loc.r = mangleName(f) - r.res = "$1.$2" % [r.res, f.loc.r] + if f.loc.r == nil: f.loc.r = mangleName(f, p.target) + if p.target == targetJS: + r.res = "$1.$2" % [r.res, f.loc.r] + else: + if {sfImportc, sfExportc} * f.flags != {}: + r.res = "$1->$2" % [r.res, f.loc.r] + else: + r.res = "$1['$2']" % [r.res, f.loc.r] r.kind = resExpr +proc genAddr(p: PProc, n: PNode, r: var TCompRes) + proc genCheckedFieldAddr(p: PProc, n: PNode, r: var TCompRes) = let m = if n.kind == nkHiddenAddr: n.sons[0] else: n internalAssert m.kind == nkCheckedFieldExpr - genFieldAddr(p, m.sons[0], r) # XXX + genAddr(p, m, r) # XXX proc genCheckedFieldAccess(p: PProc, n: PNode, r: var TCompRes) = genFieldAccess(p, n.sons[0], r) # XXX @@ -889,7 +943,13 @@ proc genArrayAddr(p: PProc, n: PNode, r: var TCompRes) = else: first = 0 if optBoundsCheck in p.options and not isConstExpr(m.sons[1]): useMagic(p, "chckIndx") - r.res = "chckIndx($1, $2, $3.length)-$2" % [b.res, rope(first), a.res] + if p.target == targetPHP: + if typ.kind != tyString: + r.res = "chckIndx($1, $2, count($3))-$2" % [b.res, rope(first), a.res] + else: + r.res = "chckIndx($1, $2, strlen($3))-$2" % [b.res, rope(first), a.res] + else: + r.res = "chckIndx($1, $2, $3.length)-$2" % [b.res, rope(first), a.res] elif first != 0: r.res = "($1)-$2" % [b.res, rope(first)] else: @@ -904,20 +964,38 @@ proc genArrayAccess(p: PProc, n: PNode, r: var TCompRes) = tyVarargs: genArrayAddr(p, n, r) of tyTuple: + if p.target == targetPHP: + genFieldAccess(p, n, r) + return genFieldAddr(p, n, r) else: internalError(n.info, "expr(nkBracketExpr, " & $ty.kind & ')') r.typ = etyNone if r.res == nil: internalError(n.info, "genArrayAccess") - r.res = "$1[$2]" % [r.address, r.res] + if p.target == targetPHP: + if n.sons[0].kind in nkCallKinds+{nkStrLit..nkTripleStrLit}: + useMagic(p, "nimAt") + if ty.kind in {tyString, tyCString}: + # XXX this needs to be more like substr($1,$2) + r.res = "ord(nimAt($1, $2))" % [r.address, r.res] + else: + r.res = "nimAt($1, $2)" % [r.address, r.res] + elif ty.kind in {tyString, tyCString}: + # XXX this needs to be more like substr($1,$2) + r.res = "ord(@$1[$2])" % [r.address, r.res] + else: + r.res = "$1[$2]" % [r.address, r.res] + else: + r.res = "$1[$2]" % [r.address, r.res] r.address = nil r.kind = resExpr -proc isIndirect(v: PSym): bool = - result = {sfAddrTaken, sfGlobal} * v.flags != {} and +template isIndirect(x: PSym): bool = + let v = x + ({sfAddrTaken, sfGlobal} * v.flags != {} and #(mapType(v.typ) != etyObject) and {sfImportc, sfVolatile, sfExportc} * v.flags == {} and - v.kind notin {skProc, skConverter, skMethod, skIterator, skClosureIterator, - skConst, skTemp, skLet} + v.kind notin {skProc, skConverter, skMethod, skIterator, + skConst, skTemp, skLet} and p.target == targetJS) proc genAddr(p: PProc, n: PNode, r: var TCompRes) = case n.sons[0].kind @@ -927,12 +1005,14 @@ proc genAddr(p: PProc, n: PNode, r: var TCompRes) = case s.kind of skVar, skLet, skResult: r.kind = resExpr - let jsType = mapType(n.typ) + let jsType = mapType(p, n.typ) if jsType == etyObject: # make addr() a no-op: r.typ = etyNone if isIndirect(s): r.res = s.loc.r & "[0]" + elif p.target == targetPHP: + r.res = "&" & s.loc.r else: r.res = s.loc.r r.address = nil @@ -950,7 +1030,7 @@ proc genAddr(p: PProc, n: PNode, r: var TCompRes) = of nkCheckedFieldExpr: genCheckedFieldAddr(p, n, r) of nkDotExpr: - if mapType(n.typ) == etyBaseIndex: + if mapType(p, n.typ) == etyBaseIndex: genFieldAddr(p, n.sons[0], r) else: genFieldAccess(p, n.sons[0], r) @@ -971,6 +1051,32 @@ proc genAddr(p: PProc, n: PNode, r: var TCompRes) = gen(p, n.sons[0], r) else: internalError(n.sons[0].info, "genAddr: " & $n.sons[0].kind) +proc thisParam(p: PProc; typ: PType): PType = + if p.target == targetPHP: + # XXX Might be very useful for the JS backend too? + let typ = skipTypes(typ, abstractInst) + assert(typ.kind == tyProc) + if 1 < sonsLen(typ.n): + assert(typ.n.sons[1].kind == nkSym) + let param = typ.n.sons[1].sym + if param.name.s == "this": + result = param.typ.skipTypes(abstractVar) + +proc attachProc(p: PProc; content: Rope; s: PSym) = + let otyp = thisParam(p, s.typ) + if otyp != nil: + for i, cls in p.g.classes: + if sameType(cls[0], otyp): + add(p.g.classes[i][1], content) + return + p.g.classes.add((otyp, content)) + else: + add(p.g.code, content) + +proc attachProc(p: PProc; s: PSym) = + let newp = genProc(p, s) + attachProc(p, newp, s) + proc genProcForSymIfNeeded(p: PProc, s: PSym) = if not p.g.generatedSyms.containsOrIncl(s.id): let newp = genProc(p, s) @@ -978,35 +1084,47 @@ proc genProcForSymIfNeeded(p: PProc, s: PSym) = while owner != nil and owner.prc != s.owner: owner = owner.up if owner != nil: add(owner.locals, newp) - else: add(p.g.code, newp) + else: attachProc(p, newp, s) proc genSym(p: PProc, n: PNode, r: var TCompRes) = var s = n.sym case s.kind - of skVar, skLet, skParam, skTemp, skResult: + of skVar, skLet, skParam, skTemp, skResult, skForVar: if s.loc.r == nil: internalError(n.info, "symbol has no generated name: " & s.name.s) - let k = mapType(s.typ) - if k == etyBaseIndex: - r.typ = etyBaseIndex - if {sfAddrTaken, sfGlobal} * s.flags != {}: - r.address = "$1[0]" % [s.loc.r] - r.res = "$1[1]" % [s.loc.r] + if p.target == targetJS: + let k = mapType(p, s.typ) + if k == etyBaseIndex: + r.typ = etyBaseIndex + if {sfAddrTaken, sfGlobal} * s.flags != {}: + r.address = "$1[0]" % [s.loc.r] + r.res = "$1[1]" % [s.loc.r] + else: + r.address = s.loc.r + r.res = s.loc.r & "_Idx" + elif isIndirect(s): + r.res = "$1[0]" % [s.loc.r] else: - r.address = s.loc.r - r.res = s.loc.r & "_Idx" - elif isIndirect(s): - r.res = "$1[0]" % [s.loc.r] + r.res = s.loc.r else: - r.res = s.loc.r + r.res = "$" & s.loc.r + if sfGlobal in s.flags: + p.declareGlobal(s.id, r.res) of skConst: genConstant(p, s) if s.loc.r == nil: internalError(n.info, "symbol has no generated name: " & s.name.s) - r.res = s.loc.r + if p.target == targetJS: + r.res = s.loc.r + else: + r.res = "$" & s.loc.r + p.declareGlobal(s.id, r.res) of skProc, skConverter, skMethod: - discard mangleName(s) - r.res = s.loc.r + discard mangleName(s, p.target) + if p.target == targetPHP and r.kind != resCallee: + r.res = makeJsString($s.loc.r) + else: + r.res = s.loc.r if lfNoDecl in s.loc.flags or s.magic != mNone or {sfImportc, sfInfixCall} * s.flags != {}: discard @@ -1024,13 +1142,18 @@ proc genSym(p: PProc, n: PNode, r: var TCompRes) = r.kind = resVal proc genDeref(p: PProc, n: PNode, r: var TCompRes) = - if mapType(n.sons[0].typ) == etyObject: + if mapType(p, n.sons[0].typ) == etyObject: gen(p, n.sons[0], r) else: var a: TCompRes gen(p, n.sons[0], a) - if a.typ != etyBaseIndex: internalError(n.info, "genDeref") - r.res = "$1[$2]" % [a.address, a.res] + if a.typ == etyBaseIndex: + r.res = "$1[$2]" % [a.address, a.res] + elif n.sons[0].kind == nkCall: + let tmp = p.getTemp + r.res = "($1 = $2, $1[0][$1[1]])" % [tmp, a.res] + else: + internalError(n.info, "genDeref") proc genArgNoParam(p: PProc, n: PNode, r: var TCompRes) = var a: TCompRes @@ -1055,8 +1178,7 @@ proc genArg(p: PProc, n: PNode, param: PSym, r: var TCompRes) = else: add(r.res, a.res) - -proc genArgs(p: PProc, n: PNode, r: var TCompRes) = +proc genArgs(p: PProc, n: PNode, r: var TCompRes; start=1) = add(r.res, "(") var hasArgs = false @@ -1064,9 +1186,9 @@ proc genArgs(p: PProc, n: PNode, r: var TCompRes) = assert(typ.kind == tyProc) assert(sonsLen(typ) == sonsLen(typ.n)) - for i in countup(1, sonsLen(n) - 1): + for i in countup(start, sonsLen(n) - 1): let it = n.sons[i] - var paramType : PNode = nil + var paramType: PNode = nil if i < sonsLen(typ): assert(typ.n.sons[i].kind == nkSym) paramType = typ.n.sons[i] @@ -1081,11 +1203,56 @@ proc genArgs(p: PProc, n: PNode, r: var TCompRes) = add(r.res, ")") r.kind = resExpr -proc genCall(p: PProc, n: PNode, r: var TCompRes) = - gen(p, n.sons[0], r) - genArgs(p, n, r) +proc genOtherArg(p: PProc; n: PNode; i: int; typ: PType; + generated: var int; r: var TCompRes) = + let it = n[i] + var paramType: PNode = nil + if i < sonsLen(typ): + assert(typ.n.sons[i].kind == nkSym) + paramType = typ.n.sons[i] + if paramType.typ.isCompileTimeOnly: return + if paramType.isNil: + genArgNoParam(p, it, r) + else: + genArg(p, it, paramType.sym, r) + +proc genPatternCall(p: PProc; n: PNode; pat: string; typ: PType; + r: var TCompRes) = + var i = 0 + var j = 1 + while i < pat.len: + case pat[i] + of '@': + var generated = 0 + for k in j .. < n.len: + if generated > 0: add(r.res, ", ") + genOtherArg(p, n, k, typ, generated, r) + inc i + of '#': + var generated = 0 + genOtherArg(p, n, j, typ, generated, r) + inc j + inc i + else: + let start = i + while i < pat.len: + if pat[i] notin {'@', '#'}: inc(i) + else: break + if i - 1 >= start: + add(r.res, substr(pat, start, i - 1)) proc genInfixCall(p: PProc, n: PNode, r: var TCompRes) = + # don't call '$' here for efficiency: + let f = n[0].sym + if f.loc.r == nil: f.loc.r = mangleName(f, p.target) + if sfInfixCall in f.flags: + let pat = n.sons[0].sym.loc.r.data + internalAssert pat != nil + if pat.contains({'#', '(', '@'}): + var typ = skipTypes(n.sons[0].typ, abstractInst) + assert(typ.kind == tyProc) + genPatternCall(p, n, pat, typ, r) + return gen(p, n.sons[1], r) if r.typ == etyBaseIndex: if r.address == nil: @@ -1093,30 +1260,40 @@ proc genInfixCall(p: PProc, n: PNode, r: var TCompRes) = r.res = "$1[$2]" % [r.address, r.res] r.address = nil r.typ = etyNone - add(r.res, ".") + add(r.res, "." | "->") var op: TCompRes + if p.target == targetPHP: + op.kind = resCallee gen(p, n.sons[0], op) add(r.res, op.res) + genArgs(p, n, r, 2) - add(r.res, "(") - for i in countup(2, sonsLen(n) - 1): - if i > 2: add(r.res, ", ") - genArgNoParam(p, n.sons[i], r) - add(r.res, ")") - r.kind = resExpr +proc genCall(p: PProc, n: PNode, r: var TCompRes) = + if n.sons[0].kind == nkSym and thisParam(p, n.sons[0].typ) != nil: + genInfixCall(p, n, r) + return + if p.target == targetPHP: + r.kind = resCallee + gen(p, n.sons[0], r) + genArgs(p, n, r) proc genEcho(p: PProc, n: PNode, r: var TCompRes) = - useMagic(p, "toJSStr") # Used in rawEcho - useMagic(p, "rawEcho") - add(r.res, "rawEcho(") let n = n[1].skipConv internalAssert n.kind == nkBracket + if p.target == targetJS: + useMagic(p, "toJSStr") # Used in rawEcho + useMagic(p, "rawEcho") + elif n.len == 0: + r.kind = resExpr + add(r.res, """print("\n")""") + return + add(r.res, "rawEcho(" | "print(") for i in countup(0, sonsLen(n) - 1): let it = n.sons[i] if it.typ.isCompileTimeOnly: continue - if i > 0: add(r.res, ", ") + if i > 0: add(r.res, ", " | ".") genArgNoParam(p, it, r) - add(r.res, ")") + add(r.res, ")" | """."\n")""") r.kind = resExpr proc putToSeq(s: string, indirect: bool): Rope = @@ -1136,8 +1313,11 @@ proc createRecordVarAux(p: PProc, rec: PNode, excludedFieldIDs: IntSet, output: of nkSym: if rec.sym.id notin excludedFieldIDs: if output.len > 0: output.add(", ") - output.add(mangleName(rec.sym)) - output.add(": ") + if p.target == targetJS: + output.add(mangleName(rec.sym, p.target)) + output.add(": ") + else: + output.addf("'$#' => ", [mangleName(rec.sym, p.target)]) output.add(createVar(p, rec.sym.typ, false)) else: internalError(rec.info, "createRecordVarAux") @@ -1145,11 +1325,23 @@ proc createObjInitList(p: PProc, typ: PType, excludedFieldIDs: IntSet, output: v var t = typ if tfFinal notin t.flags or t.sons[0] != nil: if output.len > 0: output.add(", ") - addf(output, "m_type: $1" | "m_type = $#", [genTypeInfo(p, t)]) + addf(output, "m_type: $1" | "'m_type' => $#", [genTypeInfo(p, t)]) while t != nil: createRecordVarAux(p, t.n, excludedFieldIDs, output) t = t.sons[0] +proc arrayTypeForElemType(typ: PType): string = + case typ.kind + of tyInt, tyInt32: "Int32Array" + of tyInt16: "Int16Array" + of tyInt8: "Int8Array" + of tyUint, tyUint32: "Uint32Array" + of tyUint16: "Uint16Array" + of tyUint8: "Uint8Array" + of tyFloat32: "Float32Array" + of tyFloat64, tyFloat: "Float64Array" + else: nil + proc createVar(p: PProc, typ: PType, indirect: bool): Rope = var t = skipTypes(typ, abstractInst) case t.kind @@ -1160,47 +1352,57 @@ proc createVar(p: PProc, typ: PType, indirect: bool): Rope = of tyRange, tyGenericInst: result = createVar(p, lastSon(typ), indirect) of tySet: - result = putToSeq("{}", indirect) + result = putToSeq("{}" | "array()", indirect) of tyBool: result = putToSeq("false", indirect) of tyArray, tyArrayConstr: - var length = int(lengthOrd(t)) - var e = elemType(t) - if length > 32: + let length = int(lengthOrd(t)) + let e = elemType(t) + let jsTyp = arrayTypeForElemType(e) + if not jsTyp.isNil and p.target == targetJS: + result = "new $1($2)" % [rope(jsTyp), rope(length)] + elif length > 32: useMagic(p, "arrayConstr") # XXX: arrayConstr depends on nimCopy. This line shouldn't be necessary. - useMagic(p, "nimCopy") + if p.target == targetJS: useMagic(p, "nimCopy") result = "arrayConstr($1, $2, $3)" % [rope(length), createVar(p, e, false), genTypeInfo(p, e)] else: - result = rope("[") + result = rope("[" | "array(") var i = 0 while i < length: if i > 0: add(result, ", ") add(result, createVar(p, e, false)) inc(i) - add(result, "]") + add(result, "]" | ")") if indirect: result = "[$1]" % [result] of tyTuple: - result = rope("{") - for i in 0.. <t.sonsLen: - if i > 0: add(result, ", ") - addf(result, "Field$1: $2" | "Field$# = $#", [i.rope, - createVar(p, t.sons[i], false)]) - add(result, "}") - if indirect: result = "[$1]" % [result] + if p.target == targetJS: + result = rope("{") + for i in 0.. <t.sonsLen: + if i > 0: add(result, ", ") + addf(result, "Field$1: $2", [i.rope, + createVar(p, t.sons[i], false)]) + add(result, "}") + if indirect: result = "[$1]" % [result] + else: + result = rope("array(") + for i in 0.. <t.sonsLen: + if i > 0: add(result, ", ") + add(result, createVar(p, t.sons[i], false)) + add(result, ")") of tyObject: - var initList : Rope + var initList: Rope createObjInitList(p, t, initIntSet(), initList) - result = "{$1}" % [initList] + result = ("{$1}" | "array($#)") % [initList] if indirect: result = "[$1]" % [result] of tyVar, tyPtr, tyRef: - if mapType(t) == etyBaseIndex: - result = putToSeq("[null, 0]" | "{nil, 0}", indirect) + if mapType(p, t) == etyBaseIndex: + result = putToSeq("[null, 0]", indirect) else: - result = putToSeq("null" | "nil", indirect) + result = putToSeq("null", indirect) of tySequence, tyString, tyCString, tyPointer, tyProc: - result = putToSeq("null" | "nil", indirect) + result = putToSeq("null", indirect) else: internalError("createVar: " & $t.kind) result = nil @@ -1210,14 +1412,14 @@ proc genVarInit(p: PProc, v: PSym, n: PNode) = a: TCompRes s: Rope if n.kind == nkEmpty: - addf(p.body, "var $1 = $2;$n" | "local $1 = $2;$n", - [mangleName(v), createVar(p, v.typ, isIndirect(v))]) + addf(p.body, "var $1 = $2;$n" | "$$$1 = $2;$n", + [mangleName(v, p.target), createVar(p, v.typ, isIndirect(v))]) else: - discard mangleName(v) + discard mangleName(v, p.target) gen(p, n, a) - case mapType(v.typ) + case mapType(p, v.typ) of etyObject: - if needsNoCopy(n): + if needsNoCopy(p, n): s = a.res else: useMagic(p, "nimCopy") @@ -1225,19 +1427,18 @@ proc genVarInit(p: PProc, v: PSym, n: PNode) = of etyBaseIndex: if (a.typ != etyBaseIndex): internalError(n.info, "genVarInit") if {sfAddrTaken, sfGlobal} * v.flags != {}: - addf(p.body, "var $1 = [$2, $3];$n" | "local $1 = {$2, $3};$n", + addf(p.body, "var $1 = [$2, $3];$n", [v.loc.r, a.address, a.res]) else: - addf(p.body, "var $1 = $2; var $1_Idx = $3;$n" | - "local $1 = $2; local $1_Idx = $3;$n", [ + addf(p.body, "var $1 = $2; var $1_Idx = $3;$n", [ v.loc.r, a.address, a.res]) return else: s = a.res if isIndirect(v): - addf(p.body, "var $1 = /**/[$2];$n" | "local $1 = {$2};$n", [v.loc.r, s]) + addf(p.body, "var $1 = /**/[$2];$n", [v.loc.r, s]) else: - addf(p.body, "var $1 = $2;$n" | "local $1 = $2;$n", [v.loc.r, s]) + addf(p.body, "var $1 = $2;$n" | "$$$1 = $2;$n", [v.loc.r, s]) proc genVarStmt(p: PProc, n: PNode) = for i in countup(0, sonsLen(n) - 1): @@ -1260,27 +1461,31 @@ proc genConstant(p: PProc, c: PSym) = p.body = nil #genLineDir(p, c.ast) genVarInit(p, c, c.ast) - add(p.g.code, p.body) + add(p.g.constants, p.body) p.body = oldBody proc genNew(p: PProc, n: PNode) = var a: TCompRes gen(p, n.sons[1], a) var t = skipTypes(n.sons[1].typ, abstractVar).sons[0] - addf(p.body, "$1 = $2;$n", [a.res, createVar(p, t, false)]) + if p.target == targetJS: + addf(p.body, "$1 = $2;$n", [a.res, createVar(p, t, false)]) + else: + addf(p.body, "$3 = $2; $1 = &$3;$n", [a.res, createVar(p, t, false), getTemp(p)]) proc genNewSeq(p: PProc, n: PNode) = var x, y: TCompRes gen(p, n.sons[1], x) gen(p, n.sons[2], y) let t = skipTypes(n.sons[1].typ, abstractVar).sons[0] - addf(p.body, "$1 = new Array($2); for (var i=0;i<$2;++i) {$1[i]=$3;}", [ + addf(p.body, "$1 = new Array($2); for (var i=0;i<$2;++i) {$1[i]=$3;}" | + "$1 = array(); for ($$i=0;$$i<$2;++$$i) {$1[]=$3;}", [ x.rdLoc, y.rdLoc, createVar(p, t, false)]) proc genOrd(p: PProc, n: PNode, r: var TCompRes) = case skipTypes(n.sons[1].typ, abstractVar).kind of tyEnum, tyInt..tyInt64, tyChar: gen(p, n.sons[1], r) - of tyBool: unaryExpr(p, n, r, "", "($1 ? 1:0)" | "toBool($#)") + of tyBool: unaryExpr(p, n, r, "", "($1 ? 1:0)") else: internalError(n.info, "genOrd") proc genConStrStr(p: PProc, n: PNode, r: var TCompRes) = @@ -1306,8 +1511,46 @@ proc genConStrStr(p: PProc, n: PNode, r: var TCompRes) = else: r.res.add("$1)" % [a.res]) +proc genConStrStrPHP(p: PProc, n: PNode, r: var TCompRes) = + var a: TCompRes + gen(p, n.sons[1], a) + r.kind = resExpr + if skipTypes(n.sons[1].typ, abstractVarRange).kind == tyChar: + r.res.add("chr($1)" % [a.res]) + else: + r.res.add(a.res) + for i in countup(2, sonsLen(n) - 1): + gen(p, n.sons[i], a) + if skipTypes(n.sons[i].typ, abstractVarRange).kind == tyChar: + r.res.add(".chr($1)" % [a.res]) + else: + r.res.add(".$1" % [a.res]) + +proc genToArray(p: PProc; n: PNode; r: var TCompRes) = + # we map mArray to PHP's array constructor, a mild hack: + var a, b: TCompRes + r.kind = resExpr + r.res = rope("array(") + let x = skipConv(n[1]) + if x.kind == nkBracket: + for i in countup(0, x.len - 1): + let it = x[i] + if it.kind == nkPar and it.len == 2: + if i > 0: r.res.add(", ") + gen(p, it[0], a) + gen(p, it[1], b) + r.res.add("$# => $#" % [a.rdLoc, b.rdLoc]) + else: + localError(it.info, "'toArray' needs tuple constructors") + else: + localError(x.info, "'toArray' needs an array literal") + r.res.add(")") + proc genRepr(p: PProc, n: PNode, r: var TCompRes) = - var t = skipTypes(n.sons[1].typ, abstractVarRange) + if p.target == targetPHP: + localError(n.info, "'repr' not available for PHP backend") + return + let t = skipTypes(n.sons[1].typ, abstractVarRange) case t.kind of tyInt..tyUInt64: unaryExpr(p, n, r, "", "(\"\"+ ($1))") @@ -1353,46 +1596,90 @@ proc genMagic(p: PProc, n: PNode, r: var TCompRes) = # XXX: range checking? if not (optOverflowCheck in p.options): unaryExpr(p, n, r, "", "$1 - 1") else: unaryExpr(p, n, r, "subInt", "subInt($1, 1)") - of mAppendStrCh: binaryExpr(p, n, r, "addChar", - "if ($1 != null) { addChar($1, $2); } else { $1 = [$2, 0]; }") + of mAppendStrCh: + if p.target == targetJS: + binaryExpr(p, n, r, "addChar", + "if ($1 != null) { addChar($1, $2); } else { $1 = [$2, 0]; }") + else: + binaryExpr(p, n, r, "", + "$1 .= chr($2)") of mAppendStrStr: - if skipTypes(n.sons[1].typ, abstractVarRange).kind == tyCString: - binaryExpr(p, n, r, "", "if ($1 != null) { $1 += $2; } else { $1 = $2; }") + if p.target == targetJS: + if skipTypes(n.sons[1].typ, abstractVarRange).kind == tyCString: + binaryExpr(p, n, r, "", "if ($1 != null) { $1 += $2; } else { $1 = $2; }") + else: + binaryExpr(p, n, r, "", + "if ($1 != null) { $1 = ($1.slice(0, -1)).concat($2); } else { $1 = $2;}") + # XXX: make a copy of $2, because of Javascript's sucking semantics else: binaryExpr(p, n, r, "", - "if ($1 != null) { $1 = ($1.slice(0, -1)).concat($2); } else { $1 = $2;}") - # XXX: make a copy of $2, because of Javascript's sucking semantics - of mAppendSeqElem: binaryExpr(p, n, r, "", - "if ($1 != null) { $1.push($2); } else { $1 = [$2]; }") - of mConStrStr: genConStrStr(p, n, r) - of mEqStr: binaryExpr(p, n, r, "eqStrings", "eqStrings($1, $2)") - of mLeStr: binaryExpr(p, n, r, "cmpStrings", "(cmpStrings($1, $2) <= 0)") - of mLtStr: binaryExpr(p, n, r, "cmpStrings", "(cmpStrings($1, $2) < 0)") - of mIsNil: unaryExpr(p, n, r, "", "$1 == null") + "$1 .= $2;") + of mAppendSeqElem: + if p.target == targetJS: + binaryExpr(p, n, r, "", + "if ($1 != null) { $1.push($2); } else { $1 = [$2]; }") + else: + binaryExpr(p, n, r, "", + "$1[] = $2") + of mConStrStr: + if p.target == targetJS: + genConStrStr(p, n, r) + else: + genConStrStrPHP(p, n, r) + of mEqStr: + if p.target == targetJS: + binaryExpr(p, n, r, "eqStrings", "eqStrings($1, $2)") + else: + binaryExpr(p, n, r, "", "($1 == $2)") + of mLeStr: + if p.target == targetJS: + binaryExpr(p, n, r, "cmpStrings", "(cmpStrings($1, $2) <= 0)") + else: + binaryExpr(p, n, r, "", "($1 <= $2)") + of mLtStr: + if p.target == targetJS: + binaryExpr(p, n, r, "cmpStrings", "(cmpStrings($1, $2) < 0)") + else: + binaryExpr(p, n, r, "", "($1 < $2)") + of mIsNil: unaryExpr(p, n, r, "", "($1 === null)") of mEnumToStr: genRepr(p, n, r) of mNew, mNewFinalize: genNew(p, n) of mSizeOf: r.res = rope(getSize(n.sons[1].typ)) of mChr, mArrToSeq: gen(p, n.sons[1], r) # nothing to do of mOrd: genOrd(p, n, r) - of mLengthStr: unaryExpr(p, n, r, "", "($1 != null ? $1.length-1 : 0)") - of mXLenStr: unaryExpr(p, n, r, "", "$1.length-1") + of mLengthStr: + if p.target == targetJS and n.sons[1].typ.skipTypes(abstractInst).kind == tyCString: + unaryExpr(p, n, r, "", "($1 != null ? $1.length : 0)") + else: + unaryExpr(p, n, r, "", "($1 != null ? $1.length-1 : 0)" | + "strlen($1)") + of mXLenStr: unaryExpr(p, n, r, "", "$1.length-1" | "strlen($1)") of mLengthSeq, mLengthOpenArray, mLengthArray: - unaryExpr(p, n, r, "", "($1 != null ? $1.length : 0)") + unaryExpr(p, n, r, "", "($1 != null ? $1.length : 0)" | + "count($1)") of mXLenSeq: - unaryExpr(p, n, r, "", "$1.length") + unaryExpr(p, n, r, "", "$1.length" | "count($1)") of mHigh: if skipTypes(n.sons[1].typ, abstractVar).kind == tyString: - unaryExpr(p, n, r, "", "($1 != null ? ($1.length-2) : -1)") + unaryExpr(p, n, r, "", "($1 != null ? ($1.length-2) : -1)" | + "(strlen($1)-1)") else: - unaryExpr(p, n, r, "", "($1 != null ? ($1.length-1) : -1)") + unaryExpr(p, n, r, "", "($1 != null ? ($1.length-1) : -1)" | + "(count($1)-1)") of mInc: - if optOverflowCheck notin p.options: binaryExpr(p, n, r, "", "$1 += $2") - else: binaryExpr(p, n, r, "addInt", "$1 = addInt($1, $2)") + if n[1].typ.skipTypes(abstractRange).kind in tyUInt .. tyUInt64: + binaryUintExpr(p, n, r, "+", true) + else: + if optOverflowCheck notin p.options: binaryExpr(p, n, r, "", "$1 += $2") + else: binaryExpr(p, n, r, "addInt", "$1 = addInt($1, $2)") of ast.mDec: - if optOverflowCheck notin p.options: binaryExpr(p, n, r, "", "$1 -= $2") - else: binaryExpr(p, n, r, "subInt", "$1 = subInt($1, $2)") - of mSetLengthStr: binaryExpr(p, n, r, "", "$1.length = $2+1; $1[$1.length-1] = 0") - of mSetLengthSeq: binaryExpr(p, n, r, "", "$1.length = $2") + if n[1].typ.skipTypes(abstractRange).kind in tyUInt .. tyUInt64: + binaryUintExpr(p, n, r, "-", true) + else: + if optOverflowCheck notin p.options: binaryExpr(p, n, r, "", "$1 -= $2") + else: binaryExpr(p, n, r, "subInt", "$1 = subInt($1, $2)") + of mSetLengthStr: binaryExpr(p, n, r, "", "$1.length = $2+1; $1[$1.length-1] = 0" | "") + of mSetLengthSeq: binaryExpr(p, n, r, "", "$1.length = $2" | "") of mCard: unaryExpr(p, n, r, "SetCard", "SetCard($1)") of mLtSet: binaryExpr(p, n, r, "SetLt", "SetLt($1, $2)") of mLeSet: binaryExpr(p, n, r, "SetLe", "SetLe($1, $2)") @@ -1401,24 +1688,36 @@ proc genMagic(p: PProc, n: PNode, r: var TCompRes) = of mPlusSet: binaryExpr(p, n, r, "SetPlus", "SetPlus($1, $2)") of mMinusSet: binaryExpr(p, n, r, "SetMinus", "SetMinus($1, $2)") of mIncl: binaryExpr(p, n, r, "", "$1[$2] = true") - of mExcl: binaryExpr(p, n, r, "", "delete $1[$2]") - of mInSet: binaryExpr(p, n, r, "", "($1[$2] != undefined)") + of mExcl: binaryExpr(p, n, r, "", "delete $1[$2]" | "unset $1[$2]") + of mInSet: binaryExpr(p, n, r, "", "($1[$2] != undefined)" | "isset($1[$2])") of mNewSeq: genNewSeq(p, n) of mOf: genOf(p, n, r) of mReset: genReset(p, n) of mEcho: genEcho(p, n, r) of mNLen..mNError, mSlurp, mStaticExec: localError(n.info, errXMustBeCompileTime, n.sons[0].sym.name.s) - of mCopyStr: binaryExpr(p, n, r, "", "($1.slice($2))") - of mCopyStrLast: ternaryExpr(p, n, r, "", "($1.slice($2, ($3)+1).concat(0))") + of mCopyStr: + binaryExpr(p, n, r, "", "($1.slice($2))" | "substr($1, $2)") + of mCopyStrLast: + if p.target == targetJS: + ternaryExpr(p, n, r, "", "($1.slice($2, ($3)+1).concat(0))") + else: + ternaryExpr(p, n, r, "nimSubstr", "nimSubstr($#, $#, $#)") of mNewString: unaryExpr(p, n, r, "mnewString", "mnewString($1)") - of mNewStringOfCap: unaryExpr(p, n, r, "mnewString", "mnewString(0)") + of mNewStringOfCap: + if p.target == targetJS: + unaryExpr(p, n, r, "mnewString", "mnewString(0)") + else: + unaryExpr(p, n, r, "", "''") of mDotDot: genProcForSymIfNeeded(p, n.sons[0].sym) genCall(p, n, r) of mParseBiggestFloat: useMagic(p, "nimParseBiggestFloat") genCall(p, n, r) + of mArray: + if p.target == targetPHP: genToArray(p, n, r) + else: genCall(p, n, r) else: genCall(p, n, r) #else internalError(e.info, 'genMagic: ' + magicToStr[op]); @@ -1435,7 +1734,7 @@ proc genSetConstr(p: PProc, n: PNode, r: var TCompRes) = if it.kind == nkRange: gen(p, it.sons[0], a) gen(p, it.sons[1], b) - addf(r.res, "[$1, $2]", [a.res, b.res]) + addf(r.res, "[$1, $2]" | "array($#,$#)", [a.res, b.res]) else: gen(p, it, a) add(r.res, a.res) @@ -1443,25 +1742,25 @@ proc genSetConstr(p: PProc, n: PNode, r: var TCompRes) = proc genArrayConstr(p: PProc, n: PNode, r: var TCompRes) = var a: TCompRes - r.res = rope("[") + r.res = rope("[" | "array(") r.kind = resExpr for i in countup(0, sonsLen(n) - 1): if i > 0: add(r.res, ", ") gen(p, n.sons[i], a) add(r.res, a.res) - add(r.res, "]") + add(r.res, "]" | ")") proc genTupleConstr(p: PProc, n: PNode, r: var TCompRes) = var a: TCompRes - r.res = rope("{") + r.res = rope("{" | "array(") r.kind = resExpr for i in countup(0, sonsLen(n) - 1): if i > 0: add(r.res, ", ") var it = n.sons[i] if it.kind == nkExprColonExpr: it = it.sons[1] gen(p, it, a) - addf(r.res, "Field$#: $#" | "Field$# = $#", [i.rope, a.res]) - r.res.add("}") + addf(r.res, "Field$#: $#" | "$2", [i.rope, a.res]) + r.res.add("}" | ")") proc genObjConstr(p: PProc, n: PNode, r: var TCompRes) = var a: TCompRes @@ -1474,12 +1773,12 @@ proc genObjConstr(p: PProc, n: PNode, r: var TCompRes) = internalAssert it.kind == nkExprColonExpr gen(p, it.sons[1], a) var f = it.sons[0].sym - if f.loc.r == nil: f.loc.r = mangleName(f) + if f.loc.r == nil: f.loc.r = mangleName(f, p.target) fieldIDs.incl(f.id) - addf(initList, "$#: $#" | "$# = $#" , [f.loc.r, a.res]) + addf(initList, "$#: $#" | "'$#' => $#" , [f.loc.r, a.res]) let t = skipTypes(n.typ, abstractInst + skipPtrs) createObjInitList(p, t, fieldIDs, initList) - r.res = "{$1}" % [initList] + r.res = ("{$1}" | "array($#)") % [initList] proc genConv(p: PProc, n: PNode, r: var TCompRes) = var dest = skipTypes(n.typ, abstractVarRange) @@ -1490,7 +1789,7 @@ proc genConv(p: PProc, n: PNode, r: var TCompRes) = return case dest.kind: of tyBool: - r.res = ("(($1)? 1:0)" | "toBool($#)") % [r.res] + r.res = "(($1)? 1:0)" % [r.res] r.kind = resExpr of tyInt: r.res = "($1|0)" % [r.res] @@ -1538,57 +1837,64 @@ proc convCStrToStr(p: PProc, n: PNode, r: var TCompRes) = proc genReturnStmt(p: PProc, n: PNode) = if p.procDef == nil: internalError(n.info, "genReturnStmt") p.beforeRetNeeded = true - if (n.sons[0].kind != nkEmpty): + if n.sons[0].kind != nkEmpty: genStmt(p, n.sons[0]) else: genLineDir(p, n) - addf(p.body, "break BeforeRet;$n" | "goto ::BeforeRet::;$n", []) + addf(p.body, "break BeforeRet;$n" | "goto BeforeRet;$n", []) + +proc frameCreate(p: PProc; procname, filename: Rope): Rope = + result = (("var F={procname:$1,prev:framePtr,filename:$2,line:0};$nframePtr = F;$n" | + "global $$framePtr; $$F=array('procname'=>$#,'prev'=>$$framePtr,'filename'=>$#,'line'=>0);$n$$framePtr = &$$F;$n")) % [ + procname, filename] + +proc frameDestroy(p: PProc): Rope = + result = rope(("framePtr = framePtr.prev;" | "$framePtr = $framePtr['prev'];") & tnl) proc genProcBody(p: PProc, prc: PSym): Rope = if optStackTrace in prc.options: - result = (("var F={procname:$1,prev:framePtr,filename:$2,line:0};$n" | - "local F={procname=$#,prev=framePtr,filename=$#,line=0};$n") & - "framePtr = F;$n") % [ + result = frameCreate(p, makeJSString(prc.owner.name.s & '.' & prc.name.s), - makeJSString(toFilename(prc.info))] + makeJSString(toFilename(prc.info))) else: result = nil if p.beforeRetNeeded: addf(result, "BeforeRet: do {$n$1} while (false); $n" | - "$#;::BeforeRet::$n", [p.body]) + "$# BeforeRet:;$n", [p.body]) else: add(result, p.body) if prc.typ.callConv == ccSysCall and p.target == targetJS: result = ("try {$n$1} catch (e) {$n" & " alert(\"Unhandled exception:\\n\" + e.message + \"\\n\"$n}") % [result] if optStackTrace in prc.options: - add(result, "framePtr = framePtr.prev;" & tnl) + add(result, frameDestroy(p)) proc genProc(oldProc: PProc, prc: PSym): Rope = var resultSym: PSym - name, returnStmt, resultAsgn, header: Rope a: TCompRes #if gVerbosity >= 3: # echo "BEGIN generating code for: " & prc.name.s var p = newProc(oldProc.g, oldProc.module, prc.ast, prc.options) - p.target = oldProc.target p.up = oldProc - returnStmt = nil - resultAsgn = nil - name = mangleName(prc) - header = generateHeader(p, prc.typ) + var returnStmt: Rope = nil + var resultAsgn: Rope = nil + let name = mangleName(prc, p.target) + let header = generateHeader(p, prc.typ) if prc.typ.sons[0] != nil and sfPure notin prc.flags: resultSym = prc.ast.sons[resultPos].sym - resultAsgn = ("var $# = $#;$n" | "local $# = $#;$n") % [ - mangleName(resultSym), + resultAsgn = ("var $# = $#;$n" | "$$$# = $#;$n") % [ + mangleName(resultSym, p.target), createVar(p, resultSym.typ, isIndirect(resultSym))] gen(p, prc.ast.sons[resultPos], a) - returnStmt = "return $#;$n" % [a.res] + if mapType(p, resultSym.typ) == etyBaseIndex: + returnStmt = "return [$#, $#];$n" % [a.address, a.res] + else: + returnStmt = "return $#;$n" % [a.res] genStmt(p, prc.getBody) - result = ("function $#($#) {$n$#$#$#$#}$n" | - "function $#($#) $n$#$#$#$#$nend$n") % - [name, header, p.locals, resultAsgn, + + result = "function $#($#) {$n$#$n$#$#$#$#}$n" % + [name, header, p.globals, p.locals, resultAsgn, genProcBody(p, prc), returnStmt] #if gVerbosity >= 3: # echo "END generated code for: " & prc.name.s @@ -1604,34 +1910,71 @@ proc genPragma(p: PProc, n: PNode) = of wEmit: genAsmOrEmitStmt(p, it.sons[1]) else: discard +proc genCast(p: PProc, n: PNode, r: var TCompRes) = + var dest = skipTypes(n.typ, abstractVarRange) + var src = skipTypes(n.sons[1].typ, abstractVarRange) + gen(p, n.sons[1], r) + if dest.kind == src.kind: + # no-op conversion + return + let toInt = (dest.kind in tyInt .. tyInt32) + let toUint = (dest.kind in tyUInt .. tyUInt32) + let fromInt = (src.kind in tyInt .. tyInt32) + let fromUint = (src.kind in tyUInt .. tyUInt32) + + if toUint and (fromInt or fromUint): + let trimmer = unsignedTrimmer(dest.size) + r.res = "($1 $2)" % [r.res, trimmer] + elif toInt: + if fromInt: + let trimmer = unsignedTrimmer(dest.size) + r.res = "($1 $2)" % [r.res, trimmer] + elif fromUint: + if src.size == 4 and dest.size == 4: + # XXX prevent multi evaluations + r.res = "($1|0)" % [r.res] | + "($1>(float)2147483647?(int)$1-4294967296:$1)" % [r.res] + else: + let trimmer = unsignedTrimmer(dest.size) + let minuend = case dest.size + of 1: "0xfe" + of 2: "0xfffe" + of 4: "0xfffffffe" + else: "" + r.res = "($1 - ($2 $3))" % [rope minuend, r.res, trimmer] + proc gen(p: PProc, n: PNode, r: var TCompRes) = r.typ = etyNone - r.kind = resNone + if r.kind != resCallee: r.kind = resNone #r.address = nil r.res = nil case n.kind of nkSym: genSym(p, n, r) - of nkCharLit..nkInt64Lit: - r.res = rope(n.intVal) + of nkCharLit..nkUInt32Lit: + if n.typ.kind == tyBool: + r.res = if n.intVal == 0: rope"false" else: rope"true" + else: + r.res = rope(n.intVal) r.kind = resExpr of nkNilLit: if isEmptyType(n.typ): discard - elif mapType(n.typ) == etyBaseIndex: + elif mapType(p, n.typ) == etyBaseIndex: r.typ = etyBaseIndex - r.address = rope"null" | rope"nil" + r.address = rope"null" r.res = rope"0" r.kind = resExpr else: - r.res = rope"null" | rope"nil" + r.res = rope"null" r.kind = resExpr of nkStrLit..nkTripleStrLit: - if skipTypes(n.typ, abstractVarRange).kind == tyString: - useMagic(p, "cstrToNimstr") - r.res = "cstrToNimstr($1)" % [makeJSString(n.strVal)] + if skipTypes(n.typ, abstractVarRange).kind == tyString and + p.target == targetJS: + useMagic(p, "makeNimstrLit") + r.res = "makeNimstrLit($1)" % [makeJSString(n.strVal)] else: - r.res = makeJSString(n.strVal) + r.res = makeJSString(n.strVal, false) r.kind = resExpr of nkFloatLit..nkFloat64Lit: let f = n.floatVal @@ -1650,19 +1993,24 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = genInfixCall(p, n, r) else: genCall(p, n, r) + of nkClosure: gen(p, n[0], r) of nkCurly: genSetConstr(p, n, r) of nkBracket: genArrayConstr(p, n, r) of nkPar: genTupleConstr(p, n, r) of nkObjConstr: genObjConstr(p, n, r) of nkHiddenStdConv, nkHiddenSubConv, nkConv: genConv(p, n, r) - of nkAddr, nkHiddenAddr: genAddr(p, n, r) + of nkAddr, nkHiddenAddr: + if p.target == targetJS: + genAddr(p, n, r) + else: + gen(p, n.sons[0], r) of nkDerefExpr, nkHiddenDeref: genDeref(p, n, r) of nkBracketExpr: genArrayAccess(p, n, r) of nkDotExpr: genFieldAccess(p, n, r) of nkCheckedFieldExpr: genCheckedFieldAccess(p, n, r) of nkObjDownConv: gen(p, n.sons[0], r) of nkObjUpConv: upConv(p, n, r) - of nkCast: gen(p, n.sons[1], r) + of nkCast: genCast(p, n, r) of nkChckRangeF: genRangeChck(p, n, r, "chckRangeF") of nkChckRange64: genRangeChck(p, n, r, "chckRange64") of nkChckRange: genRangeChck(p, n, r, "chckRange") @@ -1671,7 +2019,7 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = of nkEmpty: discard of nkLambdaKinds: let s = n.sons[namePos].sym - discard mangleName(s) + discard mangleName(s, p.target) r.res = s.loc.r if lfNoDecl in s.loc.flags or s.magic != mNone: discard elif not p.g.generatedSyms.containsOrIncl(s.id): @@ -1695,9 +2043,7 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = of nkConstSection: discard of nkForStmt, nkParForStmt: internalError(n.info, "for statement not eliminated") - of nkCaseStmt: - if p.target == targetJS: genCaseJS(p, n, r) - else: genCaseLua(p, n, r) + of nkCaseStmt: genCaseJS(p, n, r) of nkReturnStmt: genReturnStmt(p, n) of nkBreakStmt: genBreakStmt(p, n) of nkAsgn: genAsgn(p, n) @@ -1728,25 +2074,43 @@ var globals: PGlobals proc newModule(module: PSym): BModule = new(result) result.module = module - if globals == nil: globals = newGlobals() - -proc genHeader(): Rope = - result = ("/* Generated by the Nim Compiler v$1 */$n" & - "/* (c) 2015 Andreas Rumpf */$n$n" & - "var framePtr = null;$n" & - "var excHandler = 0;$n" & - "var lastJSError = null;$n") % - [rope(VersionAsString)] + if globals == nil: + globals = newGlobals() + +proc genHeader(target: TTarget): Rope = + if target == targetJS: + result = ( + "/* Generated by the Nim Compiler v$1 */$n" & + "/* (c) 2016 Andreas Rumpf */$n$n" & + "var framePtr = null;$n" & + "var excHandler = 0;$n" & + "var lastJSError = null;$n" & + "if (typeof Int8Array === 'undefined') Int8Array = Array;$n" & + "if (typeof Int16Array === 'undefined') Int16Array = Array;$n" & + "if (typeof Int32Array === 'undefined') Int32Array = Array;$n" & + "if (typeof Uint8Array === 'undefined') Uint8Array = Array;$n" & + "if (typeof Uint16Array === 'undefined') Uint16Array = Array;$n" & + "if (typeof Uint32Array === 'undefined') Uint32Array = Array;$n" & + "if (typeof Float32Array === 'undefined') Float32Array = Array;$n" & + "if (typeof Float64Array === 'undefined') Float64Array = Array;$n") % + [rope(VersionAsString)] + else: + result = ("<?php$n" & + "/* Generated by the Nim Compiler v$1 */$n" & + "/* (c) 2016 Andreas Rumpf */$n$n" & + "$$framePtr = null;$n" & + "$$excHandler = 0;$n" & + "$$lastJSError = null;$n") % + [rope(VersionAsString)] proc genModule(p: PProc, n: PNode) = if optStackTrace in p.options: - addf(p.body, "var F = {procname:$1,prev:framePtr,filename:$2,line:0};$n" & - "framePtr = F;$n", [ + add(p.body, frameCreate(p, makeJSString("module " & p.module.module.name.s), - makeJSString(toFilename(p.module.module.info))]) + makeJSString(toFilename(p.module.module.info)))) genStmt(p, n) if optStackTrace in p.options: - addf(p.body, "framePtr = framePtr.prev;$n", []) + add(p.body, frameDestroy(p)) proc myProcess(b: PPassContext, n: PNode): PNode = if passes.skipCodegen(n): return n @@ -1754,44 +2118,78 @@ proc myProcess(b: PPassContext, n: PNode): PNode = var m = BModule(b) if m.module == nil: internalError(n.info, "myProcess") var p = newProc(globals, m, nil, m.module.options) + p.unique = globals.unique genModule(p, n) add(p.g.code, p.locals) add(p.g.code, p.body) + globals.unique = p.unique proc wholeCode*(m: BModule): Rope = for prc in globals.forwarded: if not globals.generatedSyms.containsOrIncl(prc.id): var p = newProc(globals, m, nil, m.module.options) - add(p.g.code, genProc(p, prc)) + attachProc(p, prc) var disp = generateMethodDispatchers() for i in 0..sonsLen(disp)-1: let prc = disp.sons[i].sym if not globals.generatedSyms.containsOrIncl(prc.id): var p = newProc(globals, m, nil, m.module.options) - add(p.g.code, genProc(p, prc)) - - result = globals.typeInfo & globals.code + attachProc(p, prc) + + result = globals.typeInfo & globals.constants & globals.code + +proc getClassName(t: PType): Rope = + var s = t.sym + if s.isNil or sfAnon in s.flags: + s = skipTypes(t, abstractPtrs).sym + if s.isNil or sfAnon in s.flags: + internalError("cannot retrieve class name") + if s.loc.r != nil: result = s.loc.r + else: result = rope(s.name.s) + +proc genClass(obj: PType; content: Rope; ext: string) = + let cls = getClassName(obj) + let t = skipTypes(obj, abstractPtrs) + let extends = if t.kind == tyObject and t.sons[0] != nil: + " extends " & getClassName(t.sons[0]) + else: nil + let result = ("<?php$n" & + "/* Generated by the Nim Compiler v$# */$n" & + "/* (c) 2016 Andreas Rumpf */$n$n" & + "require_once \"nimsystem.php\";$n" & + "class $#$# {$n$#$n}$n") % + [rope(VersionAsString), cls, extends, content] + + let outfile = changeFileExt(completeCFilePath($cls), ext) + discard writeRopeIfNotEqual(result, outfile) proc myClose(b: PPassContext, n: PNode): PNode = if passes.skipCodegen(n): return n result = myProcess(b, n) var m = BModule(b) if sfMainModule in m.module.flags: + let ext = if m.target == targetJS: "js" else: "php" + let f = if globals.classes.len == 0: m.module.filename + else: "nimsystem" let code = wholeCode(m) let outfile = if options.outFile.len > 0: if options.outFile.isAbsolute: options.outFile else: getCurrentDir() / options.outFile else: - changeFileExt(completeCFilePath(m.module.filename), "js") - discard writeRopeIfNotEqual(genHeader() & code, outfile) + changeFileExt(completeCFilePath(f), ext) + discard writeRopeIfNotEqual(genHeader(m.target) & code, outfile) + for obj, content in items(globals.classes): + genClass(obj, content, ext) proc myOpenCached(s: PSym, rd: PRodReader): PPassContext = internalError("symbol files are not possible with the JS code generator") result = nil proc myOpen(s: PSym): PPassContext = - result = newModule(s) + var r = newModule(s) + r.target = if gCmd == cmdCompileToPHP: targetPHP else: targetJS + result = r const JSgenPass* = makePass(myOpen, myOpenCached, myProcess, myClose) diff --git a/compiler/jstypes.nim b/compiler/jstypes.nim index 832d9996c..8d109e48a 100644 --- a/compiler/jstypes.nim +++ b/compiler/jstypes.nim @@ -34,7 +34,8 @@ proc genObjectFields(p: PProc, typ: PType, n: PNode): Rope = s = genTypeInfo(p, field.typ) result = ("{kind: 1, offset: \"$1\", len: 0, " & "typ: $2, name: $3, sons: null}") % - [mangleName(field), s, makeJSString(field.name.s)] + [mangleName(field, p.target), s, + makeJSString(field.name.s)] of nkRecCase: length = sonsLen(n) if (n.sons[0].kind != nkSym): internalError(n.info, "genObjectFields") @@ -61,7 +62,8 @@ proc genObjectFields(p: PProc, typ: PType, n: PNode): Rope = addf(result, "[SetConstr($1), $2]", [u, genObjectFields(p, typ, lastSon(b))]) result = ("{kind: 3, offset: \"$1\", len: $3, " & - "typ: $2, name: $4, sons: [$5]}") % [mangleName(field), s, + "typ: $2, name: $4, sons: [$5]}") % [ + mangleName(field, p.target), s, rope(lengthOrd(field.typ)), makeJSString(field.name.s), result] else: internalError(n.info, "genObjectFields") @@ -115,13 +117,32 @@ proc genEnumInfo(p: PProc, typ: PType, name: Rope) = addf(p.g.typeInfo, "$1.base = $2;$n", [name, genTypeInfo(p, typ.sons[0])]) +proc genEnumInfoPHP(p: PProc; t: PType): Rope = + let t = t.skipTypes({tyGenericInst, tyDistinct}) + result = "$$NTI$1" % [rope(t.id)] + p.declareGlobal(t.id, result) + if containsOrIncl(p.g.typeInfoGenerated, t.id): return + + let length = sonsLen(t.n) + var s: Rope = nil + for i in countup(0, length - 1): + if (t.n.sons[i].kind != nkSym): internalError(t.n.info, "genEnumInfo") + let field = t.n.sons[i].sym + if i > 0: add(s, ", " & tnl) + let extName = if field.ast == nil: field.name.s else: field.ast.strVal + addf(s, "$# => $#$n", + [rope(field.position), makeJSString(extName)]) + prepend(p.g.typeInfo, "$$$# = $#;$n" % [result, s]) + proc genTypeInfo(p: PProc, typ: PType): Rope = - let t = typ.skipTypes({tyGenericInst}) + if p.target == targetPHP: + return makeJSString(typeToString(typ, preferModuleInfo)) + let t = typ.skipTypes({tyGenericInst, tyDistinct}) result = "NTI$1" % [rope(t.id)] if containsOrIncl(p.g.typeInfoGenerated, t.id): return case t.kind of tyDistinct: - result = genTypeInfo(p, typ.sons[0]) + result = genTypeInfo(p, t.sons[0]) of tyPointer, tyProc, tyBool, tyChar, tyCString, tyString, tyInt..tyUInt64: var s = "var $1 = {size: 0,kind: $2,base: null,node: null,finalizer: null};$n" % @@ -133,7 +154,7 @@ proc genTypeInfo(p: PProc, typ: PType): Rope = [result, rope(ord(t.kind))] prepend(p.g.typeInfo, s) addf(p.g.typeInfo, "$1.base = $2;$n", - [result, genTypeInfo(p, typ.lastSon)]) + [result, genTypeInfo(p, t.lastSon)]) of tyArrayConstr, tyArray: var s = "var $1 = {size: 0,kind: $2,base: null,node: null,finalizer: null};$n" % diff --git a/compiler/lambdalifting.nim b/compiler/lambdalifting.nim index cccc94756..753602c80 100644 --- a/compiler/lambdalifting.nim +++ b/compiler/lambdalifting.nim @@ -11,7 +11,7 @@ import intsets, strutils, lists, options, ast, astalgo, trees, treetab, msgs, os, - idents, renderer, types, magicsys, rodread, lowerings + idents, renderer, types, magicsys, rodread, lowerings, tables discard """ The basic approach is that captured vars need to be put on the heap and @@ -113,43 +113,19 @@ discard """ # local storage requirements for efficiency. This means closure iterators # have slightly different semantics from ordinary closures. +# ---------------- essential helpers ------------------------------------- const upName* = ":up" # field name for the 'up' reference paramName* = ":envP" envName* = ":env" -type - POuterContext = ref TOuterContext - - TIter = object - fn, closureParam, state, resultSym: PSym # most are only valid if - # fn.kind == skClosureIterator - obj: PType - - PEnv = ref TEnv - TEnv {.final.} = object of RootObj - attachedNode, replacementNode: PNode - createdVar: PNode # if != nil it is a used environment; for closure - # iterators this can be 'envParam.env' - createdVarComesFromIter: bool - capturedVars: seq[PSym] # captured variables in this environment - up, next: PEnv # outer scope and next to keep all in a list - upField: PSym # if != nil the dependency to the outer scope is used - obj: PType - fn: PSym # function that belongs to this scope; - # if up.fn != fn then we cross function boundaries. - # This is an important case to consider. - vars: IntSet # variables belonging to this environment - - TOuterContext = object - fn: PSym # may also be a module! - head: PEnv - capturedVars, processed: IntSet - localsToAccess: TIdNodeTable - lambdasToEnv: TIdTable # PSym->PEnv mapping - -proc getStateType(iter: PSym): PType = +proc newCall(a: PSym, b: PNode): PNode = + result = newNodeI(nkCall, a.info) + result.add newSymNode(a) + result.add b + +proc createStateType(iter: PSym): PType = var n = newNodeI(nkRange, iter.info) addSon(n, newIntNode(nkIntLit, -1)) addSon(n, newIntNode(nkIntLit, 0)) @@ -161,7 +137,7 @@ proc getStateType(iter: PSym): PType = proc createStateField(iter: PSym): PSym = result = newSym(skField, getIdent(":state"), iter, iter.info) - result.typ = getStateType(iter) + result.typ = createStateType(iter) proc createEnvObj(owner: PSym): PType = # YYY meh, just add the state field for every closure for now, it's too @@ -169,7 +145,7 @@ proc createEnvObj(owner: PSym): PType = result = createObj(owner, owner.info) rawAddField(result, createStateField(owner)) -proc newIterResult(iter: PSym): PSym = +proc getIterResult(iter: PSym): PSym = if resultPos < iter.ast.len: result = iter.ast.sons[resultPos].sym else: @@ -186,513 +162,445 @@ proc addHiddenParam(routine: PSym, param: PSym) = # some nkEffect node: param.position = routine.typ.n.len-1 addSon(params, newSymNode(param)) - incl(routine.typ.flags, tfCapturesEnv) + #incl(routine.typ.flags, tfCapturesEnv) assert sfFromGeneric in param.flags - #echo "produced environment: ", param.id, " for ", routine.name.s + #echo "produced environment: ", param.id, " for ", routine.id proc getHiddenParam(routine: PSym): PSym = let params = routine.ast.sons[paramsPos] let hidden = lastSon(params) - internalAssert hidden.kind == nkSym and hidden.sym.kind == skParam - result = hidden.sym - assert sfFromGeneric in result.flags + if hidden.kind == nkSym and hidden.sym.kind == skParam and hidden.sym.name.s == paramName: + result = hidden.sym + assert sfFromGeneric in result.flags + else: + # writeStackTrace() + localError(routine.info, "internal error: could not find env param for " & routine.name.s) + result = routine -proc getEnvParam(routine: PSym): PSym = +proc getEnvParam*(routine: PSym): PSym = let params = routine.ast.sons[paramsPos] let hidden = lastSon(params) if hidden.kind == nkSym and hidden.sym.name.s == paramName: result = hidden.sym assert sfFromGeneric in result.flags -proc initIter(iter: PSym): TIter = - result.fn = iter - if iter.kind == skClosureIterator: - var cp = getEnvParam(iter) - if cp == nil: - result.obj = createEnvObj(iter) - - cp = newSym(skParam, getIdent(paramName), iter, iter.info) - incl(cp.flags, sfFromGeneric) - cp.typ = newType(tyRef, iter) - rawAddSon(cp.typ, result.obj) - addHiddenParam(iter, cp) - else: - result.obj = cp.typ.sons[0] - assert result.obj.kind == tyObject - internalAssert result.obj.n.len > 0 - result.state = result.obj.n[0].sym - result.closureParam = cp - if iter.typ.sons[0] != nil: - result.resultSym = newIterResult(iter) - #iter.ast.add(newSymNode(c.resultSym)) - -proc newOuterContext(fn: PSym): POuterContext = - new(result) - result.fn = fn - result.capturedVars = initIntSet() - result.processed = initIntSet() - initIdNodeTable(result.localsToAccess) - initIdTable(result.lambdasToEnv) - -proc newEnv(o: POuterContext; up: PEnv, n: PNode; owner: PSym): PEnv = - new(result) - result.capturedVars = @[] - result.up = up - result.attachedNode = n - result.fn = owner - result.vars = initIntSet() - result.next = o.head - o.head = result - if owner.kind != skModule and (up == nil or up.fn != owner): - let param = getEnvParam(owner) - if param != nil: - result.obj = param.typ.sons[0] - assert result.obj.kind == tyObject - if result.obj.isNil: - result.obj = createEnvObj(owner) - -proc addCapturedVar(e: PEnv, v: PSym) = - for x in e.capturedVars: - if x == v: return - e.capturedVars.add(v) - addField(e.obj, v) - -proc newCall(a: PSym, b: PNode): PNode = - result = newNodeI(nkCall, a.info) - result.add newSymNode(a) - result.add b - -proc isInnerProc(s, outerProc: PSym): bool = - if s.kind in {skProc, skMethod, skConverter, skClosureIterator}: - var owner = s.skipGenericOwner - while true: - if owner.isNil: return false - if owner == outerProc: return true - owner = owner.owner - #s.typ.callConv == ccClosure - -proc addClosureParam(fn: PSym; e: PEnv) = - var cp = getEnvParam(fn) - if cp == nil: - cp = newSym(skParam, getIdent(paramName), fn, fn.info) - incl(cp.flags, sfFromGeneric) - cp.typ = newType(tyRef, fn) - rawAddSon(cp.typ, e.obj) - addHiddenParam(fn, cp) - #else: - #cp.typ.sons[0] = e.obj - #assert e.obj.kind == tyObject +proc interestingVar(s: PSym): bool {.inline.} = + result = s.kind in {skVar, skLet, skTemp, skForVar, skParam, skResult} and + sfGlobal notin s.flags proc illegalCapture(s: PSym): bool {.inline.} = result = skipTypes(s.typ, abstractInst).kind in {tyVar, tyOpenArray, tyVarargs} or s.kind == skResult -proc interestingVar(s: PSym): bool {.inline.} = - result = s.kind in {skVar, skLet, skTemp, skForVar, skParam, skResult} and - sfGlobal notin s.flags +proc isInnerProc(s: PSym): bool = + if s.kind in {skProc, skMethod, skConverter, skIterator} and s.magic == mNone: + result = s.skipGenericOwner.kind in routineKinds -proc nestedAccess(top: PEnv; local: PSym): PNode = - # Parts after the transformation are in []: - # - # proc main = - # var [:env.]foo = 23 - # proc outer(:paramO) = - # [var :envO; createClosure(:envO); :envO.up = paramO] - # proc inner(:paramI) = - # echo [:paramI.up.]foo - # inner([:envO]) - # outer([:env]) - if not interestingVar(local) or top.fn == local.owner: - return nil - # check it's in fact a captured variable: - var it = top - while it != nil: - if it.vars.contains(local.id): break - it = it.up - if it == nil: return nil - let envParam = top.fn.getEnvParam - internalAssert(not envParam.isNil) - var access = newSymNode(envParam) - it = top.up - while it != nil: - if it.vars.contains(local.id): - access = indirectAccess(access, local, local.info) - return access - internalAssert it.upField != nil - access = indirectAccess(access, it.upField, local.info) - it = it.up - when false: - # Type based expression construction works too, but turned out to hide - # other bugs: - while true: - let obj = access.typ.sons[0] - let field = getFieldFromObj(obj, local) - if field != nil: - return rawIndirectAccess(access, field, local.info) - let upField = lookupInRecord(obj.n, getIdent(upName)) - if upField == nil: break - access = rawIndirectAccess(access, upField, local.info) - return nil - -proc createUpField(obj, fieldType: PType): PSym = - let pos = obj.n.len - result = newSym(skField, getIdent(upName), obj.owner, obj.owner.info) - result.typ = newType(tyRef, obj.owner) - result.position = pos - rawAddSon(result.typ, fieldType) - #rawAddField(obj, result) - addField(obj, result) - -proc captureVar(o: POuterContext; top: PEnv; local: PSym; - info: TLineInfo): bool = - # first check if we should be concerned at all: - var it = top - while it != nil: - if it.vars.contains(local.id): break - it = it.up - if it == nil: return false - # yes, so mark every 'up' pointer as taken: - if illegalCapture(local) or top.fn.typ.callConv notin {ccClosure, ccDefault}: - localError(info, errIllegalCaptureX, local.name.s) - it = top - while it != nil: - if it.vars.contains(local.id): break - # keep in mind that the first element of the chain belong to top.fn itself - # and these don't need any upFields - if it.upField == nil and it.up != nil and it.fn != top.fn: - it.upField = createUpField(it.obj, it.up.obj) - - if it.fn != local.owner: - it.fn.typ.callConv = ccClosure - incl(it.fn.typ.flags, tfCapturesEnv) - - var u = it.up - while u != nil and u.fn == it.fn: u = u.up - addClosureParam(it.fn, u) - - if idTableGet(o.lambdasToEnv, it.fn) == nil: - if u != nil: idTablePut(o.lambdasToEnv, it.fn, u) - - it = it.up - # don't do this: 'top' might not require a closure: - #if idTableGet(o.lambdasToEnv, it.fn) == nil: - # idTablePut(o.lambdasToEnv, it.fn, top) - - # mark as captured: - #if top.iter != nil: - # if not containsOrIncl(o.capturedVars, local.id): - # #addField(top.iter.obj, local) - # addCapturedVar(it, local) - #else: - incl(o.capturedVars, local.id) - addCapturedVar(it, local) - result = true - -proc semCaptureSym*(s, owner: PSym) = - if interestingVar(s) and owner.id != s.owner.id and s.kind != skResult: - if owner.typ != nil and not isGenericRoutine(owner): - # XXX: is this really safe? - # if we capture a var from another generic routine, - # it won't be consider captured. - owner.typ.callConv = ccClosure - #echo "semCaptureSym ", owner.name.s, owner.id, " ", s.name.s, s.id - # since the analysis is not entirely correct, we don't set 'tfCapturesEnv' - # here +proc newAsgnStmt(le, ri: PNode, info: TLineInfo): PNode = + # Bugfix: unfortunately we cannot use 'nkFastAsgn' here as that would + # mean to be able to capture string literals which have no GC header. + # However this can only happen if the capture happens through a parameter, + # which is however the only case when we generate an assignment in the first + # place. + result = newNodeI(nkAsgn, info, 2) + result.sons[0] = le + result.sons[1] = ri -proc gatherVars(o: POuterContext; e: PEnv; n: PNode): int = - # gather used vars for closure generation; returns number of captured vars - if n == nil: return 0 - case n.kind - of nkSym: - var s = n.sym - if interestingVar(s) and e.fn != s.owner: - if captureVar(o, e, s, n.info): result = 1 - of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit, nkClosure, nkProcDef, - nkMethodDef, nkConverterDef, nkMacroDef, nkTemplateDef, nkTypeSection: - discard - else: - for k in countup(0, sonsLen(n) - 1): - result += gatherVars(o, e, n.sons[k]) - -proc generateThunk(prc: PNode, dest: PType): PNode = - ## Converts 'prc' into '(thunk, nil)' so that it's compatible with - ## a closure. - - # we cannot generate a proper thunk here for GC-safety reasons (see internal - # documentation): - if gCmd == cmdCompileToJS: return prc - result = newNodeIT(nkClosure, prc.info, dest) - var conv = newNodeIT(nkHiddenStdConv, prc.info, dest) - conv.add(emptyNode) - conv.add(prc) - result.add(conv) - result.add(newNodeIT(nkNilLit, prc.info, getSysType(tyNil))) - -proc transformOuterConv(n: PNode): PNode = - # numeric types need range checks: - var dest = skipTypes(n.typ, abstractVarRange) - var source = skipTypes(n.sons[1].typ, abstractVarRange) - if dest.kind == tyProc: - if dest.callConv == ccClosure and source.callConv == ccDefault: - result = generateThunk(n.sons[1], dest) - -proc makeClosure(prc: PSym; env: PNode; info: TLineInfo): PNode = +proc makeClosure*(prc: PSym; env: PNode; info: TLineInfo): PNode = result = newNodeIT(nkClosure, info, prc.typ) result.add(newSymNode(prc)) if env == nil: result.add(newNodeIT(nkNilLit, info, getSysType(tyNil))) else: + if env.skipConv.kind == nkClosure: + localError(info, "internal error: taking closure of closure") result.add(env) -proc newClosureCreationVar(e: PEnv): PNode = - var v = newSym(skVar, getIdent(envName), e.fn, e.attachedNode.info) - incl(v.flags, sfShadowed) - v.typ = newType(tyRef, e.fn) - v.typ.rawAddSon(e.obj) - if e.fn.kind == skClosureIterator: - let it = initIter(e.fn) - addUniqueField(it.obj, v) - result = indirectAccess(newSymNode(it.closureParam), v, v.info) +proc interestingIterVar(s: PSym): bool {.inline.} = + # XXX optimization: Only lift the variable if it lives across + # yield/return boundaries! This can potentially speed up + # closure iterators quite a bit. + result = s.kind in {skVar, skLet, skTemp, skForVar} and sfGlobal notin s.flags + +template isIterator*(owner: PSym): bool = + owner.kind == skIterator and owner.typ.callConv == ccClosure + +proc liftIterSym*(n: PNode; owner: PSym): PNode = + # transforms (iter) to (let env = newClosure[iter](); (iter, env)) + let iter = n.sym + assert iter.isIterator + + result = newNodeIT(nkStmtListExpr, n.info, n.typ) + + let hp = getHiddenParam(iter) + let env = newSym(skLet, iter.name, owner, n.info) + env.typ = hp.typ + env.flags = hp.flags + var v = newNodeI(nkVarSection, n.info) + addVar(v, newSymNode(env)) + result.add(v) + # add 'new' statement: + let envAsNode = env.newSymNode + result.add newCall(getSysSym"internalNew", envAsNode) + result.add makeClosure(iter, envAsNode, n.info) + +proc freshVarForClosureIter*(s, owner: PSym): PNode = + let envParam = getHiddenParam(owner) + let obj = envParam.typ.lastSon + addField(obj, s) + + var access = newSymNode(envParam) + assert obj.kind == tyObject + let field = getFieldFromObj(obj, s) + if field != nil: + result = rawIndirectAccess(access, field, s.info) else: - result = newSymNode(v) + localError(s.info, "internal error: cannot generate fresh variable") + result = access + +# ------------------ new stuff ------------------------------------------- + +proc markAsClosure(owner: PSym; n: PNode) = + let s = n.sym + if illegalCapture(s) or owner.typ.callConv notin {ccClosure, ccDefault}: + localError(n.info, errIllegalCaptureX, s.name.s) + incl(owner.typ.flags, tfCapturesEnv) + owner.typ.callConv = ccClosure -proc getClosureVar(e: PEnv): PNode = - if e.createdVar == nil: - result = newClosureCreationVar(e) - e.createdVar = result +type + DetectionPass = object + processed, capturedVars: IntSet + ownerToType: Table[int, PType] + somethingToDo: bool + +proc initDetectionPass(fn: PSym): DetectionPass = + result.processed = initIntSet() + result.capturedVars = initIntSet() + result.ownerToType = initTable[int, PType]() + result.processed.incl(fn.id) + +discard """ +proc outer = + var a, b: int + proc innerA = use(a) + proc innerB = use(b); innerA() +# --> innerA and innerB need to *share* the closure type! +This is why need to store the 'ownerToType' table and use it +during .closure'fication. +""" + +proc getEnvTypeForOwner(c: var DetectionPass; owner: PSym): PType = + result = c.ownerToType.getOrDefault(owner.id) + if result.isNil: + result = newType(tyRef, owner) + let obj = createEnvObj(owner) + rawAddSon(result, obj) + c.ownerToType[owner.id] = result + +proc createUpField(c: var DetectionPass; dest, dep: PSym) = + let refObj = c.getEnvTypeForOwner(dest) # getHiddenParam(dest).typ + let obj = refObj.lastSon + let fieldType = c.getEnvTypeForOwner(dep) #getHiddenParam(dep).typ + if refObj == fieldType: + localError(dep.info, "internal error: invalid up reference computed") + + let upIdent = getIdent(upName) + let upField = lookupInRecord(obj.n, upIdent) + if upField != nil: + if upField.typ != fieldType: + localError(dep.info, "internal error: up references do not agree") else: - result = e.createdVar - -proc findEnv(o: POuterContext; s: PSym): PEnv = - var env = o.head - while env != nil: - if env.fn == s: break - env = env.next - internalAssert env != nil and env.up != nil - result = env.up - while result.fn == s: result = result.up - -proc transformInnerProc(o: POuterContext; e: PEnv, n: PNode): PNode = + let result = newSym(skField, upIdent, obj.owner, obj.owner.info) + result.typ = fieldType + rawAddField(obj, result) + +discard """ +There are a couple of possibilities of how to implement closure +iterators that capture outer variables in a traditional sense +(aka closure closure iterators). + +1. Transform iter() to iter(state, capturedEnv). So use 2 hidden + parameters. +2. Add the captured vars directly to 'state'. +3. Make capturedEnv an up-reference of 'state'. + +We do (3) here because (2) is obviously wrong and (1) is wrong too. +Consider: + + proc outer = + var xx = 9 + + iterator foo() = + var someState = 3 + + proc bar = echo someState + proc baz = someState = 0 + baz() + bar() + +""" + +proc addClosureParam(c: var DetectionPass; fn: PSym) = + var cp = getEnvParam(fn) + let owner = if fn.kind == skIterator: fn else: fn.skipGenericOwner + let t = c.getEnvTypeForOwner(owner) + if cp == nil: + cp = newSym(skParam, getIdent(paramName), fn, fn.info) + incl(cp.flags, sfFromGeneric) + cp.typ = t + addHiddenParam(fn, cp) + elif cp.typ != t and fn.kind != skIterator: + localError(fn.info, "internal error: inconsistent environment type") + #echo "adding closure to ", fn.name.s + +proc detectCapturedVars(n: PNode; owner: PSym; c: var DetectionPass) = case n.kind - of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit: discard of nkSym: let s = n.sym - if s == e.fn: - # recursive calls go through (lambda, hiddenParam): - result = makeClosure(s, getEnvParam(s).newSymNode, n.info) - elif isInnerProc(s, o.fn) and s.typ.callConv == ccClosure: - # ugh: call to some other inner proc; - result = makeClosure(s, findEnv(o, s).getClosureVar, n.info) - else: - # captured symbol? - result = nestedAccess(e, n.sym) - #result = idNodeTableGet(i.localsToAccess, n.sym) - #of nkLambdaKinds, nkIteratorDef: - # if n.typ != nil: - # result = transformInnerProc(o, e, n.sons[namePos]) - #of nkClosure: - # let x = transformInnerProc(o, e, n.sons[0]) - # if x != nil: n.sons[0] = x - of nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef, nkTemplateDef, - nkLambdaKinds, nkIteratorDef, nkClosure: - # don't recurse here: + if s.kind in {skProc, skMethod, skConverter, skIterator} and s.typ != nil and s.typ.callConv == ccClosure: + # this handles the case that the inner proc was declared as + # .closure but does not actually capture anything: + addClosureParam(c, s) + c.somethingToDo = true + + let innerProc = isInnerProc(s) + if innerProc: + if s.isIterator: c.somethingToDo = true + if not c.processed.containsOrIncl(s.id): + detectCapturedVars(s.getBody, s, c) + let ow = s.skipGenericOwner + if ow == owner: + if owner.isIterator: + c.somethingToDo = true + addClosureParam(c, owner) + if interestingIterVar(s): + if not c.capturedVars.containsOrIncl(s.id): + let obj = getHiddenParam(owner).typ.lastSon + #let obj = c.getEnvTypeForOwner(s.owner).lastSon + addField(obj, s) + # but always return because the rest of the proc is only relevant when + # ow != owner: + return + # direct or indirect dependency: + if (innerProc and s.typ.callConv == ccClosure) or interestingVar(s): + discard """ + proc outer() = + var x: int + proc inner() = + proc innerInner() = + echo x + innerInner() + inner() + # inner() takes a closure too! + """ + # mark 'owner' as taking a closure: + c.somethingToDo = true + markAsClosure(owner, n) + addClosureParam(c, owner) + #echo "capturing ", n.info + # variable 's' is actually captured: + if interestingVar(s) and not c.capturedVars.containsOrIncl(s.id): + let obj = c.getEnvTypeForOwner(ow).lastSon + #getHiddenParam(owner).typ.lastSon + addField(obj, s) + # create required upFields: + var w = owner.skipGenericOwner + if isInnerProc(w) or owner.isIterator: + if owner.isIterator: w = owner + let last = if ow.isIterator: ow.skipGenericOwner else: ow + while w != nil and w.kind != skModule and last != w: + discard """ + proc outer = + var a, b: int + proc outerB = + proc innerA = use(a) + proc innerB = use(b); innerA() + # --> make outerB of calling convention .closure and + # give it the same env type that outer's env var gets: + """ + let up = w.skipGenericOwner + #echo "up for ", w.name.s, " up ", up.name.s + markAsClosure(w, n) + addClosureParam(c, w) # , ow + createUpField(c, w, up) + w = up + of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit, + nkTemplateDef, nkTypeSection: discard - else: - for j in countup(0, sonsLen(n) - 1): - let x = transformInnerProc(o, e, n.sons[j]) - if x != nil: n.sons[j] = x - -proc closureCreationPoint(n: PNode): PNode = - if n.kind == nkStmtList and n.len >= 1 and n[0].kind == nkEmpty: - # we already have a free slot - result = n - else: - result = newNodeI(nkStmtList, n.info) - result.add(emptyNode) - result.add(n) - #result.flags.incl nfLL - -proc addParamsToEnv(fn: PSym; env: PEnv) = - let params = fn.typ.n - for i in 1.. <params.len: - if params.sons[i].kind != nkSym: - internalError(params.info, "liftLambdas: strange params") - let param = params.sons[i].sym - env.vars.incl(param.id) - # put the 'result' into the environment so it can be captured: - let ast = fn.ast - if resultPos < sonsLen(ast) and ast.sons[resultPos].kind == nkSym: - env.vars.incl(ast.sons[resultPos].sym.id) - -proc searchForInnerProcs(o: POuterContext, n: PNode, env: PEnv) = - if n == nil: return - case n.kind - of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit: + of nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef: discard - of nkSym: - let fn = n.sym - if isInnerProc(fn, o.fn) and not containsOrIncl(o.processed, fn.id): - let body = fn.getBody - - # handle deeply nested captures: - let ex = closureCreationPoint(body) - let envB = newEnv(o, env, ex, fn) - addParamsToEnv(fn, envB) - searchForInnerProcs(o, body, envB) - fn.ast.sons[bodyPos] = ex - - let capturedCounter = gatherVars(o, envB, body) - # dummy closure param needed? - if capturedCounter == 0 and fn.typ.callConv == ccClosure: - #assert tfCapturesEnv notin n.sym.typ.flags - if idTableGet(o.lambdasToEnv, fn) == nil: - idTablePut(o.lambdasToEnv, fn, env) - addClosureParam(fn, env) - - elif fn.getEnvParam != nil: - # only transform if it really needs a closure: - let ti = transformInnerProc(o, envB, body) - if ti != nil: fn.ast.sons[bodyPos] = ti of nkLambdaKinds, nkIteratorDef: if n.typ != nil: - searchForInnerProcs(o, n.sons[namePos], env) - of nkWhileStmt, nkForStmt, nkParForStmt, nkBlockStmt: - # some nodes open a new scope, so they are candidates for the insertion - # of closure creation; however for simplicity we merge closures between - # branches, in fact, only loop bodies are of interest here as only they - # yield observable changes in semantics. For Zahary we also - # include ``nkBlock``. We don't do this for closure iterators because - # 'yield' can produce wrong code otherwise (XXX show example): - if env.fn.kind != skClosureIterator: - var body = n.len-1 - for i in countup(0, body - 1): searchForInnerProcs(o, n.sons[i], env) - # special handling for the loop body: - let ex = closureCreationPoint(n.sons[body]) - searchForInnerProcs(o, n.sons[body], newEnv(o, env, ex, env.fn)) - n.sons[body] = ex - else: - for i in countup(0, sonsLen(n) - 1): - searchForInnerProcs(o, n.sons[i], env) - of nkVarSection, nkLetSection: - # we need to compute a mapping var->declaredBlock. Note: The definition - # counts, not the block where it is captured! - for i in countup(0, sonsLen(n) - 1): - var it = n.sons[i] - if it.kind == nkCommentStmt: discard - elif it.kind == nkIdentDefs: - var L = sonsLen(it) - if it.sons[0].kind == nkSym: - # this can be false for recursive invocations that already - # transformed it into 'env.varName': - env.vars.incl(it.sons[0].sym.id) - searchForInnerProcs(o, it.sons[L-1], env) - elif it.kind == nkVarTuple: - var L = sonsLen(it) - for j in countup(0, L-3): - #echo "set: ", it.sons[j].sym.name.s, " ", o.currentBlock == nil - if it.sons[j].kind == nkSym: - env.vars.incl(it.sons[j].sym.id) - searchForInnerProcs(o, it.sons[L-1], env) - else: - internalError(it.info, "searchForInnerProcs") - of nkClosure: - searchForInnerProcs(o, n.sons[0], env) - of nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef, nkTemplateDef, - nkTypeSection: - # don't recurse here: - discard + detectCapturedVars(n[namePos], owner, c) else: - for i in countup(0, sonsLen(n) - 1): - searchForInnerProcs(o, n.sons[i], env) + for i in 0..<n.len: + detectCapturedVars(n[i], owner, c) -proc newAsgnStmt(le, ri: PNode, info: TLineInfo): PNode = - # Bugfix: unfortunately we cannot use 'nkFastAsgn' here as that would - # mean to be able to capture string literals which have no GC header. - # However this can only happen if the capture happens through a parameter, - # which is however the only case when we generate an assignment in the first - # place. - result = newNodeI(nkAsgn, info, 2) - result.sons[0] = le - result.sons[1] = ri +type + LiftingPass = object + processed: IntSet + envVars: Table[int, PNode] -proc rawClosureCreation(o: POuterContext, scope: PEnv; env: PNode): PNode = - result = newNodeI(nkStmtList, env.info) - if env.kind == nkSym: - var v = newNodeI(nkVarSection, env.info) - addVar(v, env) - result.add(v) - # add 'new' statement: - result.add(newCall(getSysSym"internalNew", env)) - - # add assignment statements: - for local in scope.capturedVars: - let fieldAccess = indirectAccess(env, local, env.info) - if local.kind == skParam: - # maybe later: (sfByCopy in local.flags) - # add ``env.param = param`` - result.add(newAsgnStmt(fieldAccess, newSymNode(local), env.info)) - # it can happen that we already captured 'local' in some other environment - # then we capture by copy for now. This is not entirely correct but better - # than nothing: - let existing = idNodeTableGet(o.localsToAccess, local) - if existing.isNil: - idNodeTablePut(o.localsToAccess, local, fieldAccess) +proc initLiftingPass(fn: PSym): LiftingPass = + result.processed = initIntSet() + result.processed.incl(fn.id) + result.envVars = initTable[int, PNode]() + +proc accessViaEnvParam(n: PNode; owner: PSym): PNode = + let s = n.sym + # Type based expression construction for simplicity: + let envParam = getHiddenParam(owner) + if not envParam.isNil: + var access = newSymNode(envParam) + while true: + let obj = access.typ.sons[0] + assert obj.kind == tyObject + let field = getFieldFromObj(obj, s) + if field != nil: + return rawIndirectAccess(access, field, n.info) + let upField = lookupInRecord(obj.n, getIdent(upName)) + if upField == nil: break + access = rawIndirectAccess(access, upField, n.info) + localError(n.info, "internal error: environment misses: " & s.name.s) + result = n + +proc newEnvVar(owner: PSym; typ: PType): PNode = + var v = newSym(skVar, getIdent(envName), owner, owner.info) + incl(v.flags, sfShadowed) + v.typ = typ + result = newSymNode(v) + when false: + if owner.kind == skIterator and owner.typ.callConv == ccClosure: + let it = getHiddenParam(owner) + addUniqueField(it.typ.sons[0], v) + result = indirectAccess(newSymNode(it), v, v.info) + else: + result = newSymNode(v) + +proc setupEnvVar(owner: PSym; d: DetectionPass; + c: var LiftingPass): PNode = + if owner.isIterator: + return getHiddenParam(owner).newSymNode + result = c.envvars.getOrDefault(owner.id) + if result.isNil: + let envVarType = d.ownerToType.getOrDefault(owner.id) + if envVarType.isNil: + localError owner.info, "internal error: could not determine closure type" + result = newEnvVar(owner, envVarType) + c.envVars[owner.id] = result + +proc getUpViaParam(owner: PSym): PNode = + let p = getHiddenParam(owner) + result = p.newSymNode + if owner.isIterator: + let upField = lookupInRecord(p.typ.lastSon.n, getIdent(upName)) + if upField == nil: + localError(owner.info, "could not find up reference for closure iter") else: - result.add(newAsgnStmt(fieldAccess, existing, env.info)) - if scope.upField != nil: - # "up" chain has been used: - if scope.up.fn != scope.fn: - # crosses function boundary: - result.add(newAsgnStmt(indirectAccess(env, scope.upField, env.info), - newSymNode(getEnvParam(scope.fn)), env.info)) + result = rawIndirectAccess(result, upField, p.info) + +proc rawClosureCreation(owner: PSym; + d: DetectionPass; c: var LiftingPass): PNode = + result = newNodeI(nkStmtList, owner.info) + + var env: PNode + if owner.isIterator: + env = getHiddenParam(owner).newSymNode + else: + env = setupEnvVar(owner, d, c) + if env.kind == nkSym: + var v = newNodeI(nkVarSection, env.info) + addVar(v, env) + result.add(v) + # add 'new' statement: + result.add(newCall(getSysSym"internalNew", env)) + # add assignment statements for captured parameters: + for i in 1..<owner.typ.n.len: + let local = owner.typ.n[i].sym + if local.id in d.capturedVars: + let fieldAccess = indirectAccess(env, local, env.info) + # add ``env.param = param`` + result.add(newAsgnStmt(fieldAccess, newSymNode(local), env.info)) + + let upField = lookupInRecord(env.typ.lastSon.n, getIdent(upName)) + if upField != nil: + let up = getUpViaParam(owner) + if up != nil and upField.typ == up.typ: + result.add(newAsgnStmt(rawIndirectAccess(env, upField, env.info), + up, env.info)) + #elif oldenv != nil and oldenv.typ == upField.typ: + # result.add(newAsgnStmt(rawIndirectAccess(env, upField, env.info), + # oldenv, env.info)) else: - result.add(newAsgnStmt(indirectAccess(env, scope.upField, env.info), - getClosureVar(scope.up), env.info)) - -proc generateClosureCreation(o: POuterContext, scope: PEnv): PNode = - var env = getClosureVar(scope) - result = rawClosureCreation(o, scope, env) - -proc generateIterClosureCreation(o: POuterContext; env: PEnv; - scope: PNode): PNode = - if env.createdVarComesFromIter or env.createdVar.isNil: - # we have to create a new closure: - result = newClosureCreationVar(env) - let cc = rawClosureCreation(o, env, result) - var insertPoint = scope.sons[0] - if insertPoint.kind == nkEmpty: scope.sons[0] = cc + localError(env.info, "internal error: cannot create up reference") + +proc closureCreationForIter(iter: PNode; + d: DetectionPass; c: var LiftingPass): PNode = + result = newNodeIT(nkStmtListExpr, iter.info, iter.sym.typ) + let owner = iter.sym.skipGenericOwner + var v = newSym(skVar, getIdent(envName), owner, iter.info) + incl(v.flags, sfShadowed) + v.typ = getHiddenParam(iter.sym).typ + var vnode: PNode + if owner.isIterator: + let it = getHiddenParam(owner) + addUniqueField(it.typ.sons[0], v) + vnode = indirectAccess(newSymNode(it), v, v.info) + else: + vnode = v.newSymNode + var vs = newNodeI(nkVarSection, iter.info) + addVar(vs, vnode) + result.add(vs) + result.add(newCall(getSysSym"internalNew", vnode)) + + let upField = lookupInRecord(v.typ.lastSon.n, getIdent(upName)) + if upField != nil: + let u = setupEnvVar(owner, d, c) + if u.typ == upField.typ: + result.add(newAsgnStmt(rawIndirectAccess(vnode, upField, iter.info), + u, iter.info)) else: - assert cc.kind == nkStmtList and insertPoint.kind == nkStmtList - for x in cc: insertPoint.add(x) - if env.createdVar == nil: env.createdVar = result + localError(iter.info, "internal error: cannot create up reference for iter") + result.add makeClosure(iter.sym, vnode, iter.info) + +proc accessViaEnvVar(n: PNode; owner: PSym; d: DetectionPass; + c: var LiftingPass): PNode = + let access = setupEnvVar(owner, d, c) + let obj = access.typ.sons[0] + let field = getFieldFromObj(obj, n.sym) + if field != nil: + result = rawIndirectAccess(access, field, n.info) else: - result = env.createdVar - env.createdVarComesFromIter = true + localError(n.info, "internal error: not part of closure object type") + result = n -proc interestingIterVar(s: PSym): bool {.inline.} = - result = s.kind in {skVar, skLet, skTemp, skForVar} and sfGlobal notin s.flags +proc getStateField(owner: PSym): PSym = + getHiddenParam(owner).typ.sons[0].n.sons[0].sym -proc transformOuterProc(o: POuterContext, n: PNode, it: TIter): PNode +proc liftCapturedVars(n: PNode; owner: PSym; d: DetectionPass; + c: var LiftingPass): PNode -proc transformYield(c: POuterContext, n: PNode, it: TIter): PNode = - assert it.state != nil - assert it.state.typ != nil - assert it.state.typ.n != nil - inc it.state.typ.n.sons[1].intVal - let stateNo = it.state.typ.n.sons[1].intVal +proc transformYield(n: PNode; owner: PSym; d: DetectionPass; + c: var LiftingPass): PNode = + let state = getStateField(owner) + assert state != nil + assert state.typ != nil + assert state.typ.n != nil + inc state.typ.n.sons[1].intVal + let stateNo = state.typ.n.sons[1].intVal var stateAsgnStmt = newNodeI(nkAsgn, n.info) - stateAsgnStmt.add(rawIndirectAccess(newSymNode(it.closureParam), - it.state, n.info)) + stateAsgnStmt.add(rawIndirectAccess(newSymNode(getEnvParam(owner)), + state, n.info)) stateAsgnStmt.add(newIntTypeNode(nkIntLit, stateNo, getSysType(tyInt))) var retStmt = newNodeI(nkReturnStmt, n.info) if n.sons[0].kind != nkEmpty: var a = newNodeI(nkAsgn, n.sons[0].info) - var retVal = transformOuterProc(c, n.sons[0], it) - addSon(a, newSymNode(it.resultSym)) - addSon(a, if retVal.isNil: n.sons[0] else: retVal) + var retVal = liftCapturedVars(n.sons[0], owner, d, c) + addSon(a, newSymNode(getIterResult(owner))) + addSon(a, retVal) retStmt.add(a) else: retStmt.add(emptyNode) @@ -705,295 +613,204 @@ proc transformYield(c: POuterContext, n: PNode, it: TIter): PNode = result.add(retStmt) result.add(stateLabelStmt) -proc transformReturn(c: POuterContext, n: PNode, it: TIter): PNode = +proc transformReturn(n: PNode; owner: PSym; d: DetectionPass; + c: var LiftingPass): PNode = + let state = getStateField(owner) result = newNodeI(nkStmtList, n.info) var stateAsgnStmt = newNodeI(nkAsgn, n.info) - stateAsgnStmt.add(rawIndirectAccess(newSymNode(it.closureParam), it.state, - n.info)) + stateAsgnStmt.add(rawIndirectAccess(newSymNode(getEnvParam(owner)), + state, n.info)) stateAsgnStmt.add(newIntTypeNode(nkIntLit, -1, getSysType(tyInt))) result.add(stateAsgnStmt) result.add(n) -proc outerProcSons(o: POuterContext, n: PNode, it: TIter) = - for i in countup(0, sonsLen(n) - 1): - let x = transformOuterProc(o, n.sons[i], it) - if x != nil: n.sons[i] = x - -proc liftIterSym(n: PNode; owner: PSym): PNode = - # transforms (iter) to (let env = newClosure[iter](); (iter, env)) - let iter = n.sym - assert iter.kind == skClosureIterator - - result = newNodeIT(nkStmtListExpr, n.info, n.typ) - - let hp = getHiddenParam(iter) - let env = newSym(skLet, iter.name, owner, n.info) - env.typ = hp.typ - env.flags = hp.flags - var v = newNodeI(nkVarSection, n.info) - addVar(v, newSymNode(env)) - result.add(v) - # add 'new' statement: - let envAsNode = env.newSymNode - result.add newCall(getSysSym"internalNew", envAsNode) - result.add makeClosure(iter, envAsNode, n.info) - -when false: - proc transformRemainingLocals(n: PNode; it: TIter): PNode = - assert it.fn.kind == skClosureIterator - result = n - case n.kind - of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit: discard - of nkSym: - let local = n.sym - if interestingIterVar(local) and it.fn == local.owner: - addUniqueField(it.obj, local) - result = indirectAccess(newSymNode(it.closureParam), local, n.info) - else: - result = newNodeI(n.kind, n.info, n.len) - for i in 0.. <n.safeLen: - result.sons[i] = transformRemainingLocals(n.sons[i], it) - -template envActive(env): expr = - (env.capturedVars.len > 0 or env.upField != nil) - -# We have to split up environment creation in 2 steps: -# 1. Generate it and store it in env.replacementNode -# 2. Insert replacementNode into its forseen slot. -# This split is necessary so that assignments belonging to closure -# creation like 'env.param = param' are not transformed -# into 'env.param = env.param'. -proc createEnvironments(o: POuterContext) = - var env = o.head - while env != nil: - if envActive(env): - var scope = env.attachedNode - assert scope.kind == nkStmtList - if scope.sons[0].kind == nkEmpty: - # prepare for closure construction: - env.replacementNode = generateClosureCreation(o, env) - env = env.next - -proc finishEnvironments(o: POuterContext) = - var env = o.head - while env != nil: - if env.replacementNode != nil: - var scope = env.attachedNode - assert scope.kind == nkStmtList - if scope.sons[0].kind == nkEmpty: - # change the empty node to contain the closure construction: - scope.sons[0] = env.replacementNode - when false: - if env.fn.kind == skClosureIterator: - scope.sons[0] = transformRemainingLocals(env.replacementNode, - initIter(env.fn)) - else: - scope.sons[0] = env.replacementNode - env = env.next - -proc transformOuterProcBody(o: POuterContext, n: PNode; it: TIter): PNode = - if nfLL in n.flags: - result = nil - elif it.fn.kind == skClosureIterator: +proc wrapIterBody(n: PNode; owner: PSym): PNode = + if not owner.isIterator: return n + when false: # unfortunately control flow is still convoluted and we can end up # multiple times here for the very same iterator. We shield against this # with some rather primitive check for now: if n.kind == nkStmtList and n.len > 0: - if n.sons[0].kind == nkGotoState: return nil + if n.sons[0].kind == nkGotoState: return n if n.len > 1 and n[1].kind == nkStmtList and n[1].len > 0 and n[1][0].kind == nkGotoState: - return nil - result = newNodeI(nkStmtList, it.fn.info) - var gs = newNodeI(nkGotoState, it.fn.info) - assert it.closureParam != nil - assert it.state != nil - gs.add(rawIndirectAccess(newSymNode(it.closureParam), it.state, it.fn.info)) - result.add(gs) - var state0 = newNodeI(nkState, it.fn.info) - state0.add(newIntNode(nkIntLit, 0)) - result.add(state0) - - let newBody = transformOuterProc(o, n, it) - if newBody != nil: - result.add(newBody) - else: - result.add(n) - - var stateAsgnStmt = newNodeI(nkAsgn, it.fn.info) - stateAsgnStmt.add(rawIndirectAccess(newSymNode(it.closureParam), - it.state, it.fn.info)) - stateAsgnStmt.add(newIntTypeNode(nkIntLit, -1, getSysType(tyInt))) - result.add(stateAsgnStmt) - result.flags.incl nfLL - else: - result = transformOuterProc(o, n, it) - if result != nil: result.flags.incl nfLL + return n + let info = n.info + result = newNodeI(nkStmtList, info) + var gs = newNodeI(nkGotoState, info) + gs.add(rawIndirectAccess(newSymNode(owner.getHiddenParam), getStateField(owner), info)) + result.add(gs) + var state0 = newNodeI(nkState, info) + state0.add(newIntNode(nkIntLit, 0)) + result.add(state0) + + result.add(n) + + var stateAsgnStmt = newNodeI(nkAsgn, info) + stateAsgnStmt.add(rawIndirectAccess(newSymNode(owner.getHiddenParam), + getStateField(owner), info)) + stateAsgnStmt.add(newIntTypeNode(nkIntLit, -1, getSysType(tyInt))) + result.add(stateAsgnStmt) -proc transformOuterProc(o: POuterContext, n: PNode; it: TIter): PNode = - if n == nil or nfLL in n.flags: return nil +proc symToClosure(n: PNode; owner: PSym; d: DetectionPass; + c: var LiftingPass): PNode = + let s = n.sym + if s == owner: + # recursive calls go through (lambda, hiddenParam): + let available = getHiddenParam(owner) + result = makeClosure(s, available.newSymNode, n.info) + elif s.isIterator: + result = closureCreationForIter(n, d, c) + elif s.skipGenericOwner == owner: + # direct dependency, so use the outer's env variable: + result = makeClosure(s, setupEnvVar(owner, d, c), n.info) + else: + let available = getHiddenParam(owner) + let wanted = getHiddenParam(s).typ + # ugh: call through some other inner proc; + var access = newSymNode(available) + while true: + if access.typ == wanted: + return makeClosure(s, access, n.info) + let obj = access.typ.sons[0] + let upField = lookupInRecord(obj.n, getIdent(upName)) + if upField == nil: + localError(n.info, "internal error: no environment found") + return n + access = rawIndirectAccess(access, upField, n.info) + +proc liftCapturedVars(n: PNode; owner: PSym; d: DetectionPass; + c: var LiftingPass): PNode = + result = n case n.kind - of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit: discard of nkSym: - var local = n.sym - - if isInnerProc(local, o.fn) and o.processed.contains(local.id): - o.processed.excl(local.id) - let body = local.getBody - let newBody = transformOuterProcBody(o, body, initIter(local)) - if newBody != nil: - local.ast.sons[bodyPos] = newBody - - if it.fn.kind == skClosureIterator and interestingIterVar(local) and - it.fn == local.owner: - # every local goes through the closure: - #if not containsOrIncl(o.capturedVars, local.id): - # addField(it.obj, local) - 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) - - if local.kind == skClosureIterator: - # bug #3354; allow for - #iterator iter(): int {.closure.}= - # s.add(iter) - # yield 1 - - #if local == o.fn or local == it.fn: - # message(n.info, errRecursiveDependencyX, local.name.s) - - # consider: [i1, i2, i1] Since we merged the iterator's closure - # with the captured owning variables, we need to generate the - # closure generation code again: - # XXX why doesn't this work? - var closure = PEnv(idTableGet(o.lambdasToEnv, local)) - if closure.isNil: - return liftIterSym(n, o.fn) - else: - let createdVar = generateIterClosureCreation(o, closure, - closure.attachedNode) - let lpt = getHiddenParam(local).typ - if lpt != createdVar.typ: - assert lpt.kind == tyRef and createdVar.typ.kind == tyRef - # fix bug 'tshallowcopy_closures' but report if this gets any weirder: - if createdVar.typ.sons[0].len == 1 and lpt.sons[0].len >= 1: - createdVar.typ = lpt - if createdVar.kind == nkSym: createdVar.sym.typ = lpt - closure.obj = lpt.sons[0] - else: - internalError(n.info, "environment computation failed") - return makeClosure(local, createdVar, n.info) - - var closure = PEnv(idTableGet(o.lambdasToEnv, local)) - if closure != nil: - # we need to replace the lambda with '(lambda, env)': - let a = closure.createdVar - if a != nil: - return makeClosure(local, a, n.info) + let s = n.sym + if isInnerProc(s): + if not c.processed.containsOrIncl(s.id): + #if s.name.s == "temp": + # echo renderTree(s.getBody, {renderIds}) + let body = wrapIterBody(liftCapturedVars(s.getBody, s, d, c), s) + if c.envvars.getOrDefault(s.id).isNil: + s.ast.sons[bodyPos] = body + else: + s.ast.sons[bodyPos] = newTree(nkStmtList, rawClosureCreation(s, d, c), body) + if s.typ.callConv == ccClosure: + result = symToClosure(n, owner, d, c) + elif s.id in d.capturedVars: + if s.owner != owner: + result = accessViaEnvParam(n, owner) + elif owner.isIterator and interestingIterVar(s): + result = accessViaEnvParam(n, owner) else: - # can happen for dummy closures: - var scope = closure.attachedNode - assert scope.kind == nkStmtList - if scope.sons[0].kind == nkEmpty: - # change the empty node to contain the closure construction: - scope.sons[0] = generateClosureCreation(o, closure) - let x = closure.createdVar - assert x != nil - return makeClosure(local, x, n.info) - - if not contains(o.capturedVars, local.id): return - # change 'local' to 'closure.local', unless it's a 'byCopy' variable: - # if sfByCopy notin local.flags: - result = idNodeTableGet(o.localsToAccess, local) - assert result != nil, "cannot find: " & local.name.s - # else it is captured by copy and this means that 'outer' should continue - # to access the local as a local. - of nkLambdaKinds, nkIteratorDef: - if n.typ != nil: - result = transformOuterProc(o, n.sons[namePos], it) - of nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef, nkTemplateDef: - # don't recurse here: + result = accessViaEnvVar(n, owner, d, c) + of nkEmpty..pred(nkSym), succ(nkSym)..nkNilLit, + nkTemplateDef, nkTypeSection: + discard + of nkProcDef, nkMethodDef, nkConverterDef, nkMacroDef: discard of nkClosure: - if n.sons[0].kind == nkSym: - var local = n.sons[0].sym - if isInnerProc(local, o.fn) and o.processed.contains(local.id): - o.processed.excl(local.id) - let body = local.getBody - let newBody = transformOuterProcBody(o, body, initIter(local)) - if newBody != nil: - local.ast.sons[bodyPos] = newBody - when false: - if n.sons[1].kind == nkSym: - var local = n.sons[1].sym - if it.fn.kind == skClosureIterator and interestingIterVar(local) and - it.fn == local.owner: - # every local goes through the closure: - addUniqueField(it.obj, local) - n.sons[1] = indirectAccess(newSymNode(it.closureParam), local, n.info) - of nkHiddenStdConv, nkHiddenSubConv, nkConv: - let x = transformOuterProc(o, n.sons[1], it) - if x != nil: n.sons[1] = x - result = transformOuterConv(n) - of nkYieldStmt: - if it.fn.kind == skClosureIterator: result = transformYield(o, n, it) - else: outerProcSons(o, n, it) - of nkReturnStmt: - if it.fn.kind == skClosureIterator: result = transformReturn(o, n, it) - else: outerProcSons(o, n, it) + if n[1].kind == nkNilLit: + n.sons[0] = liftCapturedVars(n[0], owner, d, c) + let x = n.sons[0].skipConv + if x.kind == nkClosure: + #localError(n.info, "internal error: closure to closure created") + # now we know better, so patch it: + n.sons[0] = x.sons[0] + n.sons[1] = x.sons[1] + of nkLambdaKinds, nkIteratorDef: + if n.typ != nil and n[namePos].kind == nkSym: + let m = newSymNode(n[namePos].sym) + m.typ = n.typ + result = liftCapturedVars(m, owner, d, c) + of nkHiddenStdConv: + if n.len == 2: + n.sons[1] = liftCapturedVars(n[1], owner, d, c) + if n[1].kind == nkClosure: result = n[1] else: - outerProcSons(o, n, it) + if owner.isIterator: + if n.kind == nkYieldStmt: + return transformYield(n, owner, d, c) + elif n.kind == nkReturnStmt: + return transformReturn(n, owner, d, c) + elif nfLL in n.flags: + # special case 'when nimVm' due to bug #3636: + n.sons[1] = liftCapturedVars(n[1], owner, d, c) + return + for i in 0..<n.len: + n.sons[i] = liftCapturedVars(n[i], owner, d, c) + +# ------------------ old stuff ------------------------------------------- + +proc semCaptureSym*(s, owner: PSym) = + if interestingVar(s) and s.kind != skResult: + if owner.typ != nil and not isGenericRoutine(owner): + # XXX: is this really safe? + # if we capture a var from another generic routine, + # it won't be consider captured. + var o = owner.skipGenericOwner + while o.kind != skModule and o != nil: + if s.owner == o: + owner.typ.callConv = ccClosure + #echo "computing .closure for ", owner.name.s, " ", owner.info, " because of ", s.name.s + o = o.skipGenericOwner + # since the analysis is not entirely correct, we don't set 'tfCapturesEnv' + # here -proc liftLambdas*(fn: PSym, body: PNode): PNode = +proc liftIterToProc*(fn: PSym; body: PNode; ptrType: PType): PNode = + var d = initDetectionPass(fn) + var c = initLiftingPass(fn) + # pretend 'fn' is a closure iterator for the analysis: + let oldKind = fn.kind + let oldCC = fn.typ.callConv + fn.kind = skIterator + fn.typ.callConv = ccClosure + d.ownerToType[fn.id] = ptrType + detectCapturedVars(body, fn, d) + result = wrapIterBody(liftCapturedVars(body, fn, d, c), fn) + fn.kind = oldKind + fn.typ.callConv = oldCC + +proc liftLambdas*(fn: PSym, body: PNode; tooEarly: var bool): PNode = # XXX gCmd == cmdCompileToJS does not suffice! The compiletime stuff needs # the transformation even when compiling to JS ... # However we can do lifting for the stuff which is *only* compiletime. let isCompileTime = sfCompileTime in fn.flags or fn.kind == skMacro - if body.kind == nkEmpty or (gCmd == cmdCompileToJS and not isCompileTime) or + if body.kind == nkEmpty or ( + gCmd in {cmdCompileToPHP, cmdCompileToJS} and not isCompileTime) or fn.skipGenericOwner.kind != skModule: # ignore forward declaration: result = body + tooEarly = true else: - #if fn.name.s == "sort": - # echo rendertree(fn.ast, {renderIds}) - var o = newOuterContext(fn) - let ex = closureCreationPoint(body) - let env = newEnv(o, nil, ex, fn) - addParamsToEnv(fn, env) - searchForInnerProcs(o, body, env) - createEnvironments(o) - if fn.kind == skClosureIterator: - result = transformOuterProcBody(o, body, initIter(fn)) + var d = initDetectionPass(fn) + detectCapturedVars(body, fn, d) + if not d.somethingToDo and fn.isIterator: + addClosureParam(d, fn) + d.somethingToDo = true + if d.somethingToDo: + var c = initLiftingPass(fn) + var newBody = liftCapturedVars(body, fn, d, c) + if c.envvars.getOrDefault(fn.id) != nil: + newBody = newTree(nkStmtList, rawClosureCreation(fn, d, c), newBody) + result = wrapIterBody(newBody, fn) else: - discard transformOuterProcBody(o, body, initIter(fn)) - result = ex - finishEnvironments(o) - #if fn.name.s == "parseLong": - # echo rendertree(result, {renderIds}) + result = body + #if fn.name.s == "get2": + # echo "had something to do ", d.somethingToDo + # echo renderTree(result, {renderIds}) proc liftLambdasForTopLevel*(module: PSym, body: PNode): PNode = if body.kind == nkEmpty or gCmd == cmdCompileToJS: result = body else: - var o = newOuterContext(module) - let ex = closureCreationPoint(body) - let env = newEnv(o, nil, ex, module) - searchForInnerProcs(o, body, env) - createEnvironments(o) - discard transformOuterProc(o, body, initIter(module)) - finishEnvironments(o) - result = ex + # XXX implement it properly + result = body # ------------------- iterator transformation -------------------------------- -proc liftForLoop*(body: PNode): PNode = +proc liftForLoop*(body: PNode; owner: PSym): PNode = # problem ahead: the iterator could be invoked indirectly, but then # we don't know what environment to create here: # @@ -1031,17 +848,27 @@ proc liftForLoop*(body: PNode): PNode = # static binding? var env: PSym - if call[0].kind == nkSym and call[0].sym.kind == skClosureIterator: + let op = call[0] + if op.kind == nkSym and op.sym.isIterator: # createClosure() - let iter = call[0].sym - assert iter.kind == skClosureIterator - env = copySym(getHiddenParam(iter)) + let iter = op.sym + + let hp = getHiddenParam(iter) + env = newSym(skLet, iter.name, owner, body.info) + env.typ = hp.typ + env.flags = hp.flags var v = newNodeI(nkVarSection, body.info) addVar(v, newSymNode(env)) result.add(v) # add 'new' statement: result.add(newCall(getSysSym"internalNew", env.newSymNode)) + elif op.kind == nkStmtListExpr: + let closure = op.lastSon + if closure.kind == nkClosure: + call.sons[0] = closure + for i in 0 .. op.len-2: + result.add op[i] var loopBody = newNodeI(nkStmtList, body.info, 3) var whileLoop = newNodeI(nkWhileStmt, body.info, 2) @@ -1054,8 +881,8 @@ proc liftForLoop*(body: PNode): PNode = var v2 = newNodeI(nkLetSection, body.info) var vpart = newNodeI(if L == 3: nkIdentDefs else: nkVarTuple, body.info) for i in 0 .. L-3: - assert body[i].kind == nkSym - body[i].sym.kind = skLet + if body[i].kind == nkSym: + body[i].sym.kind = skLet addSon(vpart, body[i]) addSon(vpart, ast.emptyNode) # no explicit type diff --git a/compiler/lexer.nim b/compiler/lexer.nim index cea42ad1e..0a4c01ba8 100644 --- a/compiler/lexer.nim +++ b/compiler/lexer.nim @@ -44,7 +44,8 @@ type tkLet, tkMacro, tkMethod, tkMixin, tkMod, tkNil, tkNot, tkNotin, tkObject, tkOf, tkOr, tkOut, - tkProc, tkPtr, tkRaise, tkRef, tkReturn, tkShl, tkShr, tkStatic, + tkProc, tkPtr, tkRaise, tkRef, tkReturn, + tkShl, tkShr, tkStatic, tkTemplate, tkTry, tkTuple, tkType, tkUsing, tkVar, tkWhen, tkWhile, tkWith, tkWithout, tkXor, @@ -262,7 +263,7 @@ template eatChar(L: var TLexer, t: var TToken) = add(t.literal, L.buf[L.bufpos]) inc(L.bufpos) -proc getNumber(L: var TLexer): TToken = +proc getNumber(L: var TLexer, result: var TToken) = proc matchUnderscoreChars(L: var TLexer, tok: var TToken, chars: set[char]) = var pos = L.bufpos # use registers for pos, buf var buf = L.buf @@ -662,6 +663,7 @@ proc getString(L: var TLexer, tok: var TToken, rawMode: bool) = L.lineNumber = line lexMessagePos(L, errClosingTripleQuoteExpected, L.lineStart) L.lineNumber = line2 + L.bufpos = pos break else: add(tok.literal, buf[pos]) @@ -768,24 +770,84 @@ proc getOperator(L: var TLexer, tok: var TToken) = if buf[pos] in {CR, LF, nimlexbase.EndOfFile}: tok.strongSpaceB = -1 +proc skipMultiLineComment(L: var TLexer; tok: var TToken; start: int; + isDoc: bool) = + var pos = start + var buf = L.buf + var toStrip = 0 + # detect the amount of indentation: + if isDoc: + toStrip = getColNumber(L, pos) + while buf[pos] == ' ': inc pos + if buf[pos] in {CR, LF}: + pos = handleCRLF(L, pos) + buf = L.buf + toStrip = 0 + while buf[pos] == ' ': + inc pos + inc toStrip + var nesting = 0 + while true: + case buf[pos] + of '#': + if isDoc: + if buf[pos+1] == '#' and buf[pos+2] == '[': + inc nesting + tok.literal.add '#' + elif buf[pos+1] == '[': + inc nesting + inc pos + of ']': + if isDoc: + if buf[pos+1] == '#' and buf[pos+2] == '#': + if nesting == 0: + inc(pos, 3) + break + dec nesting + tok.literal.add ']' + elif buf[pos+1] == '#': + if nesting == 0: + inc(pos, 2) + break + dec nesting + inc pos + of CR, LF: + pos = handleCRLF(L, pos) + buf = L.buf + # strip leading whitespace: + if isDoc: + tok.literal.add "\n" + inc tok.iNumber + var c = toStrip + while buf[pos] == ' ' and c > 0: + inc pos + dec c + of nimlexbase.EndOfFile: + lexMessagePos(L, errGenerated, pos, "end of multiline comment expected") + break + else: + if isDoc: tok.literal.add buf[pos] + inc(pos) + L.bufpos = pos + proc scanComment(L: var TLexer, tok: var TToken) = var pos = L.bufpos var buf = L.buf + tok.tokType = tkComment + # iNumber contains the number of '\n' in the token + tok.iNumber = 0 when not defined(nimfix): assert buf[pos+1] == '#' if buf[pos+2] == '[': - if buf[pos+3] == ']': - # ##[] is the (rather complex) "cursor token" for idetools - tok.tokType = tkComment - tok.literal = "[]" - inc(L.bufpos, 4) - return - else: - lexMessagePos(L, warnDeprecated, pos, "use '## [' instead; '##['") + skipMultiLineComment(L, tok, pos+3, true) + return + inc(pos, 2) + + var toStrip = 0 + while buf[pos] == ' ': + inc pos + inc toStrip - tok.tokType = tkComment - # iNumber contains the number of '\n' in the token - tok.iNumber = 0 when defined(nimfix): var col = getColNumber(L, pos) while true: @@ -819,6 +881,12 @@ proc scanComment(L: var TLexer, tok: var TToken) = if doContinue(): tok.literal.add "\n" when defined(nimfix): col = indent + else: + inc(pos, 2) + var c = toStrip + while buf[pos] == ' ' and c > 0: + inc pos + dec c inc tok.iNumber else: if buf[pos] > ' ': @@ -842,9 +910,16 @@ proc skip(L: var TLexer, tok: var TToken) = pos = handleCRLF(L, pos) buf = L.buf var indent = 0 - while buf[pos] == ' ': - inc(pos) - inc(indent) + while true: + if buf[pos] == ' ': + inc(pos) + inc(indent) + elif buf[pos] == '#' and buf[pos+1] == '[': + skipMultiLineComment(L, tok, pos+2, false) + pos = L.bufpos + buf = L.buf + else: + break tok.strongSpaceA = 0 when defined(nimfix): template doBreak(): expr = buf[pos] > ' ' @@ -862,8 +937,11 @@ proc skip(L: var TLexer, tok: var TToken) = # do not skip documentation comment: if buf[pos+1] == '#': break if buf[pos+1] == '[': - lexMessagePos(L, warnDeprecated, pos, "use '# [' instead; '#['") - while buf[pos] notin {CR, LF, nimlexbase.EndOfFile}: inc(pos) + skipMultiLineComment(L, tok, pos+2, false) + pos = L.bufpos + buf = L.buf + else: + while buf[pos] notin {CR, LF, nimlexbase.EndOfFile}: inc(pos) else: break # EndOfFile also leaves the loop L.bufpos = pos @@ -979,7 +1057,7 @@ proc rawGetTok*(L: var TLexer, tok: var TToken) = getCharacter(L, tok) tok.tokType = tkCharLit of '0'..'9': - tok = getNumber(L) + getNumber(L, tok) else: if c in OpChars: getOperator(L, tok) diff --git a/compiler/lookups.nim b/compiler/lookups.nim index e88589c3e..962c28613 100644 --- a/compiler/lookups.nim +++ b/compiler/lookups.nim @@ -133,7 +133,7 @@ type proc getSymRepr*(s: PSym): string = case s.kind - of skProc, skMethod, skConverter, skIterators: result = getProcHeader(s) + of skProc, skMethod, skConverter, skIterator: result = getProcHeader(s) else: result = s.name.s proc ensureNoMissingOrUnusedSymbols(scope: PScope) = @@ -221,6 +221,19 @@ when defined(nimfix): else: template fixSpelling(n: PNode; ident: PIdent; op: expr) = discard +proc errorUseQualifier*(c: PContext; info: TLineInfo; s: PSym) = + var err = "Error: ambiguous identifier: '" & s.name.s & "'" + var ti: TIdentIter + var candidate = initIdentIter(ti, c.importTable.symbols, s.name) + var i = 0 + while candidate != nil: + if i == 0: err.add " --use " + else: err.add " or " + err.add candidate.owner.name.s & "." & candidate.name.s + candidate = nextIdentIter(ti, c.importTable.symbols) + inc i + localError(info, errGenerated, err) + proc lookUp*(c: PContext, n: PNode): PSym = # Looks up a symbol. Generates an error in case of nil. case n.kind @@ -243,7 +256,7 @@ proc lookUp*(c: PContext, n: PNode): PSym = internalError(n.info, "lookUp") return if contains(c.ambiguousSymbols, result.id): - localError(n.info, errUseQualifier, result.name.s) + errorUseQualifier(c, n.info, result) if result.kind == skStub: loadStub(result) type @@ -261,11 +274,11 @@ proc qualifiedLookUp*(c: PContext, n: PNode, flags = {checkUndeclared}): PSym = result = errorSym(c, n) elif checkAmbiguity in flags and result != nil and contains(c.ambiguousSymbols, result.id): - localError(n.info, errUseQualifier, ident.s) + errorUseQualifier(c, n.info, result) of nkSym: result = n.sym if checkAmbiguity in flags and contains(c.ambiguousSymbols, result.id): - localError(n.info, errUseQualifier, n.sym.name.s) + errorUseQualifier(c, n.info, n.sym) of nkDotExpr: result = nil var m = qualifiedLookUp(c, n.sons[0], flags*{checkUndeclared}) diff --git a/compiler/lowerings.nim b/compiler/lowerings.nim index 20800b809..7a5c7f44b 100644 --- a/compiler/lowerings.nim +++ b/compiler/lowerings.nim @@ -165,9 +165,10 @@ proc indirectAccess*(a: PNode, b: string, info: TLineInfo): PNode = deref.typ = a.typ.skipTypes(abstractInst).sons[0] var t = deref.typ.skipTypes(abstractInst) var field: PSym + let bb = getIdent(b) while true: assert t.kind == tyObject - field = getSymFromList(t.n, getIdent(b)) + field = getSymFromList(t.n, bb) if field != nil: break t = t.sons[0] if t == nil: break @@ -585,7 +586,7 @@ proc wrapProcForSpawn*(owner: PSym; spawnExpr: PNode; retType: PType; objType.addField(field) result.add newFastAsgnStmt(newDotExpr(scratchObj, field), n[0]) fn = indirectAccess(castExpr, field, n.info) - elif fn.kind == nkSym and fn.sym.kind in {skClosureIterator, skIterator}: + elif fn.kind == nkSym and fn.sym.kind == skIterator: localError(n.info, "iterator in spawn environment is not allowed") elif fn.typ.callConv == ccClosure: localError(n.info, "closure in spawn environment is not allowed") diff --git a/compiler/main.nim b/compiler/main.nim index 2ee07a443..4aefbb85a 100644 --- a/compiler/main.nim +++ b/compiler/main.nim @@ -41,6 +41,7 @@ proc commandGenDepend = proc commandCheck = msgs.gErrorMax = high(int) # do not stop after first error + defineSymbol("nimcheck") semanticPasses() # use an empty backend for semantic checking only rodPass() compileProject() @@ -108,6 +109,7 @@ proc commandCompileToJS = defineSymbol("nimrod") # 'nimrod' is always defined defineSymbol("ecmascript") # For backward compatibility defineSymbol("js") + if gCmd == cmdCompileToPHP: defineSymbol("nimphp") semanticPasses() registerPass(JSgenPass) compileProject() @@ -267,6 +269,9 @@ proc mainCommand* = of "js", "compiletojs": gCmd = cmdCompileToJS commandCompileToJS() + of "php": + gCmd = cmdCompileToPHP + commandCompileToJS() of "doc": wantMainModule() gCmd = cmdDoc @@ -317,11 +322,12 @@ proc mainCommand* = (key: "lib_paths", val: libpaths) ] - outWriteln($dumpdata) + msgWriteln($dumpdata, {msgStdout, msgSkipHook}) else: - outWriteln("-- list of currently defined symbols --") - for s in definedSymbolNames(): outWriteln(s) - outWriteln("-- end of list --") + msgWriteln("-- list of currently defined symbols --", + {msgStdout, msgSkipHook}) + for s in definedSymbolNames(): msgWriteln(s, {msgStdout, msgSkipHook}) + msgWriteln("-- end of list --", {msgStdout, msgSkipHook}) for it in iterSearchPath(searchPaths): msgWriteln(it) of "check": diff --git a/compiler/modules.nim b/compiler/modules.nim index 3893d377e..8ac964321 100644 --- a/compiler/modules.nim +++ b/compiler/modules.nim @@ -30,7 +30,7 @@ var ## XXX: we should implement recycling of file IDs ## if the user keeps renaming modules, the file IDs will keep growing -proc getModule(fileIdx: int32): PSym = +proc getModule*(fileIdx: int32): PSym = if fileIdx >= 0 and fileIdx < gCompiledModules.len: result = gCompiledModules[fileIdx] @@ -156,6 +156,9 @@ proc compileModule*(fileIdx: int32, flags: TSymFlags): PSym = #var rd = handleSymbolFile(result) var rd: PRodReader result.flags = result.flags + flags + if sfMainModule in result.flags: + gMainPackageId = result.owner.id + if gCmd in {cmdCompileToC, cmdCompileToCpp, cmdCheck, cmdIdeTools}: rd = handleSymbolFile(result) if result.id < 0: @@ -183,6 +186,9 @@ proc importModule*(s: PSym, fileIdx: int32): PSym {.procvar.} = if optCaasEnabled in gGlobalOptions: addDep(s, fileIdx) if sfSystemModule in result.flags: localError(result.info, errAttemptToRedefine, result.name.s) + # restore the notes for outer module: + gNotes = if s.owner.id == gMainPackageId: gMainPackageNotes + else: ForeignPackageNotes proc includeModule*(s: PSym, fileIdx: int32): PNode {.procvar.} = result = syntaxes.parseFile(fileIdx) diff --git a/compiler/msgs.nim b/compiler/msgs.nim index 4dd134177..668d43bb3 100644 --- a/compiler/msgs.nim +++ b/compiler/msgs.nim @@ -500,12 +500,14 @@ type ESuggestDone* = object of Exception const + ForeignPackageNotes*: TNoteKinds = {hintProcessing, warnUnknownMagic, + hintQuitCalled} NotesVerbosity*: array[0..3, TNoteKinds] = [ {low(TNoteKind)..high(TNoteKind)} - {warnShadowIdent, warnUninit, warnProveField, warnProveIndex, warnGcUnsafe, hintSuccessX, hintPath, hintConf, - hintProcessing, + hintProcessing, hintPattern, hintDependency, hintExecuting, hintLinking, hintCodeBegin, hintCodeEnd, @@ -727,27 +729,32 @@ proc `??`* (info: TLineInfo, filename: string): bool = var gTrackPos*: TLineInfo -proc outWriteln*(s: string) = - ## Writes to stdout. Always. - if eStdOut in errorOutputs: - writeLine(stdout, s) - flushFile(stdout) +type + MsgFlag* = enum ## flags altering msgWriteln behavior + msgStdout, ## force writing to stdout, even stderr is default + msgSkipHook ## skip message hook even if it is present + MsgFlags* = set[MsgFlag] -proc msgWriteln*(s: string) = - ## Writes to stdout. If --stdout option is given, writes to stderr instead. +proc msgWriteln*(s: string, flags: MsgFlags = {}) = + ## Writes given message string to stderr by default. + ## If ``--stdout`` option is given, writes to stdout instead. If message hook + ## is present, then it is used to output message rather than stderr/stdout. + ## This behavior can be altered by given optional flags. #if gCmd == cmdIdeTools and optCDebug notin gGlobalOptions: return - if not isNil(writelnHook): + if not isNil(writelnHook) and msgSkipHook notin flags: writelnHook(s) - elif optStdout in gGlobalOptions: - if eStdErr in errorOutputs: - writeLine(stderr, s) - flushFile(stderr) - else: + elif optStdout in gGlobalOptions or msgStdout in flags: if eStdOut in errorOutputs: writeLine(stdout, s) flushFile(stdout) + else: + if eStdErr in errorOutputs: + writeLine(stderr, s) + # On Windows stderr is fully-buffered when piped, regardless of C std. + when defined(windows): + flushFile(stderr) macro callIgnoringStyle(theProc: typed, first: typed, args: varargs[expr]): stmt = @@ -767,8 +774,9 @@ macro callIgnoringStyle(theProc: typed, first: typed, typ != typTerminalCmd: result.add(arg) -macro callStyledEcho(args: varargs[expr]): stmt = - result = newCall(bindSym"styledEcho") +macro callStyledWriteLineStderr(args: varargs[expr]): stmt = + result = newCall(bindSym"styledWriteLine") + result.add(bindSym"stderr") for arg in children(args[0][1]): result.add(arg) @@ -782,16 +790,18 @@ template styledMsgWriteln*(args: varargs[expr]) = if not isNil(writelnHook): callIgnoringStyle(callWritelnHook, nil, args) elif optStdout in gGlobalOptions: - if eStdErr in errorOutputs: - callIgnoringStyle(writeLine, stderr, args) - flushFile(stderr) - else: if eStdOut in errorOutputs: + callIgnoringStyle(writeLine, stdout, args) + flushFile(stdout) + else: + if eStdErr in errorOutputs: if optUseColors in gGlobalOptions: - callStyledEcho(args) + callStyledWriteLineStderr(args) else: - callIgnoringStyle(writeLine, stdout, args) - flushFile stdout + callIgnoringStyle(writeLine, stderr, args) + # On Windows stderr is fully-buffered when piped, regardless of C std. + when defined(windows): + flushFile(stderr) proc coordToStr(coord: int): string = if coord == -1: result = "???" @@ -807,24 +817,33 @@ proc getMessageStr(msg: TMsgKind, arg: string): string = type TErrorHandling = enum doNothing, doAbort, doRaise -proc handleError(msg: TMsgKind, eh: TErrorHandling, s: string) = - template quit = - if defined(debug) or msg == errInternal or hintStackTrace in gNotes: - if stackTraceAvailable() and isNil(writelnHook): - writeStackTrace() - else: - styledMsgWriteln(fgRed, "No stack traceback available\nTo create a stacktrace, rerun compilation with ./koch temp " & options.command & " <file>") - quit 1 +proc quit(msg: TMsgKind) = + if defined(debug) or msg == errInternal or hintStackTrace in gNotes: + if stackTraceAvailable() and isNil(writelnHook): + writeStackTrace() + else: + styledMsgWriteln(fgRed, "No stack traceback available\n" & + "To create a stacktrace, rerun compilation with ./koch temp " & + options.command & " <file>") + quit 1 +proc log*(s: string) {.procvar.} = + var f: File + if open(f, "nimsuggest.log", fmAppend): + f.writeLine(s) + close(f) + +proc handleError(msg: TMsgKind, eh: TErrorHandling, s: string) = if msg >= fatalMin and msg <= fatalMax: - quit() + if gCmd == cmdIdeTools: log(s) + quit(msg) if msg >= errMin and msg <= errMax: inc(gErrorCounter) options.gExitcode = 1'i8 if gErrorCounter >= gErrorMax: - quit() + quit(msg) elif eh == doAbort and gCmd != cmdIdeTools: - quit() + quit(msg) elif eh == doRaise: raiseRecoverableError(s) @@ -885,8 +904,7 @@ proc rawMessage*(msg: TMsgKind, arg: string) = proc resetAttributes* = if {optUseColors, optStdout} * gGlobalOptions == {optUseColors}: - terminal.resetAttributes() - stdout.flushFile() + terminal.resetAttributes(stderr) proc writeSurroundingSrc(info: TLineInfo) = const indent = " " @@ -1032,5 +1050,5 @@ proc listHints*() = ]) # enable colors by default on terminals -if terminal.isatty(stdout): +if terminal.isatty(stderr): incl(gGlobalOptions, optUseColors) diff --git a/compiler/nim.nim b/compiler/nim.nim index 1293ec922..a58afd593 100644 --- a/compiler/nim.nim +++ b/compiler/nim.nim @@ -56,12 +56,12 @@ proc handleCmdLine() = loadConfigs(DefaultConfig) # load all config files let scriptFile = gProjectFull.changeFileExt("nims") if fileExists(scriptFile): - runNimScript(scriptFile) + runNimScript(scriptFile, freshDefines=false) # 'nim foo.nims' means to just run the NimScript file and do nothing more: if scriptFile == gProjectFull: return elif fileExists(gProjectPath / "config.nims"): # directory wide NimScript file - runNimScript(gProjectPath / "config.nims") + runNimScript(gProjectPath / "config.nims", freshDefines=false) # now process command line arguments again, because some options in the # command line can overwite the config file's settings extccomp.initVars() @@ -84,6 +84,14 @@ proc handleCmdLine() = ex = quoteShell( completeCFilePath(changeFileExt(gProjectFull, "js").prependCurDir)) execExternalProgram(findNodeJs() & " " & ex & ' ' & commands.arguments) + elif gCmd == cmdCompileToPHP: + var ex: string + if options.outFile.len > 0: + ex = options.outFile.prependCurDir.quoteShell + else: + ex = quoteShell( + completeCFilePath(changeFileExt(gProjectFull, "php").prependCurDir)) + execExternalProgram("php " & ex & ' ' & commands.arguments) else: var binPath: string if options.outFile.len > 0: diff --git a/compiler/nimsets.nim b/compiler/nimsets.nim index 055bae909..f15ad6368 100644 --- a/compiler/nimsets.nim +++ b/compiler/nimsets.nim @@ -106,13 +106,17 @@ proc toTreeSet(s: TBitSet, settype: PType, info: TLineInfo): PNode = inc(b) if (b >= len(s) * ElemSize) or not bitSetIn(s, b): break dec(b) + let aa = newIntTypeNode(nkIntLit, a + first, elemType) + aa.info = info if a == b: - addSon(result, newIntTypeNode(nkIntLit, a + first, elemType)) + addSon(result, aa) else: n = newNodeI(nkRange, info) n.typ = elemType - addSon(n, newIntTypeNode(nkIntLit, a + first, elemType)) - addSon(n, newIntTypeNode(nkIntLit, b + first, elemType)) + addSon(n, aa) + let bb = newIntTypeNode(nkIntLit, b + first, elemType) + bb.info = info + addSon(n, bb) addSon(result, n) e = b inc(e) diff --git a/compiler/options.nim b/compiler/options.nim index 98224a11d..2716a98d3 100644 --- a/compiler/options.nim +++ b/compiler/options.nim @@ -40,7 +40,7 @@ type # please make sure we have under 32 options TGlobalOption* = enum # **keep binary compatible** gloptNone, optForceFullMake, optDeadCodeElim, optListCmd, optCompileOnly, optNoLinking, - optSafeCode, # only allow safe code + optReportConceptFailures, # report 'compiles' or 'concept' matching failures optCDebug, # turn on debugging information optGenDynLib, # generate a dynamic library optGenStaticLib, # generate a static library @@ -66,11 +66,14 @@ type # please make sure we have under 32 options # also: generate header file optIdeDebug # idetools: debug mode optIdeTerse # idetools: use terse descriptions + optNoCppExceptions # use C exception handling even with CPP TGlobalOptions* = set[TGlobalOption] TCommands* = enum # Nim's commands # **keep binary compatible** cmdNone, cmdCompileToC, cmdCompileToCpp, cmdCompileToOC, - cmdCompileToJS, cmdCompileToLLVM, cmdInterpret, cmdPretty, cmdDoc, + cmdCompileToJS, + cmdCompileToPHP, + cmdCompileToLLVM, cmdInterpret, cmdPretty, cmdDoc, cmdGenDepend, cmdDump, cmdCheck, # semantic checking for whole project cmdParse, # parse a single file (for debugging) @@ -83,10 +86,12 @@ type # please make sure we have under 32 options cmdRun # run the project via TCC backend TStringSeq* = seq[string] TGCMode* = enum # the selected GC - gcNone, gcBoehm, gcGo, gcMarkAndSweep, gcRefc, gcV2, gcGenerational + gcNone, gcBoehm, gcGo, gcStack, gcMarkAndSweep, gcRefc, + gcV2, gcGenerational IdeCmd* = enum - ideNone, ideSug, ideCon, ideDef, ideUse, ideDus + ideNone, ideSug, ideCon, ideDef, ideUse, ideDus, ideChk, ideMod, + ideHighlight, ideOutline var gIdeCmd*: IdeCmd @@ -146,8 +151,8 @@ var gDllOverrides = newStringTable(modeCaseInsensitive) gPrefixDir* = "" # Overrides the default prefix dir in getPrefixDir proc. libpath* = "" - gProjectName* = "" # holds a name like 'nimrod' - gProjectPath* = "" # holds a path like /home/alice/projects/nimrod/compiler/ + gProjectName* = "" # holds a name like 'nim' + gProjectPath* = "" # holds a path like /home/alice/projects/nim/compiler/ gProjectFull* = "" # projectPath/projectName gProjectIsStdin* = false # whether we're compiling from stdin gProjectMainIdx*: int32 # the canonical path id of the main module @@ -202,6 +207,17 @@ proc setDefaultLibpath*() = else: libpath = joinPath(prefix, "lib") else: libpath = joinPath(prefix, "lib") + # Special rule to support other tools (nimble) which import the compiler + # modules and make use of them. + let realNimPath = # Make sure we expand the symlink + if symlinkExists(findExe("nim")): expandSymlink(findExe("nim")) + else: findExe("nim") + # Find out if $nim/../../lib/system.nim exists. + let parentNimLibPath = realNimPath.parentDir().parentDir() / "lib" + if not fileExists(libpath / "system.nim") and + fileExists(parentNimlibPath / "system.nim"): + libpath = parentNimLibPath + proc canonicalizePath*(path: string): string = when not FileSystemCaseSensitive: result = path.expandFilename.toLower else: result = path.expandFilename @@ -422,6 +438,10 @@ proc parseIdeCmd*(s: string): IdeCmd = of "def": ideDef of "use": ideUse of "dus": ideDus + of "chk": ideChk + of "mod": ideMod + of "highlight": ideHighlight + of "outline": ideOutline else: ideNone proc `$`*(c: IdeCmd): string = @@ -431,4 +451,8 @@ proc `$`*(c: IdeCmd): string = of ideDef: "def" of ideUse: "use" of ideDus: "dus" + of ideChk: "chk" + of ideMod: "mod" of ideNone: "none" + of ideHighlight: "highlight" + of ideOutline: "outline" diff --git a/compiler/parampatterns.nim b/compiler/parampatterns.nim index 978583c14..f8f1f355c 100644 --- a/compiler/parampatterns.nim +++ b/compiler/parampatterns.nim @@ -182,6 +182,9 @@ proc isAssignable*(owner: PSym, n: PNode; isUnsafeAddr=false): TAssignableResult ## 'owner' can be nil! result = arNone case n.kind + of nkEmpty: + if n.typ != nil and n.typ.kind == tyVar: + result = arLValue of nkSym: let kinds = if isUnsafeAddr: {skVar, skResult, skTemp, skParam, skLet} else: {skVar, skResult, skTemp} diff --git a/compiler/parser.nim b/compiler/parser.nim index 05b4df13d..6132216e1 100644 --- a/compiler/parser.nim +++ b/compiler/parser.nim @@ -112,12 +112,7 @@ proc rawSkipComment(p: var TParser, node: PNode) = if p.tok.tokType == tkComment: if node != nil: if node.comment == nil: node.comment = "" - if p.tok.literal == "[]": - node.flags.incl nfIsCursor - #echo "parser: " - #debug node - else: - add(node.comment, p.tok.literal) + add(node.comment, p.tok.literal) else: parMessage(p, errInternal, "skipComment") getTok(p) @@ -125,6 +120,9 @@ proc rawSkipComment(p: var TParser, node: PNode) = proc skipComment(p: var TParser, node: PNode) = if p.tok.indent < 0: rawSkipComment(p, node) +proc flexComment(p: var TParser, node: PNode) = + if p.tok.indent < 0 or realInd(p): rawSkipComment(p, node) + proc skipInd(p: var TParser) = if p.tok.indent >= 0: if not realInd(p): parMessage(p, errInvalidIndentation) @@ -247,12 +245,14 @@ proc isUnary(p: TParser): bool = if p.tok.tokType in {tkOpr, tkDotDot} and p.tok.strongSpaceB == 0 and p.tok.strongSpaceA > 0: - # XXX change this after 0.10.4 is out - if p.strongSpaces: result = true - else: - parMessage(p, warnDeprecated, - "will be parsed as unary operator; inconsistent spacing") + # versions prior to 0.13.0 used to do this: + when false: + if p.strongSpaces: + result = true + else: + parMessage(p, warnDeprecated, + "will be parsed as unary operator; inconsistent spacing") proc checkBinary(p: TParser) {.inline.} = ## Check if the current parser token is a binary operator. @@ -326,6 +326,7 @@ proc parseSymbol(p: var TParser, allowNil = false): PNode = getTok(p) else: parMessage(p, errIdentifierExpected, p.tok) + break eat(p, tkAccent) else: if allowNil and p.tok.tokType == tkNil: @@ -804,20 +805,24 @@ proc parsePragma(p: var TParser): PNode = else: parMessage(p, errTokenExpected, ".}") dec p.inPragma -proc identVis(p: var TParser): PNode = +proc identVis(p: var TParser; allowDot=false): PNode = #| identVis = symbol opr? # postfix position + #| identVisDot = symbol '.' optInd symbol opr? var a = parseSymbol(p) if p.tok.tokType == tkOpr: result = newNodeP(nkPostfix, p) addSon(result, newIdentNodeP(p.tok.ident, p)) addSon(result, a) getTok(p) + elif p.tok.tokType == tkDot and allowDot: + result = dotExpr(p, a) else: result = a -proc identWithPragma(p: var TParser): PNode = +proc identWithPragma(p: var TParser; allowDot=false): PNode = #| identWithPragma = identVis pragma? - var a = identVis(p) + #| identWithPragmaDot = identVisDot pragma? + var a = identVis(p, allowDot) if p.tok.tokType == tkCurlyDotLe: result = newNodeP(nkPragmaExpr, p) addSon(result, a) @@ -887,12 +892,13 @@ proc parseTuple(p: var TParser, indentAllowed = false): PNode = skipComment(p, result) if realInd(p): withInd(p): - skipComment(p, result) + rawSkipComment(p, result) while true: case p.tok.tokType of tkSymbol, tkAccent: var a = parseIdentColonEquals(p, {}) - skipComment(p, a) + if p.tok.indent < 0 or p.tok.indent >= p.currInd: + rawSkipComment(p, a) addSon(result, a) of tkEof: break else: @@ -958,8 +964,9 @@ proc parseDoBlock(p: var TParser): PNode = proc parseDoBlocks(p: var TParser, call: PNode) = #| doBlocks = doBlock ^* IND{=} if p.tok.tokType == tkDo: - addSon(call, parseDoBlock(p)) - while sameInd(p) and p.tok.tokType == tkDo: + #withInd(p): + # addSon(call, parseDoBlock(p)) + while sameOrNoInd(p) and p.tok.tokType == tkDo: addSon(call, parseDoBlock(p)) proc parseProcExpr(p: var TParser, isExpr: bool): PNode = @@ -987,7 +994,7 @@ proc isExprStart(p: TParser): bool = of tkSymbol, tkAccent, tkOpr, tkNot, tkNil, tkCast, tkIf, tkProc, tkIterator, tkBind, tkAddr, tkParLe, tkBracketLe, tkCurlyLe, tkIntLit..tkCharLit, tkVar, tkRef, tkPtr, - tkTuple, tkObject, tkType, tkWhen, tkCase: + tkTuple, tkObject, tkType, tkWhen, tkCase, tkOut: result = true else: result = false @@ -1034,7 +1041,7 @@ proc parseObject(p: var TParser): PNode proc parseTypeClass(p: var TParser): PNode proc primary(p: var TParser, mode: TPrimaryMode): PNode = - #| typeKeyw = 'var' | 'ref' | 'ptr' | 'shared' | 'tuple' + #| typeKeyw = 'var' | 'out' | 'ref' | 'ptr' | 'shared' | 'tuple' #| | 'proc' | 'iterator' | 'distinct' | 'object' | 'enum' #| primary = typeKeyw typeDescK #| / prefixOperator* identOrLiteral primarySuffix* @@ -1108,6 +1115,7 @@ proc primary(p: var TParser, mode: TPrimaryMode): PNode = optInd(p, result) addSon(result, primary(p, pmNormal)) of tkVar: result = parseTypeDescKAux(p, nkVarTy, mode) + of tkOut: result = parseTypeDescKAux(p, nkVarTy, mode) of tkRef: result = parseTypeDescKAux(p, nkRefTy, mode) of tkPtr: result = parseTypeDescKAux(p, nkPtrTy, mode) of tkDistinct: result = parseTypeDescKAux(p, nkDistinctTy, mode) @@ -1608,6 +1616,7 @@ proc parseEnum(p: var TParser): PNode = getTok(p) addSon(result, ast.emptyNode) optInd(p, result) + flexComment(p, result) while true: var a = parseSymbol(p) if a.kind == nkEmpty: return @@ -1621,12 +1630,14 @@ proc parseEnum(p: var TParser): PNode = a = newNodeP(nkEnumFieldDef, p) addSon(a, b) addSon(a, parseExpr(p)) - skipComment(p, a) + if p.tok.indent < 0 or p.tok.indent >= p.currInd: + rawSkipComment(p, a) if p.tok.tokType == tkComma and p.tok.indent < 0: getTok(p) rawSkipComment(p, a) else: - skipComment(p, a) + if p.tok.indent < 0 or p.tok.indent >= p.currInd: + rawSkipComment(p, a) addSon(result, a) if p.tok.indent >= 0 and p.tok.indent <= p.currInd or p.tok.tokType == tkEof: @@ -1647,7 +1658,7 @@ proc parseObjectWhen(p: var TParser): PNode = addSon(branch, parseExpr(p)) colcom(p, branch) addSon(branch, parseObjectPart(p)) - skipComment(p, branch) + flexComment(p, branch) addSon(result, branch) if p.tok.tokType != tkElif: break if p.tok.tokType == tkElse and sameInd(p): @@ -1655,7 +1666,7 @@ proc parseObjectWhen(p: var TParser): PNode = eat(p, tkElse) colcom(p, branch) addSon(branch, parseObjectPart(p)) - skipComment(p, branch) + flexComment(p, branch) addSon(result, branch) proc parseObjectCase(p: var TParser): PNode = @@ -1675,7 +1686,7 @@ proc parseObjectCase(p: var TParser): PNode = addSon(a, ast.emptyNode) addSon(result, a) if p.tok.tokType == tkColon: getTok(p) - skipComment(p, result) + flexComment(p, result) var wasIndented = false let oldInd = p.currInd if realInd(p): @@ -1724,7 +1735,8 @@ proc parseObjectPart(p: var TParser): PNode = result = parseObjectCase(p) of tkSymbol, tkAccent: result = parseIdentColonEquals(p, {withPragma}) - skipComment(p, result) + if p.tok.indent < 0 or p.tok.indent >= p.currInd: + rawSkipComment(p, result) of tkNil, tkDiscard: result = newNodeP(nkNilLit, p) getTok(p) @@ -1755,7 +1767,7 @@ proc parseObject(p: var TParser): PNode = addSon(result, parseObjectPart(p)) proc parseTypeClassParam(p: var TParser): PNode = - if p.tok.tokType == tkVar: + if p.tok.tokType in {tkOut, tkVar}: result = newNodeP(nkVarTy, p) getTok(p) result.addSon(p.parseSymbol) @@ -1763,7 +1775,7 @@ proc parseTypeClassParam(p: var TParser): PNode = result = p.parseSymbol proc parseTypeClass(p: var TParser): PNode = - #| typeClassParam = ('var')? symbol + #| typeClassParam = ('var' | 'out')? symbol #| typeClass = typeClassParam ^* ',' (pragma)? ('of' typeDesc ^* ',')? #| &IND{>} stmt result = newNodeP(nkTypeClassTy, p) @@ -1797,10 +1809,11 @@ proc parseTypeClass(p: var TParser): PNode = addSon(result, parseStmt(p)) proc parseTypeDef(p: var TParser): PNode = - #| typeDef = identWithPragma genericParamList? '=' optInd typeDefAux + #| + #| typeDef = identWithPragmaDot genericParamList? '=' optInd typeDefAux #| indAndComment? result = newNodeP(nkTypeDef, p) - addSon(result, identWithPragma(p)) + addSon(result, identWithPragma(p, allowDot=true)) if p.tok.tokType == tkBracketLe and p.validInd: addSon(result, parseGenericParamList(p)) else: @@ -1897,7 +1910,7 @@ proc complexOrSimpleStmt(p: var TParser): PNode = #| | 'converter' routine #| | 'type' section(typeDef) #| | 'const' section(constant) - #| | ('let' | 'var') section(variable) + #| | ('let' | 'var' | 'using') section(variable) #| | bindStmt | mixinStmt) #| / simpleStmt case p.tok.tokType @@ -1934,7 +1947,7 @@ proc complexOrSimpleStmt(p: var TParser): PNode = of tkVar: result = parseSection(p, nkVarSection, parseVariable) of tkBind: result = parseBind(p, nkBindStmt) of tkMixin: result = parseBind(p, nkMixinStmt) - of tkUsing: result = parseBind(p, nkUsingStmt) + of tkUsing: result = parseSection(p, nkUsingStmt, parseVariable) else: result = simpleStmt(p) proc parseStmt(p: var TParser): PNode = diff --git a/compiler/patterns.nim b/compiler/patterns.nim index 604d3521d..2336e44e7 100644 --- a/compiler/patterns.nim +++ b/compiler/patterns.nim @@ -129,7 +129,7 @@ proc matchNested(c: PPatternContext, p, n: PNode, rpn: bool): bool = result = bindOrCheck(c, p.sons[2].sym, arglist) proc matches(c: PPatternContext, p, n: PNode): bool = - # hidden conversions (?) + let n = skipHidden(n) if nfNoRewrite in n.flags: result = false elif isPatternParam(c, p): diff --git a/compiler/platform.nim b/compiler/platform.nim index 8376c2b32..dc414bfeb 100644 --- a/compiler/platform.nim +++ b/compiler/platform.nim @@ -10,7 +10,7 @@ # This module contains data about the different processors # and operating systems. # Note: Unfortunately if an OS or CPU is listed here this does not mean that -# Nimrod has been tested on this platform or that the RTL has been ported. +# Nim has been tested on this platform or that the RTL has been ported. # Feel free to test for your excentric platform! import diff --git a/compiler/plugins/active.nim b/compiler/plugins/active.nim index e9c11c2ea..7b6411178 100644 --- a/compiler/plugins/active.nim +++ b/compiler/plugins/active.nim @@ -10,4 +10,4 @@ ## Include file that imports all plugins that are active. import - locals.locals + locals.locals, itersgen diff --git a/compiler/plugins/itersgen.nim b/compiler/plugins/itersgen.nim new file mode 100644 index 000000000..f44735b77 --- /dev/null +++ b/compiler/plugins/itersgen.nim @@ -0,0 +1,51 @@ +# +# +# The Nim Compiler +# (c) Copyright 2015 Andreas Rumpf +# +# See the file "copying.txt", included in this +# distribution, for details about the copyright. +# + +## Plugin to transform an inline iterator into a data structure. + +import compiler/pluginsupport, compiler/ast, compiler/astalgo, + compiler/magicsys, compiler/lookups, compiler/semdata, + compiler/lambdalifting, compiler/rodread, compiler/msgs + + +proc iterToProcImpl(c: PContext, n: PNode): PNode = + result = newNodeI(nkStmtList, n.info) + let iter = n[1] + if iter.kind != nkSym or iter.sym.kind != skIterator: + localError(iter.info, "first argument needs to be an iterator") + return + if n[2].typ.isNil: + localError(n[2].info, "second argument needs to be a type") + return + if n[3].kind != nkIdent: + localError(n[3].info, "third argument needs to be an identifier") + return + + let t = n[2].typ.skipTypes({tyTypeDesc, tyGenericInst}) + if t.kind notin {tyRef, tyPtr} or t.lastSon.kind != tyObject: + localError(n[2].info, + "type must be a non-generic ref|ptr to object with state field") + return + let body = liftIterToProc(iter.sym, iter.sym.getBody, t) + + let prc = newSym(skProc, n[3].ident, iter.sym.owner, iter.sym.info) + prc.typ = copyType(iter.sym.typ, prc, false) + excl prc.typ.flags, tfCapturesEnv + prc.typ.n.add newSymNode(getEnvParam(iter.sym)) + prc.typ.rawAddSon t + let orig = iter.sym.ast + prc.ast = newProcNode(nkProcDef, n.info, + name = newSymNode(prc), + params = orig[paramsPos], + pragmas = orig[pragmasPos], + body = body) + prc.ast.add iter.sym.ast.sons[resultPos] + addInterfaceDecl(c, prc) + +registerPlugin("stdlib", "system", "iterToProc", iterToProcImpl) diff --git a/compiler/plugins/locals/locals.nim b/compiler/plugins/locals/locals.nim index 59e3d677d..8a3f67dd4 100644 --- a/compiler/plugins/locals/locals.nim +++ b/compiler/plugins/locals/locals.nim @@ -9,8 +9,8 @@ ## The builtin 'system.locals' implemented as a plugin. -import compiler/plugins, compiler/ast, compiler/astalgo, compiler/magicsys, - compiler/lookups, compiler/semdata, compiler/lowerings +import compiler/pluginsupport, compiler/ast, compiler/astalgo, + compiler/magicsys, compiler/lookups, compiler/semdata, compiler/lowerings proc semLocals(c: PContext, n: PNode): PNode = var counter = 0 diff --git a/compiler/plugins.nim b/compiler/pluginsupport.nim index 1c9b7b77b..19a0bc84d 100644 --- a/compiler/plugins.nim +++ b/compiler/pluginsupport.nim @@ -7,7 +7,7 @@ # distribution, for details about the copyright. # -## Plugin support for the Nim compiler. Right now there are no plugins and they +## Plugin support for the Nim compiler. Right now they ## need to be build with the compiler, no DLL support. import ast, semdata, idents @@ -20,13 +20,16 @@ type next: Plugin proc pluginMatches(p: Plugin; s: PSym): bool = - if s.name.id != p.fn.id: return false - let module = s.owner + if s.name.id != p.fn.id: + return false + let module = s.skipGenericOwner if module == nil or module.kind != skModule or - module.name.id != p.module.id: return false + module.name.id != p.module.id: + return false let package = module.owner if package == nil or package.kind != skPackage or - package.name.id != p.package.id: return false + package.name.id != p.package.id: + return false return true var head: Plugin diff --git a/compiler/pragmas.nim b/compiler/pragmas.nim index 79d7884fa..dc09d8fc4 100644 --- a/compiler/pragmas.nim +++ b/compiler/pragmas.nim @@ -46,7 +46,7 @@ const wBreakpoint, wWatchPoint, wPassl, wPassc, wDeadCodeElim, wDeprecated, wFloatchecks, wInfChecks, wNanChecks, wPragma, wEmit, wUnroll, wLinearScanEnd, wPatterns, wEffects, wNoForward, wComputedGoto, - wInjectStmt, wDeprecated, wExperimental} + wInjectStmt, wDeprecated, wExperimental, wThis} lambdaPragmas* = {FirstCallConv..LastCallConv, wImportc, wExportc, wNodecl, wNosideeffect, wSideeffect, wNoreturn, wDynlib, wHeader, wDeprecated, wExtern, wThread, wImportCpp, wImportObjC, wAsmNoStackFrame, @@ -55,7 +55,7 @@ const wPure, wHeader, wCompilerproc, wFinal, wSize, wExtern, wShallow, wImportCpp, wImportObjC, wError, wIncompleteStruct, wByCopy, wByRef, wInheritable, wGensym, wInject, wRequiresInit, wUnchecked, wUnion, wPacked, - wBorrow, wGcSafe, wExportNims} + wBorrow, wGcSafe, wExportNims, wPartial} fieldPragmas* = {wImportc, wExportc, wDeprecated, wExtern, wImportCpp, wImportObjC, wError, wGuard, wBitsize} varPragmas* = {wImportc, wExportc, wVolatile, wRegister, wThreadVar, wNodecl, @@ -256,8 +256,9 @@ proc expectDynlibNode(c: PContext, n: PNode): PNode = proc processDynLib(c: PContext, n: PNode, sym: PSym) = if (sym == nil) or (sym.kind == skModule): - POptionEntry(c.optionStack.tail).dynlib = getLib(c, libDynamic, - expectDynlibNode(c, n)) + let lib = getLib(c, libDynamic, expectDynlibNode(c, n)) + if not lib.isOverriden: + POptionEntry(c.optionStack.tail).dynlib = lib else: if n.kind == nkExprColonExpr: var lib = getLib(c, libDynamic, expectDynlibNode(c, n)) @@ -276,6 +277,7 @@ proc processDynLib(c: PContext, n: PNode, sym: PSym) = proc processNote(c: PContext, n: PNode) = if (n.kind == nkExprColonExpr) and (sonsLen(n) == 2) and (n.sons[0].kind == nkBracketExpr) and + (n.sons[0].sons.len == 2) and (n.sons[0].sons[1].kind == nkIdent) and (n.sons[0].sons[0].kind == nkIdent): #and (n.sons[1].kind == nkIdent): @@ -443,6 +445,7 @@ proc semAsmOrEmit*(con: PContext, n: PNode, marker: char): PNode = var e = searchInScopes(con, getIdent(sub)) if e != nil: if e.kind == skStub: loadStub(e) + incl(e.flags, sfUsed) addSon(result, newSymNode(e)) else: addSon(result, newStrNode(nkStrLit, sub)) @@ -834,6 +837,15 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, noVal(it) if sym.kind != skType or sym.typ == nil: invalidPragma(it) else: incl(sym.typ.flags, tfByCopy) + of wPartial: + noVal(it) + if sym.kind != skType or sym.typ == nil: invalidPragma(it) + else: + incl(sym.typ.flags, tfPartial) + # .partial types can only work with dead code elimination + # to prevent the codegen from doing anything before we compiled + # the whole program: + incl gGlobalOptions, optDeadCodeElim of wInject, wGensym: # We check for errors, but do nothing with these pragmas otherwise # as they are handled directly in 'evalTemplate'. @@ -874,6 +886,11 @@ proc singlePragma(c: PContext, sym: PSym, n: PNode, i: int, c.module.flags.incl sfExperimental else: localError(it.info, "'experimental' pragma only valid as toplevel statement") + of wThis: + if it.kind == nkExprColonExpr: + c.selfName = considerQuotedIdent(it[1]) + else: + c.selfName = getIdent("self") of wNoRewrite: noVal(it) of wBase: diff --git a/compiler/renderer.nim b/compiler/renderer.nim index 7cd8e25ee..f0ee137e9 100644 --- a/compiler/renderer.nim +++ b/compiler/renderer.nim @@ -167,33 +167,24 @@ proc makeNimString(s: string): string = proc putComment(g: var TSrcGen, s: string) = if s.isNil: return var i = 0 - var comIndent = 1 var isCode = (len(s) >= 2) and (s[1] != ' ') var ind = g.lineLen - var com = "" + var com = "## " while true: case s[i] of '\0': break of '\x0D': put(g, tkComment, com) - com = "" + com = "## " inc(i) if s[i] == '\x0A': inc(i) optNL(g, ind) of '\x0A': put(g, tkComment, com) - com = "" + com = "## " inc(i) optNL(g, ind) - of '#': - add(com, s[i]) - inc(i) - comIndent = 0 - while s[i] == ' ': - add(com, s[i]) - inc(i) - inc(comIndent) of ' ', '\x09': add(com, s[i]) inc(i) @@ -206,7 +197,7 @@ proc putComment(g: var TSrcGen, s: string) = if not isCode and (g.lineLen + (j - i) > MaxLineLen): put(g, tkComment, com) optNL(g, ind) - com = '#' & spaces(comIndent) + com = "## " while s[i] > ' ': add(com, s[i]) inc(i) @@ -283,7 +274,7 @@ proc shouldRenderComment(g: var TSrcGen, n: PNode): bool = result = false if n.comment != nil: result = (renderNoComments notin g.flags) or - (renderDocComments in g.flags) and startsWith(n.comment, "##") + (renderDocComments in g.flags) proc gcom(g: var TSrcGen, n: PNode) = assert(n != nil) @@ -447,7 +438,7 @@ proc lsub(n: PNode): int = len("if_:_") of nkElifExpr: result = lsons(n) + len("_elif_:_") of nkElseExpr: result = lsub(n.sons[0]) + len("_else:_") # type descriptions - of nkTypeOfExpr: result = (if n.len > 0: lsub(n.sons[0]) else: 0)+len("type_") + of nkTypeOfExpr: result = (if n.len > 0: lsub(n.sons[0]) else: 0)+len("type()") of nkRefTy: result = (if n.len > 0: lsub(n.sons[0])+1 else: 0) + len("ref") of nkPtrTy: result = (if n.len > 0: lsub(n.sons[0])+1 else: 0) + len("ptr") of nkVarTy: result = (if n.len > 0: lsub(n.sons[0])+1 else: 0) + len("var") @@ -472,6 +463,9 @@ proc lsub(n: PNode): int = of nkVarSection, nkLetSection: if sonsLen(n) > 1: result = MaxLineLen + 1 else: result = lsons(n) + len("var_") + of nkUsingStmt: + if sonsLen(n) > 1: result = MaxLineLen + 1 + else: result = lsons(n) + len("using_") of nkReturnStmt: result = lsub(n.sons[0]) + len("return_") of nkRaiseStmt: result = lsub(n.sons[0]) + len("raise_") of nkYieldStmt: result = lsub(n.sons[0]) + len("yield_") @@ -808,10 +802,23 @@ proc doParamsAux(g: var TSrcGen, params: PNode) = gsemicolon(g, params, 1) put(g, tkParRi, ")") - if params.sons[0].kind != nkEmpty: + if params.len > 0 and params.sons[0].kind != nkEmpty: putWithSpace(g, tkOpr, "->") gsub(g, params.sons[0]) +proc gsub(g: var TSrcGen; n: PNode; i: int) = + if i < n.len: + gsub(g, n[i]) + else: + put(g, tkOpr, "<<" & $i & "th child missing for " & $n.kind & " >>") + +proc isBracket*(n: PNode): bool = + case n.kind + of nkClosedSymChoice, nkOpenSymChoice: + if n.len > 0: result = isBracket(n[0]) + of nkSym: result = n.sym.name.s == "[]" + else: result = false + proc gsub(g: var TSrcGen, n: PNode, c: TContext) = if isNil(n): return var @@ -841,13 +848,19 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = of nkCharLit: put(g, tkCharLit, atom(n)) of nkNilLit: put(g, tkNil, atom(n)) # complex expressions of nkCall, nkConv, nkDotCall, nkPattern, nkObjConstr: - if sonsLen(n) >= 1: gsub(g, n.sons[0]) - put(g, tkParLe, "(") - gcomma(g, n, 1) - put(g, tkParRi, ")") + if n.len > 0 and isBracket(n[0]): + gsub(g, n, 1) + put(g, tkBracketLe, "[") + gcomma(g, n, 2) + put(g, tkBracketRi, "]") + else: + if sonsLen(n) >= 1: gsub(g, n.sons[0]) + put(g, tkParLe, "(") + gcomma(g, n, 1) + put(g, tkParRi, ")") of nkCallStrLit: - gsub(g, n.sons[0]) - if n.sons[1].kind == nkRStrLit: + gsub(g, n, 0) + if n.len > 1 and n.sons[1].kind == nkRStrLit: put(g, tkRStrLit, '\"' & replace(n[1].strVal, "\"", "\"\"") & '\"') else: gsub(g, n.sons[1]) @@ -855,10 +868,10 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = of nkCast: put(g, tkCast, "cast") put(g, tkBracketLe, "[") - gsub(g, n.sons[0]) + gsub(g, n, 0) put(g, tkBracketRi, "]") put(g, tkParLe, "(") - gsub(g, n.sons[1]) + gsub(g, n, 1) put(g, tkParRi, ")") of nkAddr: put(g, tkAddr, "addr") @@ -869,29 +882,29 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = of nkStaticExpr: put(g, tkStatic, "static") put(g, tkSpaces, Space) - gsub(g, n.sons[0]) + gsub(g, n, 0) of nkBracketExpr: - gsub(g, n.sons[0]) + gsub(g, n, 0) put(g, tkBracketLe, "[") gcomma(g, n, 1) put(g, tkBracketRi, "]") of nkCurlyExpr: - gsub(g, n.sons[0]) + gsub(g, n, 0) put(g, tkCurlyLe, "{") gcomma(g, n, 1) put(g, tkCurlyRi, "}") of nkPragmaExpr: - gsub(g, n.sons[0]) + gsub(g, n, 0) gcomma(g, n, 1) of nkCommand: - gsub(g, n.sons[0]) + gsub(g, n, 0) put(g, tkSpaces, Space) gcomma(g, n, 1) of nkExprEqExpr, nkAsgn, nkFastAsgn: - gsub(g, n.sons[0]) + gsub(g, n, 0) put(g, tkSpaces, Space) putWithSpace(g, tkEquals, "=") - gsub(g, n.sons[1]) + gsub(g, n, 1) of nkChckRangeF: put(g, tkSymbol, "chckRangeF") put(g, tkParLe, "(") @@ -913,18 +926,21 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = gcomma(g, n, 1) put(g, tkParRi, ")") of nkClosedSymChoice, nkOpenSymChoice: - put(g, tkParLe, "(") - for i in countup(0, sonsLen(n) - 1): - if i > 0: put(g, tkOpr, "|") - if n.sons[i].kind == nkSym: - let s = n[i].sym - if s.owner != nil: - put g, tkSymbol, n[i].sym.owner.name.s - put g, tkOpr, "." - put g, tkSymbol, n[i].sym.name.s - else: - gsub(g, n.sons[i], c) - put(g, tkParRi, if n.kind == nkOpenSymChoice: "|...)" else: ")") + if renderIds in g.flags: + put(g, tkParLe, "(") + for i in countup(0, sonsLen(n) - 1): + if i > 0: put(g, tkOpr, "|") + if n.sons[i].kind == nkSym: + let s = n[i].sym + if s.owner != nil: + put g, tkSymbol, n[i].sym.owner.name.s + put g, tkOpr, "." + put g, tkSymbol, n[i].sym.name.s + else: + gsub(g, n.sons[i], c) + put(g, tkParRi, if n.kind == nkOpenSymChoice: "|...)" else: ")") + else: + gsub(g, n, 0) of nkPar, nkClosure: put(g, tkParLe, "(") gcomma(g, n, c) @@ -945,33 +961,34 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = gcomma(g, n, c) put(g, tkBracketRi, "]") of nkDotExpr: - gsub(g, n.sons[0]) + gsub(g, n, 0) put(g, tkDot, ".") - gsub(g, n.sons[1]) + gsub(g, n, 1) of nkBind: putWithSpace(g, tkBind, "bind") - gsub(g, n.sons[0]) + gsub(g, n, 0) of nkCheckedFieldExpr, nkHiddenAddr, nkHiddenDeref: - gsub(g, n.sons[0]) + gsub(g, n, 0) of nkLambda: putWithSpace(g, tkProc, "proc") - gsub(g, n.sons[paramsPos]) - gsub(g, n.sons[pragmasPos]) + gsub(g, n, paramsPos) + gsub(g, n, pragmasPos) put(g, tkSpaces, Space) putWithSpace(g, tkEquals, "=") - gsub(g, n.sons[bodyPos]) + gsub(g, n, bodyPos) of nkDo: putWithSpace(g, tkDo, "do") - doParamsAux(g, n.sons[paramsPos]) - gsub(g, n.sons[pragmasPos]) + if paramsPos < n.len: + doParamsAux(g, n.sons[paramsPos]) + gsub(g, n, pragmasPos) put(g, tkColon, ":") - gsub(g, n.sons[bodyPos]) + gsub(g, n, bodyPos) of nkConstDef, nkIdentDefs: gcomma(g, n, 0, -3) var L = sonsLen(n) if L >= 2 and n.sons[L - 2].kind != nkEmpty: putWithSpace(g, tkColon, ":") - gsub(g, n.sons[L - 2]) + gsub(g, n, L - 2) if L >= 1 and n.sons[L - 1].kind != nkEmpty: put(g, tkSpaces, Space) putWithSpace(g, tkEquals, "=") @@ -984,20 +1001,20 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = putWithSpace(g, tkEquals, "=") gsub(g, lastSon(n), c) of nkExprColonExpr: - gsub(g, n.sons[0]) + gsub(g, n, 0) putWithSpace(g, tkColon, ":") - gsub(g, n.sons[1]) + gsub(g, n, 1) of nkInfix: - gsub(g, n.sons[1]) + gsub(g, n, 1) put(g, tkSpaces, Space) - gsub(g, n.sons[0]) # binary operator + gsub(g, n, 0) # binary operator if not fits(g, lsub(n.sons[2]) + lsub(n.sons[0]) + 1): optNL(g, g.indent + longIndentWid) else: put(g, tkSpaces, Space) - gsub(g, n.sons[2]) + gsub(g, n, 2) of nkPrefix: - gsub(g, n.sons[0]) + gsub(g, n, 0) if n.len > 1: put(g, tkSpaces, Space) if n.sons[1].kind == nkInfix: @@ -1007,14 +1024,14 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = else: gsub(g, n.sons[1]) of nkPostfix: - gsub(g, n.sons[1]) - gsub(g, n.sons[0]) + gsub(g, n, 1) + gsub(g, n, 0) of nkRange: - gsub(g, n.sons[0]) + gsub(g, n, 0) put(g, tkDotDot, "..") - gsub(g, n.sons[1]) + gsub(g, n, 1) of nkDerefExpr: - gsub(g, n.sons[0]) + gsub(g, n, 0) put(g, tkOpr, "[]") of nkAccQuoted: put(g, tkAccent, "`") @@ -1025,22 +1042,24 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = put(g, tkAccent, "`") of nkIfExpr: putWithSpace(g, tkIf, "if") - gsub(g, n.sons[0].sons[0]) + if n.len > 0: gsub(g, n.sons[0], 0) putWithSpace(g, tkColon, ":") - gsub(g, n.sons[0].sons[1]) + if n.len > 0: gsub(g, n.sons[0], 1) gsons(g, n, emptyContext, 1) of nkElifExpr: putWithSpace(g, tkElif, " elif") - gsub(g, n.sons[0]) + gsub(g, n, 0) putWithSpace(g, tkColon, ":") - gsub(g, n.sons[1]) + gsub(g, n, 1) of nkElseExpr: put(g, tkElse, " else") putWithSpace(g, tkColon, ":") - gsub(g, n.sons[0]) + gsub(g, n, 0) of nkTypeOfExpr: - putWithSpace(g, tkType, "type") + put(g, tkType, "type") + put(g, tkParLe, "(") if n.len > 0: gsub(g, n.sons[0]) + put(g, tkParRi, ")") of nkRefTy: if sonsLen(n) > 0: putWithSpace(g, tkRef, "ref") @@ -1072,10 +1091,10 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = else: put(g, tkDistinct, "distinct") of nkTypeDef: - gsub(g, n.sons[0]) - gsub(g, n.sons[1]) + gsub(g, n, 0) + gsub(g, n, 1) put(g, tkSpaces, Space) - if n.sons[2].kind != nkEmpty: + if n.len > 2 and n.sons[2].kind != nkEmpty: putWithSpace(g, tkEquals, "=") gsub(g, n.sons[2]) of nkObjectTy: @@ -1097,19 +1116,19 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = putNL(g) of nkOfInherit: putWithSpace(g, tkOf, "of") - gsub(g, n.sons[0]) + gsub(g, n, 0) of nkProcTy: if sonsLen(n) > 0: putWithSpace(g, tkProc, "proc") - gsub(g, n.sons[0]) - gsub(g, n.sons[1]) + gsub(g, n, 0) + gsub(g, n, 1) else: put(g, tkProc, "proc") of nkIteratorTy: if sonsLen(n) > 0: putWithSpace(g, tkIterator, "iterator") - gsub(g, n.sons[0]) - gsub(g, n.sons[1]) + gsub(g, n, 0) + gsub(g, n, 1) else: put(g, tkIterator, "iterator") of nkStaticTy: @@ -1130,10 +1149,10 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = else: put(g, tkEnum, "enum") of nkEnumFieldDef: - gsub(g, n.sons[0]) + gsub(g, n, 0) put(g, tkSpaces, Space) putWithSpace(g, tkEquals, "=") - gsub(g, n.sons[1]) + gsub(g, n, 1) of nkStmtList, nkStmtListExpr, nkStmtListType: gstmts(g, n, emptyContext) of nkIfStmt: putWithSpace(g, tkIf, "if") @@ -1173,11 +1192,12 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = initContext(a) incl(a.flags, rfInConstExpr) gsection(g, n, a, tkConst, "const") - of nkVarSection, nkLetSection: + of nkVarSection, nkLetSection, nkUsingStmt: var L = sonsLen(n) if L == 0: return if n.kind == nkVarSection: putWithSpace(g, tkVar, "var") - else: putWithSpace(g, tkLet, "let") + elif n.kind == nkLetSection: putWithSpace(g, tkLet, "let") + else: putWithSpace(g, tkUsing, "using") if L > 1: gcoms(g) indentNL(g) @@ -1190,22 +1210,22 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = gsub(g, n.sons[0]) of nkReturnStmt: putWithSpace(g, tkReturn, "return") - gsub(g, n.sons[0]) + gsub(g, n, 0) of nkRaiseStmt: putWithSpace(g, tkRaise, "raise") - gsub(g, n.sons[0]) + gsub(g, n, 0) of nkYieldStmt: putWithSpace(g, tkYield, "yield") - gsub(g, n.sons[0]) + gsub(g, n, 0) of nkDiscardStmt: putWithSpace(g, tkDiscard, "discard") - gsub(g, n.sons[0]) + gsub(g, n, 0) of nkBreakStmt: putWithSpace(g, tkBreak, "break") - gsub(g, n.sons[0]) + gsub(g, n, 0) of nkContinueStmt: putWithSpace(g, tkContinue, "continue") - gsub(g, n.sons[0]) + gsub(g, n, 0) of nkPragma: if renderNoPragmas notin g.flags: if g.inPragma <= 0: @@ -1233,7 +1253,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = putWithSpace(g, tkImport, "import") else: putWithSpace(g, tkExport, "export") - gsub(g, n.sons[0]) + gsub(g, n, 0) put(g, tkSpaces, Space) putWithSpace(g, tkExcept, "except") gcommaAux(g, n, g.indent, 1) @@ -1241,7 +1261,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = putNL(g) of nkFromStmt: putWithSpace(g, tkFrom, "from") - gsub(g, n.sons[0]) + gsub(g, n, 0) put(g, tkSpaces, Space) putWithSpace(g, tkImport, "import") gcomma(g, n, emptyContext, 1) @@ -1264,10 +1284,10 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = gcoms(g) gstmts(g, lastSon(n), c) of nkImportAs: - gsub(g, n.sons[0]) + gsub(g, n, 0) put(g, tkSpaces, Space) putWithSpace(g, tkAs, "as") - gsub(g, n.sons[1]) + gsub(g, n, 1) of nkBindStmt: putWithSpace(g, tkBind, "bind") gcomma(g, n, c) @@ -1277,7 +1297,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = of nkElifBranch: optNL(g) putWithSpace(g, tkElif, "elif") - gsub(g, n.sons[0]) + gsub(g, n, 0) putWithSpace(g, tkColon, ":") gcoms(g) gstmts(g, n.sons[1], c) @@ -1311,7 +1331,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = put(g, tkParLe, "(") gsemicolon(g, n, 1) put(g, tkParRi, ")") - if n.sons[0].kind != nkEmpty: + if n.len > 0 and n.sons[0].kind != nkEmpty: putWithSpace(g, tkColon, ":") gsub(g, n.sons[0]) of nkTupleTy: @@ -1323,13 +1343,15 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = put(g, tkTuple, "tuple") of nkMetaNode_Obsolete: put(g, tkParLe, "(META|") - gsub(g, n.sons[0]) + gsub(g, n, 0) put(g, tkParRi, ")") of nkGotoState, nkState: var c: TContext initContext c putWithSpace g, tkSymbol, if n.kind == nkState: "state" else: "goto" gsons(g, n, c) + of nkBreakState: + put(g, tkTuple, "breakstate") of nkTypeClassTy: gTypeClassTy(g, n) else: diff --git a/compiler/rodread.nim b/compiler/rodread.nim index 2a85c8975..004b30b41 100644 --- a/compiler/rodread.nim +++ b/compiler/rodread.nim @@ -527,7 +527,7 @@ proc cmdChangeTriggersRecompilation(old, new: TCommands): bool = # new command forces us to consider it here :-) case old of cmdCompileToC, cmdCompileToCpp, cmdCompileToOC, - cmdCompileToJS, cmdCompileToLLVM: + cmdCompileToJS, cmdCompileToPHP, cmdCompileToLLVM: if new in {cmdDoc, cmdCheck, cmdIdeTools, cmdPretty, cmdDef, cmdInteractive}: return false diff --git a/compiler/scriptconfig.nim b/compiler/scriptconfig.nim index 22cd282fd..d04fd5231 100644 --- a/compiler/scriptconfig.nim +++ b/compiler/scriptconfig.nim @@ -118,10 +118,10 @@ proc setupVM*(module: PSym; scriptName: string): PEvalContext = processSwitch(a.getString 0, a.getString 1, passPP, unknownLineInfo()) -proc runNimScript*(scriptName: string) = +proc runNimScript*(scriptName: string; freshDefines=true) = passes.gIncludeFile = includeModule passes.gImportModule = importModule - initDefines() + if freshDefines: initDefines() defineSymbol("nimscript") defineSymbol("nimconfig") diff --git a/compiler/sem.nim b/compiler/sem.nim index 041524f84..a8ec2229f 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, nimfix.pretty, semmacrosanity, - semparallel, lowerings, plugins, plugins.active + semparallel, lowerings, pluginsupport, plugins.active when defined(nimfix): import nimfix.prettybase @@ -61,16 +61,10 @@ template semIdeForTemplateOrGeneric(c: PContext; n: PNode; when defined(nimsuggest): assert gCmd == cmdIdeTools if requiresCheck: - if optIdeDebug in gGlobalOptions: - echo "passing to safeSemExpr: ", renderTree(n) + #if optIdeDebug in gGlobalOptions: + # echo "passing to safeSemExpr: ", renderTree(n) discard safeSemExpr(c, n) -proc typeMismatch(n: PNode, formal, actual: PType) = - if formal.kind != tyError and actual.kind != tyError: - localError(n.info, errGenerated, msgKindToString(errTypeMismatch) & - typeToString(actual) & ") " & - `%`(msgKindToString(errButExpectedX), [typeToString(formal)])) - proc fitNode(c: PContext, formal: PType, arg: PNode): PNode = if arg.typ.isNil: localError(arg.info, errExprXHasNoType, @@ -186,10 +180,12 @@ proc newSymG*(kind: TSymKind, n: PNode, c: PContext): PSym = result.owner = getCurrOwner() else: result = newSym(kind, considerQuotedIdent(n), getCurrOwner(), n.info) + #if kind in {skForVar, skLet, skVar} and result.owner.kind == skModule: + # incl(result.flags, sfGlobal) proc semIdentVis(c: PContext, kind: TSymKind, n: PNode, allowed: TSymFlags): PSym - # identifier with visability + # identifier with visibility proc semIdentWithPragma(c: PContext, kind: TSymKind, n: PNode, allowed: TSymFlags): PSym proc semStmtScope(c: PContext, n: PNode): PNode @@ -202,7 +198,7 @@ proc typeAllowedCheck(info: TLineInfo; typ: PType; kind: TSymKind) = "' in this context: '" & typeToString(typ) & "'") proc paramsTypeCheck(c: PContext, typ: PType) {.inline.} = - typeAllowedCheck(typ.n.info, typ, skConst) + typeAllowedCheck(typ.n.info, typ, skProc) proc expectMacroOrTemplateCall(c: PContext, n: PNode): PSym proc semDirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode @@ -358,7 +354,6 @@ proc semMacroExpr(c: PContext, n, nOrig: PNode, sym: PSym, #if c.evalContext == nil: # c.evalContext = c.createEvalContext(emStatic) - result = evalMacroCall(c.module, n, nOrig, sym) if efNoSemCheck notin flags: result = semAfterMacroCall(c, result, sym, flags) @@ -418,6 +413,12 @@ proc myOpen(module: PSym): PPassContext = c.importTable.addSym magicsys.systemModule # import the "System" identifier importAllSymbols(c, magicsys.systemModule) c.topLevelScope = openScope(c) + # don't be verbose unless the module belongs to the main package: + if module.owner.id == gMainPackageId: + gNotes = gMainPackageNotes + else: + if gMainPackageNotes == {}: gMainPackageNotes = gNotes + gNotes = ForeignPackageNotes result = c proc myOpenCached(module: PSym, rd: PRodReader): PPassContext = @@ -441,6 +442,8 @@ proc semStmtAndGenerateGenerics(c: PContext, n: PNode): PNode = result = hloStmt(c, result) if gCmd == cmdInteractive and not isEmptyType(result.typ): result = buildEchoStmt(c, result) + if gCmd == cmdIdeTools: + appendToModule(c.module, result) result = transformStmt(c.module, result) proc recoverContext(c: PContext) = @@ -483,4 +486,3 @@ proc myClose(context: PPassContext, n: PNode): PNode = popProcCon(c) const semPass* = makePass(myOpen, myOpenCached, myProcess, myClose) - diff --git a/compiler/semcall.nim b/compiler/semcall.nim index 381093531..17dd39595 100644 --- a/compiler/semcall.nim +++ b/compiler/semcall.nim @@ -50,7 +50,8 @@ proc pickBestCandidate(c: PContext, headSymbol: PNode, var syms: seq[tuple[a: PSym, b: int]] = @[] while symx != nil: - if symx.kind in filter: syms.add((symx, o.lastOverloadScope)) + if symx.kind in filter: + syms.add((symx, o.lastOverloadScope)) symx = nextOverloadIter(o, c, headSymbol) if syms.len == 0: return @@ -63,7 +64,6 @@ proc pickBestCandidate(c: PContext, headSymbol: PNode, let sym = syms[i][0] determineType(c, sym) initCandidate(c, z, sym, initialBinding, syms[i][1]) - z.calleeSym = sym #if sym.name.s == "*" and (n.info ?? "temp5.nim") and n.info.line == 140: # gDebug = true @@ -75,7 +75,7 @@ proc pickBestCandidate(c: PContext, headSymbol: PNode, errors.add(err) if z.state == csMatch: # little hack so that iterators are preferred over everything else: - if sym.kind in skIterators: inc(z.exactMatches, 200) + if sym.kind == skIterator: inc(z.exactMatches, 200) case best.state of csEmpty, csNoMatch: best = z of csMatch: @@ -95,7 +95,7 @@ proc notFoundError*(c: PContext, n: PNode, errors: CandidateErrors) = # Gives a detailed error message; this is separated from semOverloadedCall, # as semOverlodedCall is already pretty slow (and we need this information # only in case of an error). - if c.compilesContextId > 0: + if c.compilesContextId > 0 and optReportConceptFailures notin gGlobalOptions: # fail fast: globalError(n.info, errTypeMismatch, "") if errors.isNil or errors.len == 0: @@ -133,12 +133,10 @@ proc notFoundError*(c: PContext, n: PNode, errors: CandidateErrors) = add(candidates, "\n") if candidates != "": add(result, "\n" & msgKindToString(errButExpected) & "\n" & candidates) - localError(n.info, errGenerated, result) - -proc gatherUsedSyms(c: PContext, usedSyms: var seq[PNode]) = - for scope in walkScopes(c.currentScope): - if scope.usingSyms != nil: - for s in scope.usingSyms: usedSyms.safeAdd(s) + if c.compilesContextId > 0 and optReportConceptFailures in gGlobalOptions: + globalError(n.info, errGenerated, result) + else: + localError(n.info, errGenerated, result) proc resolveOverloads(c: PContext, n, orig: PNode, filter: TSymKinds; @@ -153,31 +151,30 @@ proc resolveOverloads(c: PContext, n, orig: PNode, else: initialBinding = nil - var usedSyms: seq[PNode] - - template pickBest(headSymbol: expr) = + template pickBest(headSymbol) = pickBestCandidate(c, headSymbol, n, orig, initialBinding, filter, result, alt, errors) - gatherUsedSyms(c, usedSyms) - if usedSyms != nil: - var hiddenArg = if usedSyms.len > 1: newNode(nkClosedSymChoice, n.info, usedSyms) - else: usedSyms[0] - - n.sons.insert(hiddenArg, 1) - orig.sons.insert(hiddenArg, 1) - - pickBest(f) - - if result.state != csMatch: - n.sons.delete(1) - orig.sons.delete(1) - else: return pickBest(f) let overloadsState = result.state if overloadsState != csMatch: + if c.p != nil and c.p.selfSym != nil: + # we need to enforce semchecking of selfSym again because it + # might need auto-deref: + var hiddenArg = newSymNode(c.p.selfSym) + hiddenArg.typ = nil + n.sons.insert(hiddenArg, 1) + orig.sons.insert(hiddenArg, 1) + + pickBest(f) + + if result.state != csMatch: + n.sons.delete(1) + orig.sons.delete(1) + else: return + if nfDotField in n.flags: internalAssert f.kind == nkIdent and n.sonsLen >= 2 let calleeName = newStrNode(nkStrLit, f.ident.s).withInfo(n.info) @@ -252,12 +249,13 @@ proc resolveOverloads(c: PContext, n, orig: PNode, proc instGenericConvertersArg*(c: PContext, a: PNode, x: TCandidate) = - if a.kind == nkHiddenCallConv and a.sons[0].kind == nkSym and - isGenericRoutine(a.sons[0].sym): - let finalCallee = generateInstance(c, a.sons[0].sym, x.bindings, a.info) - a.sons[0].sym = finalCallee - a.sons[0].typ = finalCallee.typ - #a.typ = finalCallee.typ.sons[0] + if a.kind == nkHiddenCallConv and a.sons[0].kind == nkSym: + let s = a.sons[0].sym + if s.ast != nil and s.ast[genericParamsPos].kind != nkEmpty: + let finalCallee = generateInstance(c, s, x.bindings, a.info) + a.sons[0].sym = finalCallee + a.sons[0].typ = finalCallee.typ + #a.typ = finalCallee.typ.sons[0] proc instGenericConvertersSons*(c: PContext, n: PNode, x: TCandidate) = assert n.kind in nkCallKinds @@ -363,7 +361,19 @@ proc explicitGenericInstError(n: PNode): PNode = proc explicitGenericSym(c: PContext, n: PNode, s: PSym): PNode = var m: TCandidate - initCandidate(c, m, s, n) + # binding has to stay 'nil' for this to work! + initCandidate(c, m, s, nil) + + for i in 1..sonsLen(n)-1: + let formal = s.ast.sons[genericParamsPos].sons[i-1].typ + let arg = n[i].typ + let tm = typeRel(m, formal, arg, true) + if tm in {isNone, isConvertible}: + if formal.sonsLen > 0 and formal.sons[0].kind != tyNone: + typeMismatch(n, formal.sons[0], arg) + else: + typeMismatch(n, formal, arg) + break var newInst = generateInstance(c, s, m.bindings, n.info) markUsed(n.info, s) styleCheckUse(n.info, s) @@ -392,7 +402,7 @@ proc explicitGenericInstantiation(c: PContext, n: PNode, s: PSym): PNode = for i in countup(0, len(a)-1): var candidate = a.sons[i].sym if candidate.kind in {skProc, skMethod, skConverter, - skIterator, skClosureIterator}: + skIterator}: # it suffices that the candidate has the proper number of generic # type parameters: if safeLen(candidate.ast.sons[genericParamsPos]) == n.len-1: @@ -416,7 +426,13 @@ proc searchForBorrowProc(c: PContext, startScope: PScope, fn: PSym): PSym = let param = fn.typ.n.sons[i] let t = skipTypes(param.typ, abstractVar-{tyTypeDesc}) if t.kind == tyDistinct or param.typ.kind == tyDistinct: hasDistinct = true - call.add(newNodeIT(nkEmpty, fn.info, t.baseOfDistinct)) + var x: PType + if param.typ.kind == tyVar: + x = newTypeS(tyVar, c) + x.addSonSkipIntLit t.baseOfDistinct + else: + x = t.baseOfDistinct + call.add(newNodeIT(nkEmpty, fn.info, x)) if hasDistinct: var resolved = semOverloadedCall(c, call, call, {fn.kind}) if resolved != nil: diff --git a/compiler/semdata.nim b/compiler/semdata.nim index 9b2f2e2ce..b25f72f2d 100644 --- a/compiler/semdata.nim +++ b/compiler/semdata.nim @@ -30,6 +30,7 @@ type # statements owner*: PSym # the symbol this context belongs to resultSym*: PSym # the result symbol (if we are in a proc) + selfSym*: PSym # the 'self' symbol (if available) nestedLoopCounter*: int # whether we are in a loop or not nestedBlockCounter*: int # whether we are in a block or not inTryStmt*: int # whether we are in a try statement; works also @@ -46,7 +47,7 @@ type efLValue, efWantIterator, efInTypeof, efWantStmt, efAllowStmt, efDetermineType, efAllowDestructor, efWantValue, efOperand, efNoSemCheck, - efNoProcvarCheck + efNoProcvarCheck, efFromHlo TExprFlags* = set[TExprFlag] TTypeAttachedOp* = enum @@ -103,7 +104,8 @@ type inParallelStmt*: int instTypeBoundOp*: proc (c: PContext; dc: PSym; t: PType; info: TLineInfo; op: TTypeAttachedOp): PSym {.nimcall.} - + selfName*: PIdent + signatures*: TStrTable proc makeInstPair*(s: PSym, inst: PInstantiation): TInstantiationPair = result.genericSym = s @@ -154,16 +156,6 @@ proc popOwner() = proc lastOptionEntry(c: PContext): POptionEntry = result = POptionEntry(c.optionStack.tail) -proc pushProcCon*(c: PContext, owner: PSym) {.inline.} = - if owner == nil: - internalError("owner is nil") - return - var x: PProcCon - new(x) - x.owner = owner - x.next = c.p - c.p = x - proc popProcCon*(c: PContext) {.inline.} = c.p = c.p.next proc newOptionEntry(): POptionEntry = @@ -187,6 +179,8 @@ proc newContext(module: PSym): PContext = initStrTable(result.userPragmas) result.generics = @[] result.unknownIdents = initIntSet() + initStrTable(result.signatures) + proc inclSym(sq: var TSymSeq, s: PSym) = var L = len(sq) @@ -315,7 +309,7 @@ proc makeRangeType*(c: PContext; first, last: BiggestInt; addSonSkipIntLit(result, intType) # basetype of range proc markIndirect*(c: PContext, s: PSym) {.inline.} = - if s.kind in {skProc, skConverter, skMethod, skIterator, skClosureIterator}: + if s.kind in {skProc, skConverter, skMethod, skIterator}: incl(s.flags, sfAddrTaken) # XXX add to 'c' for global analysis diff --git a/compiler/semexprs.nim b/compiler/semexprs.nim index 4792702dc..7135dcf34 100644 --- a/compiler/semexprs.nim +++ b/compiler/semexprs.nim @@ -15,7 +15,7 @@ proc semTemplateExpr(c: PContext, n: PNode, s: PSym, markUsed(n.info, s) styleCheckUse(n.info, s) pushInfoContext(n.info) - result = evalTemplate(n, s, getCurrOwner()) + result = evalTemplate(n, s, getCurrOwner(), efFromHlo in flags) if efNoSemCheck notin flags: result = semAfterMacroCall(c, result, s, flags) popInfoContext() @@ -24,10 +24,10 @@ proc semFieldAccess(c: PContext, n: PNode, flags: TExprFlags = {}): PNode proc semOperand(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = # same as 'semExprWithType' but doesn't check for proc vars result = semExpr(c, n, flags + {efOperand}) - if result.kind == nkEmpty and result.typ.isNil: + #if result.kind == nkEmpty and result.typ.isNil: # do not produce another redundant error message: #raiseRecoverableError("") - result = errorNode(c, n) + # result = errorNode(c, n) if result.typ != nil: # XXX tyGenericInst here? if result.typ.kind == tyVar: result = newDeref(result) @@ -74,90 +74,12 @@ proc semSymGenericInstantiation(c: PContext, n: PNode, s: PSym): PNode = proc inlineConst(n: PNode, s: PSym): PNode {.inline.} = result = copyTree(s.ast) - result.typ = s.typ - result.info = n.info - -proc semSym(c: PContext, n: PNode, s: PSym, flags: TExprFlags): PNode = - case s.kind - of skConst: - markUsed(n.info, s) - styleCheckUse(n.info, s) - case skipTypes(s.typ, abstractInst-{tyTypeDesc}).kind - of tyNil, tyChar, tyInt..tyInt64, tyFloat..tyFloat128, - tyTuple, tySet, tyUInt..tyUInt64: - if s.magic == mNone: result = inlineConst(n, s) - else: result = newSymNode(s, n.info) - of tyArrayConstr, tySequence: - # Consider:: - # const x = [] - # proc p(a: openarray[int]) - # proc q(a: openarray[char]) - # p(x) - # q(x) - # - # It is clear that ``[]`` means two totally different things. Thus, we - # copy `x`'s AST into each context, so that the type fixup phase can - # deal with two different ``[]``. - if s.ast.len == 0: result = inlineConst(n, s) - else: result = newSymNode(s, n.info) - else: - result = newSymNode(s, n.info) - of skMacro: result = semMacroExpr(c, n, n, s, flags) - of skTemplate: result = semTemplateExpr(c, n, s, flags) - of skParam: - markUsed(n.info, s) - styleCheckUse(n.info, s) - if s.typ.kind == tyStatic and s.typ.n != nil: - # XXX see the hack in sigmatch.nim ... - return s.typ.n - elif sfGenSym in s.flags: - if c.p.wasForwarded: - # gensym'ed parameters that nevertheless have been forward declared - # need a special fixup: - let realParam = c.p.owner.typ.n[s.position+1] - internalAssert realParam.kind == nkSym and realParam.sym.kind == skParam - return newSymNode(c.p.owner.typ.n[s.position+1].sym, n.info) - elif c.p.owner.kind == skMacro: - # gensym'ed macro parameters need a similar hack (see bug #1944): - var u = searchInScopes(c, s.name) - internalAssert u != nil and u.kind == skParam and u.owner == s.owner - return newSymNode(u, n.info) - result = newSymNode(s, n.info) - of skVar, skLet, skResult, skForVar: - if s.magic == mNimvm: - localError(n.info, "illegal context for 'nimvm' magic") - - markUsed(n.info, s) - styleCheckUse(n.info, s) - # if a proc accesses a global variable, it is not side effect free: - if sfGlobal in s.flags: - incl(c.p.owner.flags, sfSideEffect) - result = newSymNode(s, n.info) - # We cannot check for access to outer vars for example because it's still - # not sure the symbol really ends up being used: - # var len = 0 # but won't be called - # genericThatUsesLen(x) # marked as taking a closure? - of skGenericParam: - styleCheckUse(n.info, s) - if s.typ.kind == tyStatic: - result = newSymNode(s, n.info) - result.typ = s.typ - elif s.ast != nil: - result = semExpr(c, s.ast) - else: - n.typ = s.typ - return n - of skType: - markUsed(n.info, s) - styleCheckUse(n.info, s) - if s.typ.kind == tyStatic and s.typ.n != nil: - return s.typ.n - result = newSymNode(s, n.info) - result.typ = makeTypeDesc(c, s.typ) + if result.isNil: + localError(n.info, "constant of type '" & typeToString(s.typ) & "' has no value") + result = newSymNode(s) else: - markUsed(n.info, s) - styleCheckUse(n.info, s) - result = newSymNode(s, n.info) + result.typ = s.typ + result.info = n.info type TConvStatus = enum @@ -165,8 +87,9 @@ type convNotNeedeed, convNotLegal -proc checkConversionBetweenObjects(castDest, src: PType): TConvStatus = - return if inheritanceDiff(castDest, src) == high(int): +proc checkConversionBetweenObjects(castDest, src: PType; pointers: int): TConvStatus = + let diff = inheritanceDiff(castDest, src) + return if diff == high(int) or (pointers > 1 and diff != 0): convNotLegal else: convOK @@ -183,13 +106,15 @@ proc checkConvertible(c: PContext, castDest, src: PType): TConvStatus = return var d = skipTypes(castDest, abstractVar) var s = skipTypes(src, abstractVar-{tyTypeDesc}) + var pointers = 0 while (d != nil) and (d.kind in {tyPtr, tyRef}) and (d.kind == s.kind): d = d.lastSon s = s.lastSon + inc pointers if d == nil: result = convNotLegal elif d.kind == tyObject and s.kind == tyObject: - result = checkConversionBetweenObjects(d, s) + result = checkConversionBetweenObjects(d, s, pointers) elif (skipTypes(castDest, abstractVarRange).kind in IntegralTypes) and (skipTypes(src, abstractVarRange-{tyTypeDesc}).kind in IntegralTypes): # accept conversion between integral types @@ -288,12 +213,10 @@ proc semConv(c: PContext, n: PNode): PNode = styleCheckUse(n.info, it.sym) markIndirect(c, it.sym) return it - localError(n.info, errUseQualifier, op.sons[0].sym.name.s) + errorUseQualifier(c, n.info, op.sons[0].sym) proc semCast(c: PContext, n: PNode): PNode = ## Semantically analyze a casting ("cast[type](param)") - if optSafeCode in gGlobalOptions: localError(n.info, errCastNotInSafeMode) - #incl(c.p.owner.flags, sfSideEffect) checkSonsLen(n, 2) result = newNodeI(nkCast, n.info) result.typ = semTypeNode(c, n.sons[0], nil) @@ -387,7 +310,8 @@ proc isOpImpl(c: PContext, n: PNode): PNode = result = newIntNode(nkIntLit, ord(t.kind == tyProc and t.callConv == ccClosure and tfIterator notin t.flags)) - else: discard + else: + result = newIntNode(nkIntLit, 0) else: var t2 = n[2].typ.skipTypes({tyTypeDesc}) maybeLiftType(t2, c, n.info) @@ -754,11 +678,11 @@ proc semOverloadedCallAnalyseEffects(c: PContext, n: PNode, nOrig: PNode, flags: TExprFlags): PNode = if flags*{efInTypeof, efWantIterator} != {}: # consider: 'for x in pReturningArray()' --> we don't want the restriction - # to 'skIterators' anymore; skIterators are preferred in sigmatch already + # to 'skIterator' anymore; skIterator is preferred in sigmatch already # for typeof support. # for ``type(countup(1,3))``, see ``tests/ttoseq``. result = semOverloadedCall(c, n, nOrig, - {skProc, skMethod, skConverter, skMacro, skTemplate}+skIterators) + {skProc, skMethod, skConverter, skMacro, skTemplate, skIterator}) else: result = semOverloadedCall(c, n, nOrig, {skProc, skMethod, skConverter, skMacro, skTemplate}) @@ -771,7 +695,7 @@ proc semOverloadedCallAnalyseEffects(c: PContext, n: PNode, nOrig: PNode, case callee.kind of skMacro, skTemplate: discard else: - if callee.kind in skIterators and callee.id == c.p.owner.id: + if callee.kind == skIterator and callee.id == c.p.owner.id: localError(n.info, errRecursiveDependencyX, callee.name.s) # error correction, prevents endless for loop elimination in transf. # See bug #2051: @@ -809,6 +733,9 @@ proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode = return semExpr(c, result, flags) else: n.sons[0] = semExpr(c, n.sons[0]) + let t = n.sons[0].typ + if t != nil and t.kind == tyVar: + n.sons[0] = newDeref(n.sons[0]) let nOrig = n.copyTree semOpAux(c, n) var t: PType = nil @@ -1013,6 +940,116 @@ proc readTypeParameter(c: PContext, typ: PType, return newSymNode(copySym(tParam.sym).linkTo(foundTyp), info) #echo "came here: returned nil" +proc semSym(c: PContext, n: PNode, s: PSym, flags: TExprFlags): PNode = + case s.kind + of skConst: + markUsed(n.info, s) + styleCheckUse(n.info, s) + case skipTypes(s.typ, abstractInst-{tyTypeDesc}).kind + of tyNil, tyChar, tyInt..tyInt64, tyFloat..tyFloat128, + tyTuple, tySet, tyUInt..tyUInt64: + if s.magic == mNone: result = inlineConst(n, s) + else: result = newSymNode(s, n.info) + of tyArrayConstr, tySequence: + # Consider:: + # const x = [] + # proc p(a: openarray[int]) + # proc q(a: openarray[char]) + # p(x) + # q(x) + # + # It is clear that ``[]`` means two totally different things. Thus, we + # copy `x`'s AST into each context, so that the type fixup phase can + # deal with two different ``[]``. + if s.ast.len == 0: result = inlineConst(n, s) + else: result = newSymNode(s, n.info) + else: + result = newSymNode(s, n.info) + of skMacro: result = semMacroExpr(c, n, n, s, flags) + of skTemplate: result = semTemplateExpr(c, n, s, flags) + of skParam: + markUsed(n.info, s) + styleCheckUse(n.info, s) + if s.typ.kind == tyStatic and s.typ.n != nil: + # XXX see the hack in sigmatch.nim ... + return s.typ.n + elif sfGenSym in s.flags: + if c.p.wasForwarded: + # gensym'ed parameters that nevertheless have been forward declared + # need a special fixup: + let realParam = c.p.owner.typ.n[s.position+1] + internalAssert realParam.kind == nkSym and realParam.sym.kind == skParam + return newSymNode(c.p.owner.typ.n[s.position+1].sym, n.info) + elif c.p.owner.kind == skMacro: + # gensym'ed macro parameters need a similar hack (see bug #1944): + var u = searchInScopes(c, s.name) + internalAssert u != nil and u.kind == skParam and u.owner == s.owner + return newSymNode(u, n.info) + result = newSymNode(s, n.info) + of skVar, skLet, skResult, skForVar: + if s.magic == mNimvm: + localError(n.info, "illegal context for 'nimvm' magic") + + markUsed(n.info, s) + styleCheckUse(n.info, s) + # if a proc accesses a global variable, it is not side effect free: + if sfGlobal in s.flags: + incl(c.p.owner.flags, sfSideEffect) + result = newSymNode(s, n.info) + # We cannot check for access to outer vars for example because it's still + # not sure the symbol really ends up being used: + # var len = 0 # but won't be called + # genericThatUsesLen(x) # marked as taking a closure? + of skGenericParam: + styleCheckUse(n.info, s) + if s.typ.kind == tyStatic: + result = newSymNode(s, n.info) + result.typ = s.typ + elif s.ast != nil: + result = semExpr(c, s.ast) + else: + n.typ = s.typ + return n + of skType: + markUsed(n.info, s) + styleCheckUse(n.info, s) + if s.typ.kind == tyStatic and s.typ.n != nil: + return s.typ.n + result = newSymNode(s, n.info) + result.typ = makeTypeDesc(c, s.typ) + of skField: + if c.p != nil and c.p.selfSym != nil: + var ty = skipTypes(c.p.selfSym.typ, {tyGenericInst, tyVar, tyPtr, tyRef}) + while tfBorrowDot in ty.flags: ty = ty.skipTypes({tyDistinct}) + var check: PNode = nil + if ty.kind == tyObject: + while true: + check = nil + let f = lookupInRecordAndBuildCheck(c, n, ty.n, s.name, check) + if f != nil and fieldVisible(c, f): + # is the access to a public field or in the same module or in a friend? + doAssert f == s + markUsed(n.info, f) + styleCheckUse(n.info, f) + result = newNodeIT(nkDotExpr, n.info, f.typ) + result.add makeDeref(newSymNode(c.p.selfSym)) + result.add newSymNode(f) # we now have the correct field + if check != nil: + check.sons[0] = result + check.typ = result.typ + result = check + return result + if ty.sons[0] == nil: break + ty = skipTypes(ty.sons[0], {tyGenericInst}) + # old code, not sure if it's live code: + markUsed(n.info, s) + styleCheckUse(n.info, s) + result = newSymNode(s, n.info) + else: + markUsed(n.info, s) + styleCheckUse(n.info, s) + result = newSymNode(s, n.info) + proc builtinFieldAccess(c: PContext, n: PNode, flags: TExprFlags): PNode = ## returns nil if it's not a built-in field access checkSonsLen(n, 2) @@ -1199,7 +1236,7 @@ proc semSubscript(c: PContext, n: PNode, flags: TExprFlags): PNode = let s = if n.sons[0].kind == nkSym: n.sons[0].sym elif n[0].kind in nkSymChoices: n.sons[0][0].sym else: nil - if s != nil and s.kind in {skProc, skMethod, skConverter}+skIterators: + if s != nil and s.kind in {skProc, skMethod, skConverter, skIterator}: # type parameters: partial generic specialization n.sons[0] = semSymGenericInstantiation(c, n.sons[0], s) result = explicitGenericInstantiation(c, n, s) @@ -1347,8 +1384,8 @@ proc semAsgn(c: PContext, n: PNode; mode=asgnNormal): PNode = proc semReturn(c: PContext, n: PNode): PNode = result = n checkSonsLen(n, 1) - if c.p.owner.kind in {skConverter, skMethod, skProc, skMacro, - skClosureIterator}: + if c.p.owner.kind in {skConverter, skMethod, skProc, skMacro} or ( + c.p.owner.kind == skIterator and c.p.owner.typ.callConv == ccClosure): if n.sons[0].kind != nkEmpty: # transform ``return expr`` to ``result = expr; return`` if c.p.resultSym != nil: @@ -1424,7 +1461,7 @@ proc semYieldVarResult(c: PContext, n: PNode, restype: PType) = proc semYield(c: PContext, n: PNode): PNode = result = n checkSonsLen(n, 1) - if c.p.owner == nil or c.p.owner.kind notin skIterators: + if c.p.owner == nil or c.p.owner.kind != skIterator: localError(n.info, errYieldNotAllowedHere) elif c.p.inTryStmt > 0 and c.p.owner.typ.callConv != ccInline: localError(n.info, errYieldNotAllowedInTryStmt) @@ -1433,20 +1470,15 @@ proc semYield(c: PContext, n: PNode): PNode = var iterType = c.p.owner.typ let restype = iterType.sons[0] if restype != nil: - let adjustedRes = if restype.kind == tyIter: restype.base - else: restype - if adjustedRes.kind != tyExpr: - n.sons[0] = fitNode(c, adjustedRes, n.sons[0]) + if restype.kind != tyExpr: + n.sons[0] = fitNode(c, restype, n.sons[0]) if n.sons[0].typ == nil: internalError(n.info, "semYield") - if resultTypeIsInferrable(adjustedRes): + if resultTypeIsInferrable(restype): let inferred = n.sons[0].typ - if restype.kind == tyIter: - restype.sons[0] = inferred - else: - iterType.sons[0] = inferred + iterType.sons[0] = inferred - semYieldVarResult(c, n, adjustedRes) + semYieldVarResult(c, n, restype) else: localError(n.info, errCannotReturnExpr) elif c.p.owner.typ.sons[0] != nil: @@ -1531,24 +1563,6 @@ proc newAnonSym(kind: TSymKind, info: TLineInfo, result = newSym(kind, idAnon, owner, info) result.flags = {sfGenSym} -proc semUsing(c: PContext, n: PNode): PNode = - result = newNodeI(nkEmpty, n.info) - if not experimentalMode(c): - localError(n.info, "use the {.experimental.} pragma to enable 'using'") - for e in n.sons: - let usedSym = semExpr(c, e) - if usedSym.kind == nkSym: - case usedSym.sym.kind - of skLocalVars + {skConst}: - c.currentScope.usingSyms.safeAdd(usedSym) - continue - of skProcKinds: - addDeclAt(c.currentScope, usedSym.sym) - continue - else: discard - - localError(e.info, errUsingNoSymbol, e.renderTree) - proc semExpandToAst(c: PContext, n: PNode): PNode = var macroCall = n[1] var expandedSym = expectMacroOrTemplateCall(c, macroCall) @@ -1656,11 +1670,13 @@ proc tryExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = let oldInGenericInst = c.inGenericInst let oldProcCon = c.p c.generics = @[] + var err: string try: result = semExpr(c, n, flags) if msgs.gErrorCounter != oldErrorCount: result = nil except ERecoverableError: - discard + if optReportConceptFailures in gGlobalOptions: + err = getCurrentExceptionMsg() # undo symbol table changes (as far as it's possible): c.compilesContextId = oldCompilesId c.generics = oldGenerics @@ -1674,6 +1690,8 @@ proc tryExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = errorOutputs = oldErrorOutputs msgs.gErrorCounter = oldErrorCount msgs.gErrorMax = oldErrorMax + if optReportConceptFailures in gGlobalOptions and not err.isNil: + localError(n.info, err) proc semCompiles(c: PContext, n: PNode, flags: TExprFlags): PNode = # we replace this node by a 'true' or 'false' node: @@ -1775,7 +1793,24 @@ proc semMagic(c: PContext, n: PNode, s: PSym, flags: TExprFlags): PNode = result = setMs(n, s) result.sons[1] = semExpr(c, n.sons[1]) result.typ = n[1].typ - else: result = semDirectOp(c, n, flags) + of mPlugin: + # semDirectOp with conditional 'afterCallActions': + let nOrig = n.copyTree + #semLazyOpAux(c, n) + result = semOverloadedCallAnalyseEffects(c, n, nOrig, flags) + if result == nil: + result = errorNode(c, n) + else: + let callee = result.sons[0].sym + if callee.magic == mNone: + semFinishOperands(c, result) + activate(c, result) + fixAbstractType(c, result) + analyseIfAddressTakenInCall(c, result) + if callee.magic != mNone: + result = magicsAfterOverloadResolution(c, result, flags) + else: + result = semDirectOp(c, n, flags) proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = # If semCheck is set to false, ``when`` will return the verbatim AST of @@ -1783,7 +1818,7 @@ proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = result = nil template setResult(e: expr) = - if semCheck: result = semStmt(c, e) # do not open a new scope! + if semCheck: result = semExpr(c, e) # do not open a new scope! else: result = e # Check if the node is "when nimvm" @@ -1792,6 +1827,7 @@ proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = # else: # ... var whenNimvm = false + var typ = commonTypeBegin if n.sons.len == 2 and n.sons[0].kind == nkElifBranch and n.sons[1].kind == nkElse: let exprNode = n.sons[0].sons[0] @@ -1799,6 +1835,7 @@ proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = whenNimvm = lookUp(c, exprNode).magic == mNimvm elif exprNode.kind == nkSym: whenNimvm = exprNode.sym.magic == mNimvm + if whenNimvm: n.flags.incl nfLL for i in countup(0, sonsLen(n) - 1): var it = n.sons[i] @@ -1807,7 +1844,8 @@ proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = checkSonsLen(it, 2) if whenNimvm: if semCheck: - it.sons[1] = semStmt(c, it.sons[1]) + it.sons[1] = semExpr(c, it.sons[1]) + typ = commonType(typ, it.sons[1].typ) result = n # when nimvm is not elimited until codegen else: var e = semConstExpr(c, it.sons[0]) @@ -1821,12 +1859,14 @@ proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = checkSonsLen(it, 1) if result == nil or whenNimvm: if semCheck: - it.sons[0] = semStmt(c, it.sons[0]) + it.sons[0] = semExpr(c, it.sons[0]) + typ = commonType(typ, it.sons[0].typ) if result == nil: result = it.sons[0] else: illFormedAst(n) if result == nil: result = newNodeI(nkEmpty, n.info) + if whenNimvm: result.typ = typ # The ``when`` statement implements the mechanism for platform dependent # code. Thus we try to ensure here consistent ID allocation after the # ``when`` statement. @@ -2078,11 +2118,6 @@ proc semExport(c: PContext, n: PNode): PNode = x.add(newSymNode(s, a.info)) strTableAdd(c.module.tab, s) s = nextOverloadIter(o, c, a) - 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 shouldBeBracketExpr(n: PNode): bool = @@ -2111,7 +2146,7 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = var s = lookUp(c, n) if c.inTypeClass == 0: semCaptureSym(s, c.p.owner) result = semSym(c, n, s, flags) - if s.kind in {skProc, skMethod, skConverter}+skIterators: + if s.kind in {skProc, skMethod, skConverter, skIterator}: #performProcvarCheck(c, n, s) result = symChoice(c, n, s, scClosed) if result.kind == nkSym: @@ -2167,7 +2202,7 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = message(n.info, warnDeprecated, "bind") result = semExpr(c, n.sons[0], flags) of nkTypeOfExpr, nkTupleTy, nkTupleClassTy, nkRefTy..nkEnumTy, nkStaticTy: - var typ = semTypeNode(c, n, nil).skipTypes({tyTypeDesc, tyIter}) + var typ = semTypeNode(c, n, nil).skipTypes({tyTypeDesc}) result.typ = makeTypeDesc(c, typ) #result = symNodeFromType(c, typ, n.info) of nkCall, nkInfix, nkPrefix, nkPostfix, nkCommand, nkCallStrLit: @@ -2196,10 +2231,10 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = elif n.len == 1: result = semObjConstr(c, n, flags) elif contains(c.ambiguousSymbols, s.id): - localError(n.info, errUseQualifier, s.name.s) + errorUseQualifier(c, n.info, s) elif s.magic == mNone: result = semDirectOp(c, n, flags) else: result = semMagic(c, n, s, flags) - of skProc, skMethod, skConverter, skIterators: + of skProc, skMethod, skConverter, skIterator: if s.magic == mNone: result = semDirectOp(c, n, flags) else: result = semMagic(c, n, s, flags) else: @@ -2240,7 +2275,7 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = var tupexp = semTuplePositionsConstr(c, n, flags) if isTupleType(tupexp): # reinterpret as type - var typ = semTypeNode(c, n, nil).skipTypes({tyTypeDesc, tyIter}) + var typ = semTypeNode(c, n, nil).skipTypes({tyTypeDesc}) result.typ = makeTypeDesc(c, typ) else: result = tupexp @@ -2312,7 +2347,7 @@ proc semExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = if not isTopLevel(c): localError(n.info, errXOnlyAtModuleScope, "from") result = evalFrom(c, n) of nkIncludeStmt: - if not isTopLevel(c): localError(n.info, errXOnlyAtModuleScope, "include") + #if not isTopLevel(c): localError(n.info, errXOnlyAtModuleScope, "include") result = evalInclude(c, n) of nkExportStmt, nkExportExceptStmt: if not isTopLevel(c): localError(n.info, errXOnlyAtModuleScope, "export") diff --git a/compiler/semfold.nim b/compiler/semfold.nim index 5fe4e3299..c5a8cc2a2 100644 --- a/compiler/semfold.nim +++ b/compiler/semfold.nim @@ -419,7 +419,14 @@ proc evalOp(m: TMagic, n, a, b, c: PNode): PNode = result = newStrNodeT(substr(getStr(a), int(getOrdValue(b)), int(getOrdValue(c))), n) of mFloatToStr: result = newStrNodeT($getFloat(a), n) - of mCStrToStr, mCharToStr: result = newStrNodeT(getStrOrChar(a), n) + of mCStrToStr, mCharToStr: + if a.kind == nkBracket: + var s = "" + for b in a.sons: + s.add b.getStrOrChar + result = newStrNodeT(s, n) + else: + result = newStrNodeT(getStrOrChar(a), n) of mStrToStr: result = a of mEnumToStr: result = newStrNodeT(ordinalValToString(a), n) of mArrToSeq: diff --git a/compiler/semgnrc.nim b/compiler/semgnrc.nim index 620453277..6651de78e 100644 --- a/compiler/semgnrc.nim +++ b/compiler/semgnrc.nim @@ -58,7 +58,7 @@ proc semGenericStmtSymbol(c: PContext, n: PNode, s: PSym, of skUnknown: # Introduced in this pass! Leave it as an identifier. result = n - of skProc, skMethod, skIterators, skConverter, skModule: + of skProc, skMethod, skIterator, skConverter, skModule: result = symChoice(c, n, s, scOpen) of skTemplate: if macroToExpand(s): @@ -226,7 +226,7 @@ proc semGenericStmt(c: PContext, n: PNode, of skUnknown, skParam: # Leave it as an identifier. discard - of skProc, skMethod, skIterators, skConverter, skModule: + of skProc, skMethod, skIterator, skConverter, skModule: result.sons[0] = symChoice(c, fn, s, scOption) # do not check of 's.magic==mRoof' here because it might be some # other '^' but after overload resolution the proper one: diff --git a/compiler/seminst.nim b/compiler/seminst.nim index abc5600c3..14631a590 100644 --- a/compiler/seminst.nim +++ b/compiler/seminst.nim @@ -10,6 +10,47 @@ # This module implements the instantiation of generic procs. # included from sem.nim +proc addObjFieldsToLocalScope(c: PContext; n: PNode) = + template rec(n) = addObjFieldsToLocalScope(c, n) + case n.kind + of nkRecList: + for i in countup(0, len(n)-1): + rec n[i] + of nkRecCase: + if n.len > 0: rec n.sons[0] + for i in countup(1, len(n)-1): + if n[i].kind in {nkOfBranch, nkElse}: rec lastSon(n[i]) + of nkSym: + let f = n.sym + if f.kind == skField and fieldVisible(c, f): + c.currentScope.symbols.strTableIncl(f, onConflictKeepOld=true) + incl(f.flags, sfUsed) + # it is not an error to shadow fields via parameters + else: discard + +proc rawPushProcCon(c: PContext, owner: PSym) = + var x: PProcCon + new(x) + x.owner = owner + x.next = c.p + c.p = x + +proc rawHandleSelf(c: PContext; owner: PSym) = + if c.selfName != nil and owner.kind in {skProc, skMethod, skConverter, skIterator, skMacro} and owner.typ != nil: + let params = owner.typ.n + if params.len > 1: + let arg = params[1].sym + if arg.name.id == c.selfName.id: + c.p.selfSym = arg + arg.flags.incl sfIsSelf + let t = c.p.selfSym.typ.skipTypes(abstractPtrs) + if t.kind == tyObject: + addObjFieldsToLocalScope(c, t.n) + +proc pushProcCon*(c: PContext; owner: PSym) = + rawPushProcCon(c, owner) + rawHandleSelf(c, owner) + iterator instantiateGenericParamList(c: PContext, n: PNode, pt: TIdTable): PSym = internalAssert n.kind == nkGenericParams for i, a in n.pairs: @@ -70,9 +111,9 @@ proc removeDefaultParamValues(n: PNode) = # not possible... XXX We don't solve this issue here. a.sons[L-1] = ast.emptyNode -proc freshGenSyms(n: PNode, owner: PSym, symMap: var TIdTable) = +proc freshGenSyms(n: PNode, owner, orig: PSym, symMap: var TIdTable) = # we need to create a fresh set of gensym'ed symbols: - if n.kind == nkSym and sfGenSym in n.sym.flags: + if n.kind == nkSym and sfGenSym in n.sym.flags and n.sym.owner == orig: let s = n.sym var x = PSym(idTableGet(symMap, s)) if x == nil: @@ -81,7 +122,7 @@ proc freshGenSyms(n: PNode, owner: PSym, symMap: var TIdTable) = idTablePut(symMap, s, x) n.sym = x else: - for i in 0 .. <safeLen(n): freshGenSyms(n.sons[i], owner, symMap) + for i in 0 .. <safeLen(n): freshGenSyms(n.sons[i], owner, orig, symMap) proc addParamOrResult(c: PContext, param: PSym, kind: TSymKind) @@ -96,7 +137,7 @@ proc addProcDecls(c: PContext, fn: PSym) = maybeAddResult(c, fn, fn.ast) -proc instantiateBody(c: PContext, n, params: PNode, result: PSym) = +proc instantiateBody(c: PContext, n, params: PNode, result, orig: PSym) = if n.sons[bodyPos].kind != nkEmpty: inc c.inGenericInst # add it here, so that recursive generic procs are possible: @@ -108,7 +149,7 @@ proc instantiateBody(c: PContext, n, params: PNode, result: PSym) = let param = params[i].sym if sfGenSym in param.flags: idTablePut(symMap, params[i].sym, result.typ.n[param.position+1].sym) - freshGenSyms(b, result, symMap) + freshGenSyms(b, result, orig, symMap) b = semProcBody(c, b) b = hloBody(c, b) n.sons[bodyPos] = transformBody(c.module, b, result) @@ -124,7 +165,7 @@ proc fixupInstantiatedSymbols(c: PContext, s: PSym) = openScope(c) var n = oldPrc.ast n.sons[bodyPos] = copyTree(s.getBody) - instantiateBody(c, n, nil, oldPrc) + instantiateBody(c, n, nil, oldPrc, s) closeScope(c) popInfoContext() @@ -239,14 +280,20 @@ proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, pushInfoContext(info) var entry = TInstantiation.new entry.sym = result - newSeq(entry.concreteTypes, gp.len) + # we need to compare both the generic types and the concrete types: + # generic[void](), generic[int]() + # see ttypeor.nim test. var i = 0 + newSeq(entry.concreteTypes, fn.typ.len+gp.len-1) for s in instantiateGenericParamList(c, gp, pt): addDecl(c, s) entry.concreteTypes[i] = s.typ inc i - pushProcCon(c, result) + rawPushProcCon(c, result) instantiateProcType(c, pt, result, info) + for j in 1 .. result.typ.len-1: + entry.concreteTypes[i] = result.typ.sons[j] + inc i if tfTriggersCompileTime in result.typ.flags: incl(result.flags, sfCompileTime) n.sons[genericParamsPos] = ast.emptyNode @@ -257,6 +304,7 @@ proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, # a ``compiles`` context but this is the lesser evil. See # bug #1055 (tevilcompiles). #if c.compilesContextId == 0: + rawHandleSelf(c, result) entry.compilesId = c.compilesContextId fn.procInstCache.safeAdd(entry) c.generics.add(makeInstPair(fn, entry)) @@ -264,7 +312,7 @@ proc generateInstance(c: PContext, fn: PSym, pt: TIdTable, pragma(c, result, n.sons[pragmasPos], allRoutinePragmas) if isNil(n.sons[bodyPos]): n.sons[bodyPos] = copyTree(fn.getBody) - instantiateBody(c, n, fn.typ.n, result) + instantiateBody(c, n, fn.typ.n, result, fn) sideEffectsCheck(c, result) paramsTypeCheck(c, result.typ) else: diff --git a/compiler/semmagic.nim b/compiler/semmagic.nim index deef38ae3..1a70e4a12 100644 --- a/compiler/semmagic.nim +++ b/compiler/semmagic.nim @@ -178,10 +178,6 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, result.typ = n[1].typ of mDotDot: result = n - # disallow negative indexing for now: - if not c.p.bracketExpr.isNil: - if isNegative(n.sons[1]) or (n.len > 2 and isNegative(n.sons[2])): - localError(n.info, "use '^' instead of '-'; negative indexing is obsolete") of mRoof: let bracketExpr = if n.len == 3: n.sons[2] else: c.p.bracketExpr if bracketExpr.isNil: @@ -207,7 +203,7 @@ proc magicsAfterOverloadResolution(c: PContext, n: PNode, result = n.sons[1] else: result = newNodeIT(nkCall, n.info, getSysType(tyInt)) - result.add newSymNode(createMagic("-", mSubI), n.info) + result.add newSymNode(getSysMagic("-", mSubI), n.info) result.add lenExprB result.add n.sons[1] of mPlugin: diff --git a/compiler/sempass2.nim b/compiler/sempass2.nim index ef014963c..c3a9e01a0 100644 --- a/compiler/sempass2.nim +++ b/compiler/sempass2.nim @@ -504,7 +504,8 @@ proc notNilCheck(tracked: PEffects, n: PNode, paramType: PType) = if n.kind == nkAddr: # addr(x[]) can't be proven, but addr(x) can: if not containsNode(n, {nkDerefExpr, nkHiddenDeref}): return - elif (n.kind == nkSym and n.sym.kind in routineKinds) or n.kind in procDefs: + elif (n.kind == nkSym and n.sym.kind in routineKinds) or + n.kind in procDefs+{nkObjConstr}: # 'p' is not nil obviously: return case impliesNotNil(tracked.guards, n) @@ -699,12 +700,20 @@ proc track(tracked: PEffects, n: PNode) = if notGcSafe(op) and not importedFromC(a): # and it's not a recursive call: if not (a.kind == nkSym and a.sym == tracked.owner): - warnAboutGcUnsafe(n) + if warnGcUnsafe in gNotes: warnAboutGcUnsafe(n) markGcUnsafe(tracked, a) 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: - initVarViaNew(tracked, n.sons[1]) + let arg = n.sons[1] + initVarViaNew(tracked, arg) + if {tfNeedsInit} * arg.typ.lastSon.flags != {}: + if a.sym.magic == mNewSeq and n[2].kind in {nkCharLit..nkUInt64Lit} and + n[2].intVal == 0: + # var s: seq[notnil]; newSeq(s, 0) is a special case! + discard + else: + message(arg.info, warnProveInit, $arg) for i in 0 .. <safeLen(n): track(tracked, n.sons[i]) of nkDotExpr: @@ -875,7 +884,8 @@ proc trackProc*(s: PSym, body: PNode) = var t: TEffects initEffects(effects, s, t) track(t, body) - if not isEmptyType(s.typ.sons[0]) and tfNeedsInit in s.typ.sons[0].flags and + if not isEmptyType(s.typ.sons[0]) and + {tfNeedsInit, tfNotNil} * s.typ.sons[0].flags != {} and s.kind in {skProc, skConverter, skMethod}: var res = s.ast.sons[resultPos].sym # get result symbol if res.id notin t.init: diff --git a/compiler/semstmts.nim b/compiler/semstmts.nim index adb1c81c1..20de8e928 100644 --- a/compiler/semstmts.nim +++ b/compiler/semstmts.nim @@ -84,7 +84,7 @@ proc performProcvarCheck(c: PContext, n: PNode, s: PSym) = proc semProcvarCheck(c: PContext, n: PNode) = let n = n.skipConv if n.kind == nkSym and n.sym.kind in {skProc, skMethod, skConverter, - skIterator, skClosureIterator}: + skIterator}: performProcvarCheck(c, n, n.sym) proc semProc(c: PContext, n: PNode): PNode @@ -326,11 +326,14 @@ proc semIdentDef(c: PContext, n: PNode, kind: TSymKind): PSym = incl(result.flags, sfGlobal) else: result = semIdentWithPragma(c, kind, n, {}) + if result.owner.kind == skModule: + incl(result.flags, sfGlobal) suggestSym(n.info, result) styleCheckDef(result) proc checkNilable(v: PSym) = - if sfGlobal in v.flags and {tfNotNil, tfNeedsInit} * v.typ.flags != {}: + if {sfGlobal, sfImportC} * v.flags == {sfGlobal} and + {tfNotNil, tfNeedsInit} * v.typ.flags != {}: if v.ast.isNil: message(v.info, warnProveInit, v.name.s) elif tfNotNil in v.typ.flags and tfNotNil notin v.ast.typ.flags: @@ -383,6 +386,30 @@ proc isDiscardUnderscore(v: PSym): bool = v.flags.incl(sfGenSym) result = true +proc semUsing(c: PContext; n: PNode): PNode = + result = ast.emptyNode + if not isTopLevel(c): localError(n.info, errXOnlyAtModuleScope, "using") + if not experimentalMode(c): + localError(n.info, "use the {.experimental.} pragma to enable 'using'") + for i in countup(0, sonsLen(n)-1): + var a = n.sons[i] + if gCmd == cmdIdeTools: suggestStmt(c, a) + if a.kind == nkCommentStmt: continue + if a.kind notin {nkIdentDefs, nkVarTuple, nkConstDef}: illFormedAst(a) + checkMinSonsLen(a, 3) + var length = sonsLen(a) + if a.sons[length-2].kind != nkEmpty: + let typ = semTypeNode(c, a.sons[length-2], nil) + for j in countup(0, length-3): + let v = semIdentDef(c, a.sons[j], skParam) + v.typ = typ + strTableIncl(c.signatures, v) + else: + localError(a.info, "'using' section must have a type") + var def: PNode + if a.sons[length-1].kind != nkEmpty: + localError(a.info, "'using' sections cannot contain assignments") + proc semVarOrLet(c: PContext, n: PNode, symkind: TSymKind): PNode = var b: PNode result = copyNode(n) @@ -539,7 +566,7 @@ proc symForVar(c: PContext, n: PNode): PSym = proc semForVars(c: PContext, n: PNode): PNode = result = n var length = sonsLen(n) - let iterBase = n.sons[length-2].typ.skipTypes({tyIter}) + let iterBase = n.sons[length-2].typ var iter = skipTypes(iterBase, {tyGenericInst}) # length == 3 means that there is one for loop variable # and thus no tuple unpacking: @@ -593,12 +620,12 @@ proc semFor(c: PContext, n: PNode): PNode = result.kind = nkParForStmt else: result = semForFields(c, n, call.sons[0].sym.magic) - elif (isCallExpr and call.sons[0].typ.callConv == ccClosure) or - call.typ.kind == tyIter: + elif isCallExpr and call.sons[0].typ.callConv == ccClosure and + tfIterator in call.sons[0].typ.flags: # first class iterator: result = semForVars(c, n) elif not isCallExpr or call.sons[0].kind != nkSym or - call.sons[0].sym.kind notin skIterators: + call.sons[0].sym.kind != skIterator: if length == 3: n.sons[length-2] = implicitIterator(c, "items", n.sons[length-2]) elif length == 4: @@ -638,13 +665,20 @@ proc typeSectionLeftSidePass(c: PContext, n: PNode) = if a.kind == nkCommentStmt: continue if a.kind != nkTypeDef: illFormedAst(a) checkSonsLen(a, 3) - var s = semIdentDef(c, a.sons[0], skType) - s.typ = newTypeS(tyForward, c) - s.typ.sym = s # process pragmas: - if a.sons[0].kind == nkPragmaExpr: - pragma(c, s, a.sons[0].sons[1], typePragmas) - # add it here, so that recursive types are possible: - if sfGenSym notin s.flags: addInterfaceDecl(c, s) + let name = a.sons[0] + var s: PSym + if name.kind == nkDotExpr: + s = qualifiedLookUp(c, name) + if s.kind != skType or s.typ.skipTypes(abstractPtrs).kind != tyObject or tfPartial notin s.typ.skipTypes(abstractPtrs).flags: + localError(name.info, "only .partial objects can be extended") + else: + s = semIdentDef(c, name, skType) + s.typ = newTypeS(tyForward, c) + s.typ.sym = s # process pragmas: + if name.kind == nkPragmaExpr: + pragma(c, s, name.sons[1], typePragmas) + # add it here, so that recursive types are possible: + if sfGenSym notin s.flags: addInterfaceDecl(c, s) a.sons[0] = newSymNode(s) proc typeSectionRightSidePass(c: PContext, n: PNode) = @@ -653,8 +687,9 @@ proc typeSectionRightSidePass(c: PContext, n: PNode) = if a.kind == nkCommentStmt: continue if (a.kind != nkTypeDef): illFormedAst(a) checkSonsLen(a, 3) - if (a.sons[0].kind != nkSym): illFormedAst(a) - var s = a.sons[0].sym + let name = a.sons[0] + if (name.kind != nkSym): illFormedAst(a) + var s = name.sym if s.magic == mNone and a.sons[2].kind == nkEmpty: localError(a.info, errImplOfXexpected, s.name.s) if s.magic != mNone: processMagicType(c, s) @@ -743,11 +778,16 @@ proc typeSectionFinalPass(c: PContext, n: PNode) = var s = a.sons[0].sym # compute the type's size and check for illegal recursions: if a.sons[1].kind == nkEmpty: - if a.sons[2].kind in {nkSym, nkIdent, nkAccQuoted}: + var x = a[2] + while x.kind in {nkStmtList, nkStmtListExpr} and x.len > 0: + x = x.lastSon + if x.kind notin {nkObjectTy, nkDistinctTy, nkEnumTy, nkEmpty} and + s.typ.kind notin {tyObject, tyEnum}: # type aliases are hard: - #MessageOut('for type ' + typeToString(s.typ)); - var t = semTypeNode(c, a.sons[2], nil) - if t.kind in {tyObject, tyEnum}: + var t = semTypeNode(c, x, nil) + assert t != nil + if t.kind in {tyObject, tyEnum, tyDistinct}: + assert s.typ != nil assignType(s.typ, t) s.typ.id = t.id # same id checkConstructedType(s.info, s.typ) @@ -958,15 +998,17 @@ proc semInferredLambda(c: PContext, pt: TIdTable, n: PNode): PNode = var n = n let original = n.sons[namePos].sym - let s = copySym(original, false) - incl(s.flags, sfFromGeneric) + let s = original #copySym(original, false) + #incl(s.flags, sfFromGeneric) + #s.owner = original n = replaceTypesInBody(c, pt, n, original) result = n s.ast = result n.sons[namePos].sym = s n.sons[genericParamsPos] = emptyNode - let params = n.typ.n + # for LL we need to avoid wrong aliasing + let params = copyTree n.typ.n n.sons[paramsPos] = params s.typ = n.typ for i in 1..<params.len: @@ -974,6 +1016,7 @@ proc semInferredLambda(c: PContext, pt: TIdTable, n: PNode): PNode = tyFromExpr, tyFieldAccessor}+tyTypeClasses: localError(params[i].info, "cannot infer type of parameter: " & params[i].sym.name.s) + #params[i].sym.owner = s openScope(c) pushOwner(s) addParams(c, params, skProc) @@ -1006,7 +1049,8 @@ proc activate(c: PContext, n: PNode) = discard proc maybeAddResult(c: PContext, s: PSym, n: PNode) = - if s.typ.sons[0] != nil and s.kind != skIterator: + if s.typ.sons[0] != nil and not + (s.kind == skIterator and s.typ.callConv != ccClosure): addResult(c, s.typ.sons[0], n.info, s.kind) addResultNode(c, n) @@ -1095,6 +1139,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, if n[namePos].kind == nkEmpty: s = newSym(kind, idAnon, getCurrOwner(), n.info) + incl(s.flags, sfUsed) isAnon = true else: s = semIdentDef(c, n.sons[0], kind) @@ -1143,13 +1188,16 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, if tfTriggersCompileTime in s.typ.flags: incl(s.flags, sfCompileTime) if n.sons[patternPos].kind != nkEmpty: n.sons[patternPos] = semPattern(c, n.sons[patternPos]) - if s.kind in skIterators: + if s.kind == skIterator: s.typ.flags.incl(tfIterator) var proto = searchForProc(c, oldScope, s) - if proto == nil: - if s.kind == skClosureIterator: s.typ.callConv = ccClosure - else: s.typ.callConv = lastOptionEntry(c).defaultCC + if proto == nil or isAnon: + if s.kind == skIterator: + if s.typ.callConv != ccClosure: + s.typ.callConv = if isAnon: ccClosure else: ccInline + else: + s.typ.callConv = lastOptionEntry(c).defaultCC # add it here, so that recursive procs are possible: if sfGenSym in s.flags: discard elif kind in OverloadableSyms: @@ -1196,20 +1244,20 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, # Macros and Templates can have generic parameters, but they are # only used for overload resolution (there is no instantiation of # the symbol, so we must process the body now) + pushProcCon(c, s) if n.sons[genericParamsPos].kind == nkEmpty or usePseudoGenerics: if not usePseudoGenerics: paramsTypeCheck(c, s.typ) - pushProcCon(c, s) + c.p.wasForwarded = proto != nil maybeAddResult(c, s, n) - if sfImportc notin s.flags: + if lfDynamicLib notin s.loc.flags: # no semantic checking for importc: let semBody = hloBody(c, semProcBody(c, n.sons[bodyPos])) # unfortunately we cannot skip this step when in 'system.compiles' # context as it may even be evaluated in 'system.compiles': n.sons[bodyPos] = transformBody(c.module, semBody, s) - popProcCon(c) else: - if s.typ.sons[0] != nil and kind notin skIterators: + if s.typ.sons[0] != nil and kind != skIterator: addDecl(c, newSym(skUnknown, getIdent"result", nil, n.info)) openScope(c) n.sons[bodyPos] = semGenericStmt(c, n.sons[bodyPos]) @@ -1218,6 +1266,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, if sfImportc in s.flags: # so we just ignore the body after semantic checking for importc: n.sons[bodyPos] = ast.emptyNode + popProcCon(c) else: if proto != nil: localError(n.info, errImplOfXexpected, proto.name.s) if {sfImportc, sfBorrow} * s.flags == {} and s.magic == mNone: @@ -1230,9 +1279,9 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, if n.sons[patternPos].kind != nkEmpty: c.patterns.add(s) if isAnon: result.typ = s.typ - if isTopLevel(c) and s.kind != skClosureIterator and + if isTopLevel(c) and s.kind != skIterator and s.typ.callConv == ccClosure: - message(s.info, warnDeprecated, "top level '.closure' calling convention") + localError(s.info, "'.closure' calling convention for top level routines is invalid") proc determineType(c: PContext, s: PSym) = if s.typ != nil: return @@ -1240,15 +1289,12 @@ proc determineType(c: PContext, s: PSym) = discard semProcAux(c, s.ast, s.kind, {}, stepDetermineType) proc semIterator(c: PContext, n: PNode): PNode = - let kind = if hasPragma(n[pragmasPos], wClosure) or - n[namePos].kind == nkEmpty: skClosureIterator - else: skIterator # gensym'ed iterator? if n[namePos].kind == nkSym: # gensym'ed iterators might need to become closure iterators: n[namePos].sym.owner = getCurrOwner() - n[namePos].sym.kind = kind - result = semProcAux(c, n, kind, iteratorPragmas) + n[namePos].sym.kind = skIterator + result = semProcAux(c, n, skIterator, iteratorPragmas) var s = result.sons[namePos].sym var t = s.typ if t.sons[0] == nil and s.typ.callConv != ccClosure: diff --git a/compiler/semtempl.nim b/compiler/semtempl.nim index 2dda8276d..a4498a3ae 100644 --- a/compiler/semtempl.nim +++ b/compiler/semtempl.nim @@ -228,10 +228,7 @@ proc semTemplSymbol(c: PContext, n: PNode, s: PSym): PNode = of skParam: result = n of skType: - if (s.typ != nil) and (s.typ.kind != tyGenericParam): - result = newSymNodeTypeDesc(s, n.info) - else: - result = n + result = newSymNodeTypeDesc(s, n.info) else: result = newSymNode(s, n.info) @@ -456,9 +453,7 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = of nkMethodDef: result = semRoutineInTemplBody(c, n, skMethod) of nkIteratorDef: - let kind = if hasPragma(n[pragmasPos], wClosure): skClosureIterator - else: skIterator - result = semRoutineInTemplBody(c, n, kind) + result = semRoutineInTemplBody(c, n, skIterator) of nkTemplateDef: result = semRoutineInTemplBody(c, n, skTemplate) of nkMacroDef: diff --git a/compiler/semtypes.nim b/compiler/semtypes.nim index 65cb9421b..9d0afd8b1 100644 --- a/compiler/semtypes.nim +++ b/compiler/semtypes.nim @@ -135,13 +135,19 @@ proc semAnyRef(c: PContext; n: PNode; kind: TTypeKind; prev: PType): PType = checkMinSonsLen(n, 1) var base = semTypeNode(c, n.lastSon, nil) result = newOrPrevType(kind, prev, c) + var isNilable = false # check every except the last is an object: for i in isCall .. n.len-2: - let region = semTypeNode(c, n[i], nil) - if region.skipTypes({tyGenericInst}).kind notin {tyError, tyObject}: - message n[i].info, errGenerated, "region needs to be an object type" - addSonSkipIntLit(result, region) + let ni = n[i] + if ni.kind == nkNilLit: + isNilable = true + else: + let region = semTypeNode(c, ni, nil) + if region.skipTypes({tyGenericInst}).kind notin {tyError, tyObject}: + message n[i].info, errGenerated, "region needs to be an object type" + addSonSkipIntLit(result, region) addSonSkipIntLit(result, base) + #if not isNilable: result.flags.incl tfNotNil proc semVarType(c: PContext, n: PNode, prev: PType): PType = if sonsLen(n) == 1: @@ -667,7 +673,11 @@ proc semObjectNode(c: PContext, n: PNode, prev: PType): PType = if n.kind != nkObjectTy: internalError(n.info, "semObjectNode") result = newOrPrevType(tyObject, prev, c) rawAddSon(result, base) - result.n = newNodeI(nkRecList, n.info) + if result.n.isNil: + result.n = newNodeI(nkRecList, n.info) + else: + # partial object so add things to the check + addInheritedFields(c, check, pos, result) semRecordNodeAux(c, n.sons[2], check, pos, result.n, result) if n.sons[0].kind != nkEmpty: # dummy symbol for `pragma`: @@ -821,20 +831,13 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, result.rawAddSon paramType.lastSon return addImplicitGeneric(result) - result = instGenericContainer(c, paramType.sym.info, result, + let x = instGenericContainer(c, paramType.sym.info, result, allowMetaTypes = true) - result = newTypeWithSons(c, tyCompositeTypeClass, @[paramType, result]) + result = newTypeWithSons(c, tyCompositeTypeClass, @[paramType, x]) + #result = newTypeS(tyCompositeTypeClass, c) + #for i in 0..<x.len: result.rawAddSon(x.sons[i]) result = addImplicitGeneric(result) - of tyIter: - if paramType.callConv == ccInline: - if procKind notin {skTemplate, skMacro, skIterator}: - localError(info, errInlineIteratorsAsProcParams) - if paramType.len == 1: - let lifted = liftingWalk(paramType.base) - if lifted != nil: paramType.sons[0] = lifted - result = addImplicitGeneric(paramType) - of tyGenericInst: if paramType.lastSon.kind == tyUserTypeClass: var cp = copyType(paramType, getCurrOwner(), false) @@ -865,11 +868,6 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, of tyUserTypeClass, tyBuiltInTypeClass, tyAnd, tyOr, tyNot: result = addImplicitGeneric(copyType(paramType, getCurrOwner(), true)) - of tyExpr: - if procKind notin {skMacro, skTemplate}: - result = addImplicitGeneric(newTypeS(tyAnything, c)) - #result = addImplicitGenericImpl(newTypeS(tyGenericParam, c), nil) - of tyGenericParam: markUsed(info, paramType.sym) styleCheckUse(info, paramType.sym) @@ -942,14 +940,18 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, def = fitNode(c, typ, def) if not hasType and not hasDefault: if isType: localError(a.info, "':' expected") - let tdef = if kind in {skTemplate, skMacro}: tyExpr else: tyAnything - if tdef == tyAnything: - message(a.info, warnTypelessParam, renderTree(n)) - typ = newTypeS(tdef, c) - - if skipTypes(typ, {tyGenericInst}).kind == tyEmpty: continue + if kind in {skTemplate, skMacro}: + typ = newTypeS(tyExpr, c) + elif skipTypes(typ, {tyGenericInst}).kind == tyEmpty: + continue for j in countup(0, length-3): var arg = newSymG(skParam, a.sons[j], c) + if not hasType and not hasDefault and kind notin {skTemplate, skMacro}: + let param = strTableGet(c.signatures, arg.name) + if param != nil: typ = param.typ + else: + localError(a.info, "typeless parameters are obsolete") + typ = errorType(c) let lifted = liftParamType(c, kind, genericParams, typ, arg.name.s, arg.info) let finalType = if lifted != nil: lifted else: typ.skipIntLit @@ -968,10 +970,6 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, var r: PType if n.sons[0].kind != nkEmpty: r = semTypeNode(c, n.sons[0], nil) - elif kind == skIterator: - # XXX This is special magic we should likely get rid of - r = newTypeS(tyExpr, c) - message(n.info, warnDeprecated, "implicit return type for 'iterator'") if r != nil: # turn explicit 'void' return type into 'nil' because the rest of the @@ -996,7 +994,8 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, # see tchainediterators # in cases like iterator foo(it: iterator): type(it) # we don't need to change the return type to iter[T] - if not r.isInlineIterator: r = newTypeWithSons(c, tyIter, @[r]) + result.flags.incl tfIterator + # XXX Would be nice if we could get rid of this result.sons[0] = r result.n.typ = r @@ -1095,10 +1094,14 @@ proc semGeneric(c: PContext, n: PNode, s: PSym, prev: PType): PType = result = instGenericContainer(c, n.info, result, allowMetaTypes = false) -proc semTypeExpr(c: PContext, n: PNode): PType = +proc semTypeExpr(c: PContext, n: PNode; prev: PType): PType = var n = semExprWithType(c, n, {efDetermineType}) if n.typ.kind == tyTypeDesc: result = n.typ.base + # fix types constructed by macros: + if prev != nil and prev.sym != nil and result.sym.isNil: + result.sym = prev.sym + result.sym.typ = result else: localError(n.info, errTypeExpected, n.renderTree) result = errorType(c) @@ -1151,7 +1154,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = # for ``type(countup(1,3))``, see ``tests/ttoseq``. checkSonsLen(n, 1) let typExpr = semExprWithType(c, n.sons[0], {efInTypeof}) - result = typExpr.typ.skipTypes({tyIter}) + result = typExpr.typ of nkPar: if sonsLen(n) == 1: result = semTypeNode(c, n.sons[0], prev) else: @@ -1169,8 +1172,16 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = result = semTypeNode(c, b, prev) elif ident != nil and ident.id == ord(wDotDot): result = semRangeAux(c, n, prev) + elif n[0].kind == nkNilLit and n.len == 2: + result = semTypeNode(c, n.sons[1], prev) + if result.skipTypes({tyGenericInst}).kind in NilableTypes+GenericTypes: + if tfNotNil in result.flags: + result = freshType(result, prev) + result.flags.excl(tfNotNil) + else: + localError(n.info, errGenerated, "invalid type") elif n[0].kind notin nkIdentKinds: - result = semTypeExpr(c, n) + result = semTypeExpr(c, n, prev) else: let op = considerQuotedIdent(n.sons[0]) if op.id in {ord(wAnd), ord(wOr)} or op.s == "|": @@ -1209,9 +1220,9 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = elif op.id == ord(wType): checkSonsLen(n, 2) let typExpr = semExprWithType(c, n.sons[1], {efInTypeof}) - result = typExpr.typ.skipTypes({tyIter}) + result = typExpr.typ else: - result = semTypeExpr(c, n) + result = semTypeExpr(c, n, prev) of nkWhenStmt: var whenResult = semWhen(c, n, false) if whenResult.kind == nkStmtList: whenResult.kind = nkStmtListType @@ -1290,14 +1301,16 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = result.flags.incl tfHasStatic of nkIteratorTy: if n.sonsLen == 0: - result = newConstraint(c, tyIter) + result = newTypeS(tyBuiltInTypeClass, c) + let child = newTypeS(tyProc, c) + child.flags.incl tfIterator + result.addSonSkipIntLit(child) else: - result = semProcTypeWithScope(c, n, prev, skClosureIterator) + result = semProcTypeWithScope(c, n, prev, skIterator) + result.flags.incl(tfIterator) if n.lastSon.kind == nkPragma and hasPragma(n.lastSon, wInline): - result.kind = tyIter result.callConv = ccInline else: - result.flags.incl(tfIterator) result.callConv = ccClosure of nkProcTy: if n.sonsLen == 0: @@ -1308,11 +1321,6 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = of nkType: result = n.typ of nkStmtListType: result = semStmtListType(c, n, prev) of nkBlockType: result = semBlockType(c, n, prev) - of nkSharedTy: - checkSonsLen(n, 1) - result = semTypeNode(c, n.sons[0], prev) - result = freshType(result, prev) - result.flags.incl(tfShared) else: localError(n.info, errTypeExpected) result = newOrPrevType(tyError, prev, c) @@ -1388,15 +1396,6 @@ proc processMagicType(c: PContext, m: PSym) = rawAddSon(m.typ, newTypeS(tyNone, c)) of mPNimrodNode: incl m.typ.flags, tfTriggersCompileTime - of mShared: - setMagicType(m, tyObject, 0) - m.typ.n = newNodeI(nkRecList, m.info) - incl m.typ.flags, tfShared - of mGuarded: - setMagicType(m, tyObject, 0) - m.typ.n = newNodeI(nkRecList, m.info) - incl m.typ.flags, tfShared - rawAddSon(m.typ, sysTypeFromName"shared") else: localError(m.info, errTypeExpected) proc semGenericConstraints(c: PContext, x: PType): PType = diff --git a/compiler/semtypinst.nim b/compiler/semtypinst.nim index f643fb903..7ff33f918 100644 --- a/compiler/semtypinst.nim +++ b/compiler/semtypinst.nim @@ -14,22 +14,11 @@ import ast, astalgo, msgs, types, magicsys, semdata, renderer const tfInstClearedFlags = {tfHasMeta} -proc sharedPtrCheck(info: TLineInfo, t: PType) = - if t.kind == tyPtr and t.len > 1: - if t.sons[0].sym.magic == mShared: - incl(t.flags, tfShared) - #if t.sons[0].sym.magic == mGuarded: incl(t.flags, tfGuarded) - if tfHasGCedMem in t.flags or t.isGCedMem: - localError(info, errGenerated, - "shared memory may not refer to GC'ed thread local memory") - proc checkPartialConstructedType(info: TLineInfo, t: PType) = if tfAcyclic in t.flags and skipTypes(t, abstractInst).kind != tyObject: localError(info, errInvalidPragmaX, "acyclic") elif t.kind == tyVar and t.sons[0].kind == tyVar: localError(info, errVarVarTypeNotAllowed) - else: - sharedPtrCheck(info, t) proc checkConstructedType*(info: TLineInfo, typ: PType) = var t = typ.skipTypes({tyDistinct}) @@ -40,8 +29,6 @@ proc checkConstructedType*(info: TLineInfo, typ: PType) = localError(info, errVarVarTypeNotAllowed) elif computeSize(t) == szIllegalRecursion: localError(info, errIllegalRecursionInTypeX, typeToString(t)) - else: - sharedPtrCheck(info, t) when false: if t.kind == tyObject and t.sons[0] != nil: if t.sons[0].kind != tyObject or tfFinal in t.sons[0].flags: @@ -60,7 +47,7 @@ proc searchInstTypes*(key: PType): PType = if inst.id == key.id: return inst if inst.sons.len < key.sons.len: # XXX: This happens for prematurely cached - # types such as TChannel[empty]. Why? + # types such as Channel[empty]. Why? # See the notes for PActor in handleGenericInvocation return block matchType: @@ -75,8 +62,12 @@ proc searchInstTypes*(key: PType): PType = proc cacheTypeInst*(inst: PType) = # XXX: add to module's generics # update the refcount - let genericTyp = inst.sons[0] - genericTyp.sym.typeInstCache.safeAdd(inst) + let gt = inst.sons[0] + let t = if gt.kind == tyGenericBody: gt.lastSon else: gt + if t.kind in {tyStatic, tyGenericParam} + tyTypeClasses: + return + gt.sym.typeInstCache.safeAdd(inst) + type TReplTypeVars* {.final.} = object @@ -212,14 +203,14 @@ proc replaceTypeVarsS(cl: var TReplTypeVars, s: PSym): PSym = # symbol is not our business: if cl.owner != nil and s.owner != cl.owner: return s - result = PSym(idTableGet(cl.symMap, s)) - if result == nil: - result = copySym(s, false) - incl(result.flags, sfFromGeneric) - idTablePut(cl.symMap, s, result) - result.owner = s.owner - result.typ = replaceTypeVarsT(cl, s.typ) - result.ast = replaceTypeVarsN(cl, s.ast) + #result = PSym(idTableGet(cl.symMap, s)) + #if result == nil: + result = copySym(s, false) + incl(result.flags, sfFromGeneric) + #idTablePut(cl.symMap, s, result) + result.owner = s.owner + result.typ = replaceTypeVarsT(cl, s.typ) + result.ast = replaceTypeVarsN(cl, s.ast) proc lookupTypeVar(cl: var TReplTypeVars, t: PType): PType = result = PType(idTableGet(cl.typeMap, t)) @@ -386,7 +377,7 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = result = t if t == nil: return - if t.kind in {tyStatic, tyGenericParam, tyIter} + tyTypeClasses: + if t.kind in {tyStatic, tyGenericParam} + tyTypeClasses: let lookup = PType(idTableGet(cl.typeMap, t)) if lookup != nil: return lookup diff --git a/compiler/sigmatch.nim b/compiler/sigmatch.nim index 642f50330..e72db45e7 100644 --- a/compiler/sigmatch.nim +++ b/compiler/sigmatch.nim @@ -37,6 +37,7 @@ type # is this a top-level symbol or a nested proc? call*: PNode # modified call bindings*: TIdTable # maps types to types + magic*: TMagic # magic of operation baseTypeMatch: bool # needed for conversions from T to openarray[T] # for example fauxMatch*: TTypeKind # the match was successful only due to the use @@ -114,6 +115,7 @@ proc initCandidate*(ctx: PContext, c: var TCandidate, callee: PSym, c.calleeScope = 1 else: c.calleeScope = calleeScope + c.magic = c.calleeSym.magic initIdTable(c.bindings) c.errors = nil if binding != nil and callee.kind in routineKinds: @@ -167,12 +169,12 @@ proc sumGeneric(t: PType): int = t = t.lastSon if t.kind == tyEmpty: break inc result - of tyGenericInvocation, tyTuple: + of tyGenericInvocation, tyTuple, tyProc: result += ord(t.kind == tyGenericInvocation) for i in 0 .. <t.len: result += t.sons[i].sumGeneric break of tyGenericParam, tyExpr, tyStatic, tyStmt: break - of tyBool, tyChar, tyEnum, tyObject, tyProc, tyPointer, + of tyBool, tyChar, tyEnum, tyObject, tyPointer, tyString, tyCString, tyInt..tyInt64, tyFloat..tyFloat128, tyUInt..tyUInt64: return isvar @@ -240,6 +242,8 @@ proc argTypeToString(arg: PNode; prefer: TPreferedDesc): string = for i in 1 .. <arg.len: result.add(" | ") result.add typeToString(arg[i].typ, prefer) + elif arg.typ == nil: + result = "void" else: result = arg.typ.typeToString(prefer) @@ -251,15 +255,15 @@ proc describeArgs*(c: PContext, n: PNode, startIdx = 1; if n.sons[i].kind == nkExprEqExpr: add(result, renderTree(n.sons[i].sons[0])) add(result, ": ") - if arg.typ.isNil: + if arg.typ.isNil and arg.kind notin {nkStmtList, nkDo}: arg = c.semOperand(c, n.sons[i].sons[1]) n.sons[i].typ = arg.typ n.sons[i].sons[1] = arg else: - if arg.typ.isNil: + if arg.typ.isNil and arg.kind notin {nkStmtList, nkDo}: arg = c.semOperand(c, n.sons[i]) n.sons[i] = arg - if arg.typ.kind == tyError: return + if arg.typ != nil and arg.typ.kind == tyError: return add(result, argTypeToString(arg, prefer)) if i != sonsLen(n) - 1: add(result, ", ") @@ -511,7 +515,7 @@ proc typeRangeRel(f, a: PType): TTypeRelation {.noinline.} = proc matchUserTypeClass*(c: PContext, m: var TCandidate, ff, a: PType): TTypeRelation = var body = ff.skipTypes({tyUserTypeClassInst}) - if c.inTypeClass > 20: + if c.inTypeClass > 4: localError(body.n[3].info, $body.n[3] & " too nested for type matching") return isNone @@ -596,6 +600,10 @@ proc tryResolvingStaticExpr(c: var TCandidate, n: PNode): PNode = let instantiated = replaceTypesInBody(c.c, c.bindings, n, nil) result = c.c.semExpr(c.c, instantiated) +template subtypeCheck() = + if result <= isSubrange and f.lastSon.skipTypes(abstractInst).kind in {tyRef, tyPtr, tyVar}: + result = isNone + proc typeRel(c: var TCandidate, f, aOrig: PType, doBind = true): TTypeRelation = # typeRel can be used to establish various relationships between types: # @@ -684,6 +692,13 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, doBind = true): TTypeRelation = of tyAnything: return if f.kind == tyAnything: isGeneric else: isNone + + of tyUserTypeClass, tyUserTypeClassInst: + # consider this: 'var g: Node' *within* a concept where 'Node' + # is a concept too (tgraph) + let x = typeRel(c, a, f, false) + if x >= isGeneric: + return isGeneric else: discard case f.kind @@ -728,6 +743,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, doBind = true): TTypeRelation = of tyVar: if aOrig.kind == tyVar: result = typeRel(c, f.base, aOrig.base) else: result = typeRel(c, f.base, aOrig) + subtypeCheck() of tyArray, tyArrayConstr: # tyArrayConstr cannot happen really, but # we wanna be safe here @@ -838,7 +854,10 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, doBind = true): TTypeRelation = inc(c.inheritancePenalty, depth) result = isSubtype of tyDistinct: - if a.kind == tyDistinct and sameDistinctTypes(f, a): result = isEqual + if a.kind == tyDistinct: + if sameDistinctTypes(f, a): result = isEqual + elif f.base.kind == tyAnything: result = isGeneric + elif c.coerceDistincts: result = typeRel(c, f.base, a) elif c.coerceDistincts: result = typeRel(c, f.base, a) of tySet: if a.kind == tySet: @@ -855,6 +874,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, doBind = true): TTypeRelation = for i in 0..f.len-2: if typeRel(c, f.sons[i], a.sons[i]) == isNone: return isNone result = typeRel(c, f.lastSon, a.lastSon) + subtypeCheck() if result <= isConvertible: result = isNone elif tfNotNil in f.flags and tfNotNil notin a.flags: result = isNilConversion @@ -913,19 +933,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, doBind = true): TTypeRelation = if a.kind == tyEmpty: result = isEqual of tyGenericInst: - let roota = a.skipGenericAlias - let rootf = f.skipGenericAlias - if a.kind == tyGenericInst and roota.base == rootf.base: - for i in 1 .. rootf.sonsLen-2: - let ff = rootf.sons[i] - let aa = roota.sons[i] - result = typeRel(c, ff, aa) - if result == isNone: return - if ff.kind == tyRange and result != isEqual: return isNone - #result = isGeneric - # XXX See bug #2220. A[int] should match A[int] better than some generic X - else: - result = typeRel(c, lastSon(f), a) + result = typeRel(c, lastSon(f), a) of tyGenericBody: considerPreviousT: @@ -1026,12 +1034,20 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, doBind = true): TTypeRelation = of tyCompositeTypeClass: considerPreviousT: - if typeRel(c, f.sons[1], a) != isNone: - put(c.bindings, f, a) - return isGeneric + let roota = a.skipGenericAlias + let rootf = f.lastSon.skipGenericAlias + if a.kind == tyGenericInst and roota.base == rootf.base: + for i in 1 .. rootf.sonsLen-2: + let ff = rootf.sons[i] + let aa = roota.sons[i] + result = typeRel(c, ff, aa) + if result == isNone: return + if ff.kind == tyRange and result != isEqual: return isNone else: - return isNone - + result = typeRel(c, rootf.lastSon, a) + if result != isNone: + put(c.bindings, f, a) + result = isGeneric of tyGenericParam: var x = PType(idTableGet(c.bindings, f)) if x == nil: @@ -1249,10 +1265,6 @@ proc localConvMatch(c: PContext, m: var TCandidate, f, a: PType, result.typ = getInstantiatedType(c, arg, m, base(f)) m.baseTypeMatch = true -proc isInlineIterator*(t: PType): bool = - result = t.kind == tyIter or - (t.kind == tyBuiltInTypeClass and t.base.kind == tyIter) - proc incMatches(m: var TCandidate; r: TTypeRelation; convMatch = 1) = case r of isConvertible, isIntConv: inc(m.convMatches, convMatch) @@ -1296,11 +1308,8 @@ proc paramTypesMatchAux(m: var TCandidate, f, argType: PType, arg.typ.n = evaluated argType = arg.typ - var - a = if c.inTypeClass > 0: argType.skipTypes({tyTypeDesc, tyFieldAccessor}) - else: argType - - r = typeRel(m, f, a) + var a = argType + var r = typeRel(m, f, a) if r != isNone and m.calleeSym != nil and m.calleeSym.kind in {skMacro, skTemplate}: @@ -1316,13 +1325,6 @@ proc paramTypesMatchAux(m: var TCandidate, f, argType: PType, else: return argSemantized # argOrig - if r != isNone and f.isInlineIterator: - var inlined = newTypeS(tyStatic, c) - inlined.sons = @[argType] - inlined.n = argSemantized - put(m.bindings, f, inlined) - return argSemantized - # If r == isBothMetaConvertible then we rerun typeRel. # bothMetaCounter is for safety to avoid any infinite loop, # I don't have any example when it is needed. @@ -1446,7 +1448,7 @@ proc paramTypesMatch*(m: var TCandidate, f, a: PType, z.calleeSym = m.calleeSym var best = -1 for i in countup(0, sonsLen(arg) - 1): - if arg.sons[i].sym.kind in {skProc, skMethod, skConverter}+skIterators: + if arg.sons[i].sym.kind in {skProc, skMethod, skConverter, skIterator}: copyCandidate(z, m) z.callee = arg.sons[i].typ z.calleeSym = arg.sons[i].sym @@ -1594,8 +1596,11 @@ proc matchesAux(c: PContext, n, nOrig: PNode, m.state = csNoMatch return if containsOrIncl(marker, formal.position): - # already in namedParams: - localError(n.sons[a].info, errCannotBindXTwice, formal.name.s) + # already in namedParams, so no match + # we used to produce 'errCannotBindXTwice' here but see + # bug #3836 of why that is not sound (other overload with + # different parameter names could match later on): + when false: localError(n.sons[a].info, errCannotBindXTwice, formal.name.s) m.state = csNoMatch return m.baseTypeMatch = false @@ -1639,6 +1644,7 @@ proc matchesAux(c: PContext, n, nOrig: PNode, if arg != nil and m.baseTypeMatch and container != nil: addSon(container, arg) incrIndexType(container.typ) + checkConstraint(n.sons[a]) else: m.state = csNoMatch return @@ -1651,35 +1657,44 @@ proc matchesAux(c: PContext, n, nOrig: PNode, return formal = m.callee.n.sons[f].sym if containsOrIncl(marker, formal.position) and container.isNil: - # already in namedParams: - localError(n.sons[a].info, errCannotBindXTwice, formal.name.s) - m.state = csNoMatch - return - m.baseTypeMatch = false - n.sons[a] = prepareOperand(c, formal.typ, n.sons[a]) - var arg = paramTypesMatch(m, formal.typ, n.sons[a].typ, - n.sons[a], nOrig.sons[a]) - if arg == nil: + # already in namedParams: (see above remark) + when false: localError(n.sons[a].info, errCannotBindXTwice, formal.name.s) m.state = csNoMatch return - if m.baseTypeMatch: - #assert(container == nil) + + if formal.typ.isVarargsUntyped: if container.isNil: - container = newNodeIT(nkBracket, n.sons[a].info, arrayConstr(c, arg)) + container = newNodeIT(nkBracket, n.sons[a].info, arrayConstr(c, n.info)) + setSon(m.call, formal.position + 1, container) else: incrIndexType(container.typ) - addSon(container, arg) - setSon(m.call, formal.position + 1, - implicitConv(nkHiddenStdConv, formal.typ, container, m, c)) - #if f != formalLen - 1: container = nil - - # pick the formal from the end, so that 'x, y, varargs, z' works: - f = max(f, formalLen - n.len + a + 1) + addSon(container, n.sons[a]) else: - setSon(m.call, formal.position + 1, arg) - inc(f) - container = nil - checkConstraint(n.sons[a]) + m.baseTypeMatch = false + n.sons[a] = prepareOperand(c, formal.typ, n.sons[a]) + var arg = paramTypesMatch(m, formal.typ, n.sons[a].typ, + n.sons[a], nOrig.sons[a]) + if arg == nil: + m.state = csNoMatch + return + if m.baseTypeMatch: + #assert(container == nil) + if container.isNil: + container = newNodeIT(nkBracket, n.sons[a].info, arrayConstr(c, arg)) + else: + incrIndexType(container.typ) + addSon(container, arg) + setSon(m.call, formal.position + 1, + implicitConv(nkHiddenStdConv, formal.typ, container, m, c)) + #if f != formalLen - 1: container = nil + + # pick the formal from the end, so that 'x, y, varargs, z' works: + f = max(f, formalLen - n.len + a + 1) + else: + setSon(m.call, formal.position + 1, arg) + inc(f) + container = nil + checkConstraint(n.sons[a]) inc(a) proc semFinishOperands*(c: PContext, n: PNode) = @@ -1694,7 +1709,7 @@ proc partialMatch*(c: PContext, n, nOrig: PNode, m: var TCandidate) = matchesAux(c, n, nOrig, m, marker) proc matches*(c: PContext, n, nOrig: PNode, m: var TCandidate) = - if m.calleeSym != nil and m.calleeSym.magic in {mArrGet, mArrPut}: + if m.magic in {mArrGet, mArrPut}: m.state = csMatch m.call = n return diff --git a/compiler/suggest.nim b/compiler/suggest.nim index 18d723315..bcab6b04a 100644 --- a/compiler/suggest.nim +++ b/compiler/suggest.nim @@ -13,6 +13,9 @@ import algorithm, sequtils +when defined(nimsuggest): + import passes, tables # importer + const sep = '\t' @@ -26,16 +29,24 @@ type doc*: string # Not escaped (yet) symkind*: TSymKind forth*: string # XXX TODO object on symkind + quality*: range[0..100] # matching quality + isGlobal*: bool # is a global variable + tokenLen*: int var suggestionResultHook*: proc (result: Suggest) {.closure.} + suggestVersion*: int #template sectionSuggest(): expr = "##begin\n" & getStackTrace() & "##end\n" template origModuleName(m: PSym): string = m.name.s -proc symToSuggest(s: PSym, isLocal: bool, section: string, li: TLineInfo): Suggest = +proc symToSuggest(s: PSym, isLocal: bool, section: string, li: TLineInfo; + quality: range[0..100]): Suggest = result.section = parseIdeCmd(section) + result.quality = quality + result.isGlobal = sfGlobal in s.flags + result.tokenLen = s.name.s.len if optIdeTerse in gGlobalOptions: result.symkind = s.kind result.filePath = toFullPath(li) @@ -65,23 +76,41 @@ proc symToSuggest(s: PSym, isLocal: bool, section: string, li: TLineInfo): Sugge proc `$`(suggest: Suggest): string = result = $suggest.section result.add(sep) - result.add($suggest.symkind) - result.add(sep) - result.add(suggest.qualifiedPath.join(".")) - result.add(sep) - result.add(suggest.forth) - result.add(sep) - result.add(suggest.filePath) - result.add(sep) - result.add($suggest.line) - result.add(sep) - result.add($suggest.column) - result.add(sep) - when not defined(noDocgen): - result.add(suggest.doc.escape) + if suggest.section == ideHighlight: + if suggest.symkind == skVar and suggest.isGlobal: + result.add("skGlobalVar") + elif suggest.symkind == skLet and suggest.isGlobal: + result.add("skGlobalLet") + else: + result.add($suggest.symkind) + result.add(sep) + result.add($suggest.line) + result.add(sep) + result.add($suggest.column) + result.add(sep) + result.add($suggest.tokenLen) + else: + result.add($suggest.symkind) + result.add(sep) + result.add(suggest.qualifiedPath.join(".")) + result.add(sep) + result.add(suggest.forth) + result.add(sep) + result.add(suggest.filePath) + result.add(sep) + result.add($suggest.line) + result.add(sep) + result.add($suggest.column) + result.add(sep) + when not defined(noDocgen): + result.add(suggest.doc.escape) + if suggestVersion == 2: + result.add(sep) + result.add($suggest.quality) -proc symToSuggest(s: PSym, isLocal: bool, section: string): Suggest = - result = symToSuggest(s, isLocal, section, s.info) +proc symToSuggest(s: PSym, isLocal: bool, section: string; + quality: range[0..100]): Suggest = + result = symToSuggest(s, isLocal, section, s.info, quality) proc suggestResult(s: Suggest) = if not isNil(suggestionResultHook): @@ -106,7 +135,7 @@ proc fieldVisible*(c: PContext, f: PSym): bool {.inline.} = proc suggestField(c: PContext, s: PSym, outputs: var int) = if filterSym(s) and fieldVisible(c, s): - suggestResult(symToSuggest(s, isLocal=true, $ideSug)) + suggestResult(symToSuggest(s, isLocal=true, $ideSug, 100)) inc outputs template wholeSymTab(cond, section: expr) {.immediate.} = @@ -119,7 +148,7 @@ template wholeSymTab(cond, section: expr) {.immediate.} = for item in entries: let it {.inject.} = item if cond: - suggestResult(symToSuggest(it, isLocal = isLocal, section)) + suggestResult(symToSuggest(it, isLocal = isLocal, section, 100)) inc outputs proc suggestSymList(c: PContext, list: PNode, outputs: var int) = @@ -188,7 +217,7 @@ proc suggestEverything(c: PContext, n: PNode, outputs: var int) = if scope == c.topLevelScope: isLocal = false for it in items(scope.symbols): if filterSym(it): - suggestResult(symToSuggest(it, isLocal = isLocal, $ideSug)) + suggestResult(symToSuggest(it, isLocal = isLocal, $ideSug, 0)) inc outputs if scope == c.topLevelScope: break @@ -196,6 +225,23 @@ proc suggestFieldAccess(c: PContext, n: PNode, outputs: var int) = # special code that deals with ``myObj.``. `n` is NOT the nkDotExpr-node, but # ``myObj``. var typ = n.typ + when defined(nimsuggest): + if n.kind == nkSym and n.sym.kind == skError and suggestVersion == 2: + # consider 'foo.|' where 'foo' is some not imported module. + let fullPath = findModule(n.sym.name.s, n.info.toFullPath) + if fullPath.len == 0: + # error: no known module name: + typ = nil + else: + let m = gImportModule(c.module, fullpath.fileInfoIdx) + if m == nil: typ = nil + else: + for it in items(n.sym.tab): + if filterSym(it): + suggestResult(symToSuggest(it, isLocal=false, $ideSug, 100)) + inc outputs + suggestResult(symToSuggest(m, isLocal=false, $ideMod, 100)) + if typ == nil: # a module symbol has no type for example: if n.kind == nkSym and n.sym.kind == skModule: @@ -203,12 +249,12 @@ proc suggestFieldAccess(c: PContext, n: PNode, outputs: var int) = # all symbols accessible, because we are in the current module: for it in items(c.topLevelScope.symbols): if filterSym(it): - suggestResult(symToSuggest(it, isLocal=false, $ideSug)) + suggestResult(symToSuggest(it, isLocal=false, $ideSug, 100)) inc outputs else: for it in items(n.sym.tab): if filterSym(it): - suggestResult(symToSuggest(it, isLocal=false, $ideSug)) + suggestResult(symToSuggest(it, isLocal=false, $ideSug, 100)) inc outputs else: # fallback: @@ -263,12 +309,11 @@ proc findClosestCall(n: PNode): PNode = result = findClosestCall(n.sons[i]) if result != nil: return -proc isTracked(current: TLineInfo, tokenLen: int): bool = - if current.fileIndex == gTrackPos.fileIndex: - if current.line == gTrackPos.line: - let col = gTrackPos.col - if col >= current.col and col <= current.col+tokenLen-1: - return true +proc isTracked*(current: TLineInfo, tokenLen: int): bool = + if current.fileIndex==gTrackPos.fileIndex and current.line==gTrackPos.line: + let col = gTrackPos.col + if col >= current.col and col <= current.col+tokenLen-1: + return true proc findClosestSym(n: PNode): PNode = if n.kind == nkSym and inCheckpoint(n.info) == cpExact: @@ -278,23 +323,43 @@ proc findClosestSym(n: PNode): PNode = result = findClosestSym(n.sons[i]) if result != nil: return +when defined(nimsuggest): + # Since TLineInfo defined a == operator that doesn't include the column, + # we map TLineInfo to a unique int here for this lookup table: + proc infoToInt(info: TLineInfo): int64 = + info.fileIndex + info.line.int64 shl 32 + info.col.int64 shl 48 + + proc addNoDup(s: PSym; info: TLineInfo) = + let infoAsInt = info.infoToInt + for infoB in s.allUsages: + if infoB.infoToInt == infoAsInt: return + s.allUsages.add(info) + var usageSym*: PSym - lastLineInfo: TLineInfo + lastLineInfo*: TLineInfo proc findUsages(info: TLineInfo; s: PSym) = - if usageSym == nil and isTracked(info, s.name.s.len): - usageSym = s - suggestResult(symToSuggest(s, isLocal=false, $ideUse)) - elif s == usageSym: - if lastLineInfo != info: - suggestResult(symToSuggest(s, isLocal=false, $ideUse, info)) - lastLineInfo = info + if suggestVersion < 2: + if usageSym == nil and isTracked(info, s.name.s.len): + usageSym = s + suggestResult(symToSuggest(s, isLocal=false, $ideUse, 100)) + elif s == usageSym: + if lastLineInfo != info: + suggestResult(symToSuggest(s, isLocal=false, $ideUse, info, 100)) + lastLineInfo = info + +when defined(nimsuggest): + proc listUsages*(s: PSym) = + #echo "usages ", len(s.allUsages) + for info in s.allUsages: + let x = if info == s.info and info.col == s.info.col: "def" else: "use" + suggestResult(symToSuggest(s, isLocal=false, x, info, 100)) proc findDefinition(info: TLineInfo; s: PSym) = if s.isNil: return if isTracked(info, s.name.s.len): - suggestResult(symToSuggest(s, isLocal=false, $ideDef)) + suggestResult(symToSuggest(s, isLocal=false, $ideDef, 100)) suggestQuit() proc ensureIdx[T](x: var T, y: int) = @@ -303,23 +368,36 @@ proc ensureIdx[T](x: var T, y: int) = proc ensureSeq[T](x: var seq[T]) = if x == nil: newSeq(x, 0) -proc suggestSym*(info: TLineInfo; s: PSym) {.inline.} = +proc suggestSym*(info: TLineInfo; s: PSym; isDecl=true) {.inline.} = ## misnamed: should be 'symDeclared' - if gIdeCmd == ideUse: - findUsages(info, s) - elif gIdeCmd == ideDef: - findDefinition(info, s) - elif gIdeCmd == ideDus and s != nil: - if isTracked(info, s.name.s.len): - suggestResult(symToSuggest(s, isLocal=false, $ideDef)) - findUsages(info, s) + when defined(nimsuggest): + if suggestVersion == 2: + if s.allUsages.isNil: + s.allUsages = @[info] + else: + s.addNoDup(info) + + if gIdeCmd == ideUse: + findUsages(info, s) + elif gIdeCmd == ideDef: + findDefinition(info, s) + elif gIdeCmd == ideDus and s != nil: + if isTracked(info, s.name.s.len): + suggestResult(symToSuggest(s, isLocal=false, $ideDef, 100)) + findUsages(info, s) + elif gIdeCmd == ideHighlight and info.fileIndex == gTrackPos.fileIndex: + suggestResult(symToSuggest(s, isLocal=false, $ideHighlight, info, 100)) + elif gIdeCmd == ideOutline and info.fileIndex == gTrackPos.fileIndex and + isDecl: + suggestResult(symToSuggest(s, isLocal=false, $ideOutline, info, 100)) proc markUsed(info: TLineInfo; s: PSym) = incl(s.flags, sfUsed) if {sfDeprecated, sfError} * s.flags != {}: if sfDeprecated in s.flags: message(info, warnDeprecated, s.name.s) if sfError in s.flags: localError(info, errWrongSymbolX, s.name.s) - suggestSym(info, s) + when defined(nimsuggest): + suggestSym(info, s, false) proc useSym*(sym: PSym): PNode = result = newSymNode(sym) @@ -348,8 +426,9 @@ proc suggestExpr*(c: PContext, node: PNode) = if n.kind == nkDotExpr: var obj = safeSemExpr(c, n.sons[0]) suggestFieldAccess(c, obj, outputs) - if optIdeDebug in gGlobalOptions: - echo "expression ", renderTree(obj), " has type ", typeToString(obj.typ) + + #if optIdeDebug in gGlobalOptions: + # echo "expression ", renderTree(obj), " has type ", typeToString(obj.typ) #writeStackTrace() else: suggestEverything(c, n, outputs) @@ -370,7 +449,7 @@ proc suggestExpr*(c: PContext, node: PNode) = suggestCall(c, a, n, outputs) dec(c.compilesContextId) - if outputs > 0 and gIdeCmd notin {ideUse, ideDus}: suggestQuit() + if outputs > 0 and gIdeCmd in {ideSug, ideCon, ideDef}: suggestQuit() proc suggestStmt*(c: PContext, n: PNode) = suggestExpr(c, n) diff --git a/compiler/syntaxes.nim b/compiler/syntaxes.nim index 021910544..37ea6e2db 100644 --- a/compiler/syntaxes.nim +++ b/compiler/syntaxes.nim @@ -97,10 +97,7 @@ proc parsePipe(filename: string, inputStream: PLLStream): PNode = discard llStreamReadLine(s, line) i = 0 inc linenumber - if line[i] == '#' and line[i+1] in {'?', '!'}: - if line[i+1] == '!': - message(newLineInfo(filename, linenumber, 1), - warnDeprecated, "use '#?' instead; '#!'") + if line[i] == '#' and line[i+1] == '?': inc(i, 2) while line[i] in Whitespace: inc(i) var q: TParser diff --git a/compiler/tccgen.nim b/compiler/tccgen.nim index 7616641fc..ea0fb590f 100644 --- a/compiler/tccgen.nim +++ b/compiler/tccgen.nim @@ -35,7 +35,7 @@ proc setupEnvironment = when defined(linux): defineSymbol(gTinyC, "__linux__", nil) defineSymbol(gTinyC, "__linux", nil) - var nimrodDir = getPrefixDir() + var nimDir = getPrefixDir() addIncludePath(gTinyC, libpath) when defined(windows): @@ -44,7 +44,7 @@ proc setupEnvironment = when defined(windows): defineSymbol(gTinyC, "_WIN32", nil) # we need Mingw's headers too: - var gccbin = getConfigVar("gcc.path") % ["nimrod", nimrodDir] + var gccbin = getConfigVar("gcc.path") % ["nim", nimDir] addSysincludePath(gTinyC, gccbin /../ "include") #addFile(nimrodDir / r"tinyc\win32\wincrt1.o") addFile(nimrodDir / r"tinyc\win32\alloca86.o") diff --git a/compiler/transf.nim b/compiler/transf.nim index 92319ac19..25988fb8c 100644 --- a/compiler/transf.nim +++ b/compiler/transf.nim @@ -12,7 +12,7 @@ # # * inlines iterators # * inlines constants -# * performes constant folding +# * performs constant folding # * converts "continue" to "break"; disambiguates "break" # * introduces method dispatchers # * performs lambda lifting for closure support @@ -45,7 +45,7 @@ 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' - deferDetected: bool + deferDetected, tooEarly: bool PTransf = ref TTransfContext proc newTransNode(a: PNode): PTransNode {.inline.} = @@ -93,10 +93,15 @@ proc getCurrOwner(c: PTransf): PSym = if c.transCon != nil: result = c.transCon.owner else: result = c.module -proc newTemp(c: PTransf, typ: PType, info: TLineInfo): PSym = - result = newSym(skTemp, getIdent(genPrefix), getCurrOwner(c), info) - result.typ = skipTypes(typ, {tyGenericInst}) - incl(result.flags, sfFromGeneric) +proc newTemp(c: PTransf, typ: PType, info: TLineInfo): PNode = + let r = newSym(skTemp, getIdent(genPrefix), getCurrOwner(c), info) + r.typ = typ #skipTypes(typ, {tyGenericInst}) + incl(r.flags, sfFromGeneric) + let owner = getCurrOwner(c) + if owner.isIterator and not c.tooEarly: + result = freshVarForClosureIter(r, owner) + else: + result = newSymNode(r) proc transform(c: PTransf, n: PNode): PTransNode @@ -111,13 +116,22 @@ proc newAsgnStmt(c: PTransf, le: PNode, ri: PTransNode): PTransNode = result[1] = ri proc transformSymAux(c: PTransf, n: PNode): PNode = - #if n.sym.kind == skClosureIterator: - # return liftIterSym(n) + let s = n.sym + if s.typ != nil and s.typ.callConv == ccClosure: + if s.kind == skIterator: + if c.tooEarly: return n + else: return liftIterSym(n, getCurrOwner(c)) + elif s.kind in {skProc, skConverter, skMethod} and not c.tooEarly: + # top level .closure procs are still somewhat supported for 'Nake': + return makeClosure(s, nil, n.info) + #elif n.sym.kind in {skVar, skLet} and n.sym.typ.callConv == ccClosure: + # echo n.info, " come heer for ", c.tooEarly + # if not c.tooEarly: var b: PNode var tc = c.transCon - if sfBorrow in n.sym.flags and n.sym.kind in routineKinds: + if sfBorrow in s.flags and s.kind in routineKinds: # simply exchange the symbol: - b = n.sym.getBody + b = s.getBody if b.kind != nkSym: internalError(n.info, "wrong AST for borrowed symbol") b = newSymNode(b.sym) b.info = n.info @@ -132,6 +146,16 @@ proc transformSymAux(c: PTransf, n: PNode): PNode = proc transformSym(c: PTransf, n: PNode): PTransNode = result = PTransNode(transformSymAux(c, n)) +proc freshVar(c: PTransf; v: PSym): PNode = + let owner = getCurrOwner(c) + if owner.isIterator and not c.tooEarly: + result = freshVarForClosureIter(v, owner) + else: + var newVar = copySym(v) + incl(newVar.flags, sfFromGeneric) + newVar.owner = owner + result = newSymNode(newVar) + proc transformVarSection(c: PTransf, v: PNode): PTransNode = result = newTransNode(v) for i in countup(0, sonsLen(v)-1): @@ -141,35 +165,30 @@ proc transformVarSection(c: PTransf, v: PNode): PTransNode = elif it.kind == nkIdentDefs: if it.sons[0].kind == nkSym: internalAssert(it.len == 3) - var newVar = copySym(it.sons[0].sym) - incl(newVar.flags, sfFromGeneric) - # fixes a strange bug for rodgen: - #include(it.sons[0].sym.flags, sfFromGeneric); - newVar.owner = getCurrOwner(c) - idNodeTablePut(c.transCon.mapping, it.sons[0].sym, newSymNode(newVar)) + let x = freshVar(c, it.sons[0].sym) + idNodeTablePut(c.transCon.mapping, it.sons[0].sym, x) var defs = newTransNode(nkIdentDefs, it.info, 3) if importantComments(): # keep documentation information: PNode(defs).comment = it.comment - defs[0] = newSymNode(newVar).PTransNode + defs[0] = x.PTransNode defs[1] = it.sons[1].PTransNode defs[2] = transform(c, it.sons[2]) - newVar.ast = defs[2].PNode + if x.kind == nkSym: x.sym.ast = defs[2].PNode result[i] = defs else: - # has been transformed into 'param.x' for closure iterators, so keep it: - result[i] = PTransNode(it) + # has been transformed into 'param.x' for closure iterators, so just + # transform it: + result[i] = transform(c, it) else: if it.kind != nkVarTuple: internalError(it.info, "transformVarSection: not nkVarTuple") var L = sonsLen(it) var defs = newTransNode(it.kind, it.info, L) for j in countup(0, L-3): - var newVar = copySym(it.sons[j].sym) - incl(newVar.flags, sfFromGeneric) - newVar.owner = getCurrOwner(c) - idNodeTablePut(c.transCon.mapping, it.sons[j].sym, newSymNode(newVar)) - defs[j] = newSymNode(newVar).PTransNode + let x = freshVar(c, it.sons[j].sym) + idNodeTablePut(c.transCon.mapping, it.sons[j].sym, x) + defs[j] = x.PTransNode assert(it.sons[L-2].kind == nkEmpty) defs[L-2] = ast.emptyNode.PTransNode defs[L-1] = transform(c, it.sons[L-1]) @@ -294,16 +313,25 @@ proc introduceNewLocalVars(c: PTransf, n: PNode): PTransNode = result = PTransNode(n) of nkVarSection, nkLetSection: result = transformVarSection(c, n) + of nkClosure: + # it can happen that for-loop-inlining produced a fresh + # set of variables, including some computed environment + # (bug #2604). We need to patch this environment here too: + let a = n[1] + if a.kind == nkSym: + n.sons[1] = transformSymAux(c, a) + return PTransNode(n) else: result = newTransNode(n) for i in countup(0, sonsLen(n)-1): - result[i] = introduceNewLocalVars(c, n.sons[i]) + result[i] = introduceNewLocalVars(c, n.sons[i]) proc transformYield(c: PTransf, n: PNode): PTransNode = result = newTransNode(nkStmtList, n.info, 0) var e = n.sons[0] # c.transCon.forStmt.len == 3 means that there is one for loop variable # and thus no tuple unpacking: + if e.typ.isNil: return result # can happen in nimsuggest for unknown reasons if skipTypes(e.typ, {tyGenericInst}).kind == tyTuple and c.transCon.forStmt.len != 3: e = skipConv(e) @@ -347,6 +375,22 @@ proc transformAddrDeref(c: PTransf, n: PNode, a, b: TNodeKind): PTransNode = # addr ( deref ( x )) --> x result = PTransNode(n.sons[0].sons[0]) +proc generateThunk(prc: PNode, dest: PType): PNode = + ## Converts 'prc' into '(thunk, nil)' so that it's compatible with + ## a closure. + + # we cannot generate a proper thunk here for GC-safety reasons + # (see internal documentation): + if gCmd == cmdCompileToJS: return prc + result = newNodeIT(nkClosure, prc.info, dest) + var conv = newNodeIT(nkHiddenSubConv, prc.info, dest) + conv.add(emptyNode) + conv.add(prc) + if prc.kind == nkClosure: + internalError(prc.info, "closure to closure created") + result.add(conv) + result.add(newNodeIT(nkNilLit, prc.info, getSysType(tyNil))) + proc transformConv(c: PTransf, n: PNode): PTransNode = # numeric types need range checks: var dest = skipTypes(n.typ, abstractVarRange) @@ -370,8 +414,8 @@ proc transformConv(c: PTransf, n: PNode): PTransNode = result = newTransNode(nkChckRange, n, 3) dest = skipTypes(n.typ, abstractVar) result[0] = transform(c, n.sons[1]) - result[1] = newIntTypeNode(nkIntLit, firstOrd(dest), source).PTransNode - result[2] = newIntTypeNode(nkIntLit, lastOrd(dest), source).PTransNode + result[1] = newIntTypeNode(nkIntLit, firstOrd(dest), dest).PTransNode + result[2] = newIntTypeNode(nkIntLit, lastOrd(dest), dest).PTransNode of tyFloat..tyFloat128: # XXX int64 -> float conversion? if skipTypes(n.typ, abstractVar).kind == tyRange: @@ -427,6 +471,10 @@ proc transformConv(c: PTransf, n: PNode): PTransNode = of tyGenericParam, tyOrdinal: result = transform(c, n.sons[1]) # happens sometimes for generated assignments, etc. + of tyProc: + result = transformSons(c, n) + if dest.callConv == ccClosure and source.callConv == ccDefault: + result = generateThunk(result[1].PNode, dest).PTransNode else: result = transformSons(c, n) @@ -477,11 +525,14 @@ proc transformFor(c: PTransf, n: PNode): PTransNode = result[1] = newNode(nkEmpty).PTransNode return result c.breakSyms.add(labl) - if call.typ.kind != tyIter and - (call.kind notin nkCallKinds or call.sons[0].kind != nkSym or - call.sons[0].sym.kind != skIterator): + if call.kind notin nkCallKinds or call.sons[0].kind != nkSym or + call.sons[0].typ.callConv == ccClosure: n.sons[length-1] = transformLoopBody(c, n.sons[length-1]).PNode - result[1] = lambdalifting.liftForLoop(n).PTransNode + if not c.tooEarly: + n.sons[length-2] = transform(c, n.sons[length-2]).PNode + result[1] = lambdalifting.liftForLoop(n, getCurrOwner(c)).PTransNode + else: + result[1] = newNode(nkEmpty).PTransNode discard c.breakSyms.pop return result @@ -511,16 +562,15 @@ proc transformFor(c: PTransf, n: PNode): PTransNode = for i in countup(1, sonsLen(call) - 1): var arg = transform(c, call.sons[i]).PNode var formal = skipTypes(iter.typ, abstractInst).n.sons[i].sym - if arg.typ.kind == tyIter: continue case putArgInto(arg, formal.typ) of paDirectMapping: idNodeTablePut(newC.mapping, formal, arg) of paFastAsgn: # generate a temporary and produce an assignment statement: var temp = newTemp(c, formal.typ, formal.info) - addVar(v, newSymNode(temp)) - add(stmtList, newAsgnStmt(c, newSymNode(temp), arg.PTransNode)) - idNodeTablePut(newC.mapping, formal, newSymNode(temp)) + addVar(v, temp) + add(stmtList, newAsgnStmt(c, temp, arg.PTransNode)) + idNodeTablePut(newC.mapping, formal, temp) of paVarAsgn: assert(skipTypes(formal.typ, abstractInst).kind == tyVar) idNodeTablePut(newC.mapping, formal, arg) @@ -701,18 +751,13 @@ proc transform(c: PTransf, n: PNode): PTransNode = result = PTransNode(n) of nkBracketExpr: result = transformArrayAccess(c, n) of procDefs: - when false: - if n.sons[genericParamsPos].kind == nkEmpty: - var s = n.sons[namePos].sym - n.sons[bodyPos] = PNode(transform(c, s.getBody)) - if s.ast.sons[bodyPos] != n.sons[bodyPos]: - # somehow this can happen ... :-/ - s.ast.sons[bodyPos] = n.sons[bodyPos] - #n.sons[bodyPos] = liftLambdas(s, n) - #if n.kind == nkMethodDef: methodDef(s, false) - #if n.kind == nkIteratorDef and n.typ != nil: - # return liftIterSym(n.sons[namePos]).PTransNode - result = PTransNode(n) + var s = n.sons[namePos].sym + if n.typ != nil and s.typ.callConv == ccClosure: + result = transformSym(c, n.sons[namePos]) + # use the same node as before if still a symbol: + if result.PNode.kind == nkSym: result = PTransNode(n) + else: + result = PTransNode(n) of nkMacroDef: # XXX no proper closure support yet: when false: @@ -749,7 +794,7 @@ proc transform(c: PTransf, n: PNode): PTransNode = result = newTransNode(nkCommentStmt, n.info, 0) tryStmt.addSon(deferPart) # disable the original 'defer' statement: - n.kind = nkCommentStmt + n.kind = nkEmpty of nkContinueStmt: result = PTransNode(newNodeI(nkBreakStmt, n.info)) var labl = c.contSyms[c.contSyms.high] @@ -795,7 +840,14 @@ proc transform(c: PTransf, n: PNode): PTransNode = # XXX comment handling really sucks: if importantComments(): PNode(result).comment = n.comment - of nkClosure: return PTransNode(n) + of nkClosure: + # it can happen that for-loop-inlining produced a fresh + # set of variables, including some computed environment + # (bug #2604). We need to patch this environment here too: + let a = n[1] + if a.kind == nkSym: + n.sons[1] = transformSymAux(c, a) + return PTransNode(n) else: result = transformSons(c, n) when false: @@ -867,11 +919,11 @@ proc transformBody*(module: PSym, n: PNode, prc: PSym): PNode = result = n else: var c = openTransf(module, "") - result = processTransf(c, n, prc) + result = liftLambdas(prc, n, c.tooEarly) + #result = n + result = processTransf(c, result, prc) liftDefer(c, result) - result = liftLambdas(prc, result) - #if prc.kind == skClosureIterator: - # result = lambdalifting.liftIterator(prc, result) + #result = liftLambdas(prc, result) incl(result.flags, nfTransf) when useEffectSystem: trackProc(prc, result) #if prc.name.s == "testbody": @@ -884,9 +936,11 @@ proc transformStmt*(module: PSym, n: PNode): PNode = var c = openTransf(module, "") result = processTransf(c, n, module) liftDefer(c, result) - result = liftLambdasForTopLevel(module, result) + #result = liftLambdasForTopLevel(module, result) incl(result.flags, nfTransf) when useEffectSystem: trackTopLevelStmt(module, result) + #if n.info ?? "temp.nim": + # echo renderTree(result, {renderIds}) proc transformExpr*(module: PSym, n: PNode): PNode = if nfTransf in n.flags: diff --git a/compiler/types.nim b/compiler/types.nim index 66fb657fc..bada47075 100644 --- a/compiler/types.nim +++ b/compiler/types.nim @@ -412,7 +412,6 @@ const const preferToResolveSymbols = {preferName, preferModuleInfo, preferGenericArg} proc addTypeFlags(name: var string, typ: PType) {.inline.} = - if tfShared in typ.flags: name = "shared " & name if tfNotNil in typ.flags: name.add(" not nil") proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = @@ -991,7 +990,9 @@ proc compareTypes*(x, y: PType, var c = initSameTypeClosure() c.cmp = cmp c.flags = flags - result = sameTypeAux(x, y, c) + if x == y: result = true + elif x.isNil or y.isNil: result = false + else: result = sameTypeAux(x, y, c) proc inheritanceDiff*(a, b: PType): int = # | returns: 0 iff `a` == `b` @@ -1059,7 +1060,8 @@ proc typeAllowedNode(marker: var IntSet, n: PNode, kind: TSymKind, else: for i in countup(0, sonsLen(n) - 1): let it = n.sons[i] - if it.kind == nkRecCase and kind == skConst: return n.typ + if it.kind == nkRecCase and kind in {skProc, skConst}: + return n.typ result = typeAllowedNode(marker, it, kind, flags) if result != nil: break @@ -1074,7 +1076,7 @@ proc matchType*(a: PType, pattern: openArray[tuple[k:TTypeKind, i:int]], proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, flags: TTypeAllowedFlags = {}): PType = - assert(kind in {skVar, skLet, skConst, skParam, skResult}) + assert(kind in {skVar, skLet, skConst, skProc, skParam, skResult}) # if we have already checked the type, return true, because we stop the # evaluation if something is wrong: result = nil @@ -1083,7 +1085,7 @@ proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, var t = skipTypes(typ, abstractInst-{tyTypeDesc}) case t.kind of tyVar: - if kind == skConst: return t + if kind in {skProc, skConst}: return t var t2 = skipTypes(t.sons[0], abstractInst-{tyTypeDesc}) case t2.kind of tyVar: @@ -1095,6 +1097,7 @@ proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, if kind notin {skParam, skResult}: result = t else: result = typeAllowedAux(marker, t2, kind, flags) of tyProc: + if kind == skConst and t.callConv == ccClosure: return t for i in countup(1, sonsLen(t) - 1): result = typeAllowedAux(marker, t.sons[i], skParam, flags) if result != nil: break @@ -1142,7 +1145,8 @@ proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, result = typeAllowedAux(marker, t.sons[i], kind, flags) if result != nil: break of tyObject, tyTuple: - if kind == skConst and t.kind == tyObject and t.sons[0] != nil: return t + if kind in {skProc, skConst} and + t.kind == tyObject and t.sons[0] != nil: return t let flags = flags+{taField} for i in countup(0, sonsLen(t) - 1): result = typeAllowedAux(marker, t.sons[i], kind, flags) @@ -1444,6 +1448,18 @@ proc skipConv*(n: PNode): PNode = result = n.sons[1] else: discard +proc skipHidden*(n: PNode): PNode = + result = n + while true: + case result.kind + of nkHiddenStdConv, nkHiddenSubConv: + if result.sons[1].typ.classify == result.typ.classify: + result = result.sons[1] + else: break + of nkHiddenDeref, nkHiddenAddr: + result = result.sons[0] + else: break + proc skipConvTakeType*(n: PNode): PNode = result = n.skipConv result.typ = n.typ @@ -1489,3 +1505,12 @@ proc skipHiddenSubConv*(n: PNode): PNode = result.typ = dest else: result = n + +proc typeMismatch*(n: PNode, formal, actual: PType) = + if formal.kind != tyError and actual.kind != tyError: + let named = typeToString(formal) + let desc = typeToString(formal, preferDesc) + let x = if named == desc: named else: named & " = " & desc + localError(n.info, errGenerated, msgKindToString(errTypeMismatch) & + typeToString(actual) & ") " & + `%`(msgKindToString(errButExpectedX), [x])) diff --git a/compiler/typesrenderer.nim b/compiler/typesrenderer.nim index 700356ab7..d050a86b2 100644 --- a/compiler/typesrenderer.nim +++ b/compiler/typesrenderer.nim @@ -100,7 +100,6 @@ proc renderParamTypes(found: var seq[string], n: PNode) = if not typ.isNil: typeStr = typeToString(typ, preferExported) if typeStr.len < 1: return for i in 0 .. <typePos: - assert ((n[i].kind == nkIdent) or (n[i].kind == nkAccQuoted)) found.add(typeStr) else: internalError(n.info, "renderParamTypes(found,n) with " & $n.kind) diff --git a/compiler/vm.nim b/compiler/vm.nim index ded66d3d0..f275b7b9b 100644 --- a/compiler/vm.nim +++ b/compiler/vm.nim @@ -10,12 +10,14 @@ ## This file implements the new evaluation engine for Nim code. ## An instruction is 1-3 int32s in memory, it is a register based VM. -const debugEchoCode = false +const + debugEchoCode = false + traceCode = debugEchoCode import ast except getstr import - strutils, astalgo, msgs, vmdef, vmgen, nimsets, types, passes, unsigned, + strutils, astalgo, msgs, vmdef, vmgen, nimsets, types, passes, parser, vmdeps, idents, trees, renderer, options, transf, parseutils, vmmarshal @@ -121,7 +123,7 @@ template move(a, b: expr) {.immediate, dirty.} = system.shallowCopy(a, b) # XXX fix minor 'shallowCopy' overloading bug in compiler proc createStrKeepNode(x: var TFullReg; keepNode=true) = - if x.node.isNil: + if x.node.isNil or not keepNode: x.node = newNode(nkStrLit) elif x.node.kind == nkNilLit and keepNode: when defined(useNodeIds): @@ -255,9 +257,12 @@ proc cleanUpOnException(c: PCtx; tos: PStackFrame): nextExceptOrFinally = pc2 + c.code[pc2].regBx - wordExcess inc pc2 while c.code[pc2].opcode == opcExcept: - let exceptType = c.types[c.code[pc2].regBx-wordExcess].skipTypes( + let excIndex = c.code[pc2].regBx-wordExcess + let exceptType = if excIndex > 0: c.types[excIndex].skipTypes( abstractPtrs) - if inheritanceDiff(exceptType, raisedType) <= 0: + else: nil + #echo typeToString(exceptType), " ", typeToString(raisedType) + if exceptType.isNil or inheritanceDiff(exceptType, raisedType) <= 0: # mark exception as handled but keep it in B for # the getCurrentException() builtin: c.currentExceptionB = c.currentExceptionA @@ -356,7 +361,14 @@ proc opConv*(dest: var TFullReg, src: TFullReg, desttyp, srctyp: PType): bool = of tyFloat..tyFloat64: dest.intVal = int(src.floatVal) else: - dest.intVal = src.intVal and ((1 shl (desttyp.size*8))-1) + let srcDist = (sizeof(src.intVal) - srctyp.size) * 8 + let destDist = (sizeof(dest.intVal) - desttyp.size) * 8 + when system.cpuEndian == bigEndian: + dest.intVal = (src.intVal shr srcDist) shl srcDist + dest.intVal = (dest.intVal shr destDist) shl destDist + else: + dest.intVal = (src.intVal shl srcDist) shr srcDist + dest.intVal = (dest.intVal shl destDist) shr destDist of tyFloat..tyFloat64: if dest.kind != rkFloat: myreset(dest); dest.kind = rkFloat @@ -394,7 +406,8 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = let instr = c.code[pc] let ra = instr.regA #if c.traceActive: - #echo "PC ", pc, " ", c.code[pc].opcode, " ra ", ra, " rb ", instr.regB, " rc ", instr.regC + when traceCode: + echo "PC ", pc, " ", c.code[pc].opcode, " ra ", ra, " rb ", instr.regB, " rc ", instr.regC # message(c.debug[pc], warnUser, "Trace") case instr.opcode @@ -511,7 +524,10 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = regs[ra].regAddr = addr(regs[rb]) of opcAddrNode: decodeB(rkNodeAddr) - regs[ra].nodeAddr = addr(regs[rb].node) + if regs[rb].kind == rkNode: + regs[ra].nodeAddr = addr(regs[rb].node) + else: + stackTrace(c, tos, pc, errGenerated, "limited VM support for 'addr'") of opcLdDeref: # a = b[] let ra = instr.regA @@ -529,7 +545,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = if regs[rb].node.kind == nkRefTy: regs[ra].node = regs[rb].node.sons[0] else: - stackTrace(c, tos, pc, errGenerated, "limited VM support for 'ref'") + stackTrace(c, tos, pc, errGenerated, "limited VM support for pointers") else: stackTrace(c, tos, pc, errNilAccess) of opcWrDeref: @@ -605,7 +621,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = addSon(regs[ra].node, r.copyTree) of opcExcl: decodeB(rkNode) - var b = newNodeIT(nkCurly, regs[rb].node.info, regs[rb].node.typ) + var b = newNodeIT(nkCurly, regs[ra].node.info, regs[ra].node.typ) addSon(b, regs[rb].regToNode) var r = diffSets(regs[ra].node, b) discardSons(regs[ra].node) @@ -808,13 +824,13 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcEcho: let rb = instr.regB if rb == 1: - msgWriteln(regs[ra].node.strVal) + msgWriteln(regs[ra].node.strVal, {msgStdout}) else: var outp = "" for i in ra..ra+rb-1: #if regs[i].kind != rkNode: debug regs[i] outp.add(regs[i].node.strVal) - msgWriteln(outp) + msgWriteln(outp, {msgStdout}) of opcContainsSet: decodeBC(rkInt) regs[ra].intVal = ord(inSet(regs[rb].node, regs[rc].regToNode)) @@ -1169,24 +1185,41 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = of opcNGetType: let rb = instr.regB let rc = instr.regC - if rc == 0: + case rc: + of 0: + # getType opcode: ensureKind(rkNode) if regs[rb].kind == rkNode and regs[rb].node.typ != nil: regs[ra].node = opMapTypeToAst(regs[rb].node.typ, c.debug[pc]) else: stackTrace(c, tos, pc, errGenerated, "node has no type") - else: + of 1: # typeKind opcode: ensureKind(rkInt) if regs[rb].kind == rkNode and regs[rb].node.typ != nil: regs[ra].intVal = ord(regs[rb].node.typ.kind) #else: # stackTrace(c, tos, pc, errGenerated, "node has no type") + of 2: + # getTypeInst opcode: + ensureKind(rkNode) + if regs[rb].kind == rkNode and regs[rb].node.typ != nil: + regs[ra].node = opMapTypeInstToAst(regs[rb].node.typ, c.debug[pc]) + else: + stackTrace(c, tos, pc, errGenerated, "node has no type") + else: + # getTypeImpl opcode: + ensureKind(rkNode) + if regs[rb].kind == rkNode and regs[rb].node.typ != nil: + regs[ra].node = opMapTypeImplToAst(regs[rb].node.typ, c.debug[pc]) + else: + stackTrace(c, tos, pc, errGenerated, "node has no type") of opcNStrVal: decodeB(rkNode) createStr regs[ra] let a = regs[rb].node if a.kind in {nkStrLit..nkTripleStrLit}: regs[ra].node.strVal = a.strVal + elif a.kind == nkCommentStmt: regs[ra].node.strVal = a.comment else: stackTrace(c, tos, pc, errFieldXNotFound, "strVal") of opcSlurp: decodeB(rkNode) @@ -1576,12 +1609,13 @@ proc evalMacroCall*(module: PSym, n, nOrig: PNode, sym: PSym): PNode = for i in 1.. <sym.typ.len: tos.slots[i] = setupMacroParam(n.sons[i], sym.typ.sons[i]) - if sfImmediate notin sym.flags: - let gp = sym.ast[genericParamsPos] - for i in 0 .. <gp.len: + let gp = sym.ast[genericParamsPos] + for i in 0 .. <gp.len: + if sfImmediate notin sym.flags: let idx = sym.typ.len + i tos.slots[idx] = setupMacroParam(n.sons[idx], gp[i].sym.typ) - + elif gp[i].sym.typ.kind in {tyStatic, tyTypeDesc}: + globalError(n.info, "static[T] or typedesc nor supported for .immediate macros") # temporary storage: #for i in L .. <maxSlots: tos.slots[i] = newNode(nkEmpty) result = rawExecute(c, start, tos).regToNode diff --git a/compiler/vmdeps.nim b/compiler/vmdeps.nim index 2cc4a107b..e7ead17b6 100644 --- a/compiler/vmdeps.nim +++ b/compiler/vmdeps.nim @@ -67,10 +67,12 @@ proc atomicTypeX(name: string; t: PType; info: TLineInfo): PNode = result = newSymNode(sym) result.typ = t -proc mapTypeToAst(t: PType, info: TLineInfo; allowRecursion=false): PNode +proc mapTypeToAstX(t: PType; info: TLineInfo; + inst=false; allowRecursionX=false): PNode -proc mapTypeToBracket(name: string; t: PType; info: TLineInfo): PNode = - result = newNodeIT(nkBracketExpr, info, t) +proc mapTypeToBracketX(name: string; t: PType; info: TLineInfo; + inst=false): PNode = + result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) result.add atomicTypeX(name, t, info) for i in 0 .. < t.len: if t.sons[i] == nil: @@ -78,10 +80,39 @@ proc mapTypeToBracket(name: string; t: PType; info: TLineInfo): PNode = void.typ = newType(tyEmpty, t.owner) result.add void else: - result.add mapTypeToAst(t.sons[i], info) + result.add mapTypeToAstX(t.sons[i], info, inst) -proc mapTypeToAst(t: PType, info: TLineInfo; allowRecursion=false): PNode = +proc mapTypeToAstX(t: PType; info: TLineInfo; + inst=false; allowRecursionX=false): PNode = + var allowRecursion = allowRecursionX template atomicType(name): expr = atomicTypeX(name, t, info) + template mapTypeToAst(t,info): expr = mapTypeToAstX(t, info, inst) + template mapTypeToAstR(t,info): expr = mapTypeToAstX(t, info, inst, true) + template mapTypeToAst(t,i,info): expr = + if i<t.len and t.sons[i]!=nil: mapTypeToAstX(t.sons[i], info, inst) + else: ast.emptyNode + template mapTypeToBracket(name,t,info): expr = + mapTypeToBracketX(name, t, info, inst) + template newNodeX(kind):expr = + newNodeIT(kind, if t.n.isNil: info else: t.n.info, t) + template newIdent(s):expr = + var r = newNodeX(nkIdent) + r.add !s + r + template newIdentDefs(n,t):expr = + var id = newNodeX(nkIdentDefs) + id.add n # name + id.add mapTypeToAst(t, info) # type + id.add ast.emptyNode # no assigned value + id + template newIdentDefs(s):expr = newIdentDefs(s, s.typ) + + if inst: + if t.sym != nil: # if this node has a symbol + if allowRecursion: # getTypeImpl behavior: turn off recursion + allowRecursion = false + else: # getTypeInst behavior: return symbol + return atomicType(t.sym.name.s) case t.kind of tyNone: result = atomicType("none") @@ -92,52 +123,120 @@ proc mapTypeToAst(t: PType, info: TLineInfo; allowRecursion=false): PNode = of tyStmt: result = atomicType("stmt") of tyEmpty: result = atomicType"void" of tyArrayConstr, tyArray: - result = newNodeIT(nkBracketExpr, info, t) + result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) result.add atomicType("array") - result.add mapTypeToAst(t.sons[0], info) + if inst and t.sons[0].kind == tyRange: + var rng = newNodeX(nkInfix) + rng.add newIdentNode(getIdent(".."), info) + rng.add t.sons[0].n.sons[0].copyTree + rng.add t.sons[0].n.sons[1].copyTree + result.add rng + else: + result.add mapTypeToAst(t.sons[0], info) result.add mapTypeToAst(t.sons[1], info) of tyTypeDesc: if t.base != nil: - result = newNodeIT(nkBracketExpr, info, t) + result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) result.add atomicType("typeDesc") result.add mapTypeToAst(t.base, info) else: result = atomicType"typeDesc" of tyGenericInvocation: - result = newNodeIT(nkBracketExpr, info, t) + result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) for i in 0 .. < t.len: result.add mapTypeToAst(t.sons[i], info) - of tyGenericInst, tyGenericBody, tyOrdinal, tyUserTypeClassInst: + of tyGenericInst: + if inst: + if allowRecursion: + result = mapTypeToAstR(t.lastSon, info) + else: + result = newNodeX(nkBracketExpr) + result.add mapTypeToAst(t.lastSon, info) + for i in 1 .. < t.len-1: + result.add mapTypeToAst(t.sons[i], info) + else: + result = mapTypeToAst(t.lastSon, info) + of tyGenericBody, tyOrdinal, tyUserTypeClassInst: result = mapTypeToAst(t.lastSon, info) of tyDistinct: - if allowRecursion: - result = mapTypeToBracket("distinct", t, info) + if inst: + result = newNodeX(nkDistinctTy) + result.add mapTypeToAst(t.sons[0], info) else: - result = atomicType(t.sym.name.s) + if allowRecursion or t.sym==nil: + result = mapTypeToBracket("distinct", t, info) + else: + result = atomicType(t.sym.name.s) of tyGenericParam, tyForward: result = atomicType(t.sym.name.s) of tyObject: - if allowRecursion: - result = newNodeIT(nkObjectTy, info, t) - if t.sons[0] == nil: - result.add ast.emptyNode + if inst: + result = newNodeX(nkObjectTy) + result.add ast.emptyNode # pragmas not reconstructed yet + if t.sons[0]==nil: result.add ast.emptyNode # handle parent object + else: + var nn = newNodeX(nkOfInherit) + nn.add mapTypeToAst(t.sons[0], info) + result.add nn + if t.n.sons.len>0: + var rl = copyNode(t.n) # handle nkRecList + for s in t.n.sons: + rl.add newIdentDefs(s) + result.add rl else: - result.add mapTypeToAst(t.sons[0], info) - result.add copyTree(t.n) + result.add ast.emptyNode else: - result = atomicType(t.sym.name.s) + if allowRecursion or t.sym == nil: + result = newNodeIT(nkObjectTy, if t.n.isNil: info else: t.n.info, t) + result.add ast.emptyNode + if t.sons[0] == nil: + result.add ast.emptyNode + else: + result.add mapTypeToAst(t.sons[0], info) + result.add copyTree(t.n) + else: + result = atomicType(t.sym.name.s) of tyEnum: - result = newNodeIT(nkEnumTy, info, t) + result = newNodeIT(nkEnumTy, if t.n.isNil: info else: t.n.info, t) result.add copyTree(t.n) - of tyTuple: result = mapTypeToBracket("tuple", t, info) + of tyTuple: + if inst: + result = newNodeX(nkTupleTy) + for s in t.n.sons: + result.add newIdentDefs(s) + else: + result = mapTypeToBracket("tuple", t, info) of tySet: result = mapTypeToBracket("set", t, info) - of tyPtr: result = mapTypeToBracket("ptr", t, info) - of tyRef: result = mapTypeToBracket("ref", t, info) + of tyPtr: + if inst: + result = newNodeX(nkPtrTy) + result.add mapTypeToAst(t.sons[0], info) + else: + result = mapTypeToBracket("ptr", t, info) + of tyRef: + if inst: + result = newNodeX(nkRefTy) + result.add mapTypeToAst(t.sons[0], info) + else: + result = mapTypeToBracket("ref", t, info) of tyVar: result = mapTypeToBracket("var", t, info) of tySequence: result = mapTypeToBracket("seq", t, info) - of tyProc: result = mapTypeToBracket("proc", t, info) + of tyProc: + if inst: + result = newNodeX(nkProcTy) + var fp = newNodeX(nkFormalParams) + if t.sons[0] == nil: + fp.add ast.emptyNode + else: + fp.add mapTypeToAst(t.sons[0], t.n[0].info) + for i in 1..<t.sons.len: + fp.add newIdentDefs(t.n[i], t.sons[i]) + result.add fp + result.add ast.emptyNode # pragmas aren't reconstructed yet + else: + result = mapTypeToBracket("proc", t, info) of tyOpenArray: result = mapTypeToBracket("openArray", t, info) of tyRange: - result = newNodeIT(nkBracketExpr, info, t) + result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) result.add atomicType("range") result.add t.n.sons[0].copyTree result.add t.n.sons[1].copyTree @@ -174,10 +273,24 @@ proc mapTypeToAst(t: PType, info: TLineInfo; allowRecursion=false): PNode = of tyNot: result = mapTypeToBracket("not", t, info) of tyAnything: result = atomicType"anything" of tyStatic, tyFromExpr, tyFieldAccessor: - result = newNodeIT(nkBracketExpr, info, t) - result.add atomicType("static") - if t.n != nil: - result.add t.n.copyTree + if inst: + if t.n != nil: result = t.n.copyTree + else: result = atomicType "void" + else: + result = newNodeIT(nkBracketExpr, if t.n.isNil: info else: t.n.info, t) + result.add atomicType "static" + if t.n != nil: + result.add t.n.copyTree proc opMapTypeToAst*(t: PType; info: TLineInfo): PNode = - result = mapTypeToAst(t, info, true) + result = mapTypeToAstX(t, info, false, true) + +# the "Inst" version includes generic parameters in the resulting type tree +# and also tries to look like the corresponding Nim type declaration +proc opMapTypeInstToAst*(t: PType; info: TLineInfo): PNode = + result = mapTypeToAstX(t, info, true, false) + +# the "Impl" version includes generic parameters in the resulting type tree +# and also tries to look like the corresponding Nim type implementation +proc opMapTypeImplToAst*(t: PType; info: TLineInfo): PNode = + result = mapTypeToAstX(t, info, true, true) diff --git a/compiler/vmgen.nim b/compiler/vmgen.nim index 92db0d513..7832aa9b9 100644 --- a/compiler/vmgen.nim +++ b/compiler/vmgen.nim @@ -28,7 +28,7 @@ # this copy depends on the involved types. import - unsigned, strutils, ast, astalgo, types, msgs, renderer, vmdef, + strutils, ast, astalgo, types, msgs, renderer, vmdef, trees, intsets, rodread, magicsys, options, lowerings from os import splitFile @@ -102,14 +102,18 @@ proc gABC(ctx: PCtx; n: PNode; opc: TOpcode; a, b, c: TRegister = 0) = let ins = (opc.uint32 or (a.uint32 shl 8'u32) or (b.uint32 shl 16'u32) or (c.uint32 shl 24'u32)).TInstr + when false: + if ctx.code.len == 43: + writeStackTrace() + echo "generating ", opc ctx.code.add(ins) ctx.debug.add(n.info) proc gABI(c: PCtx; n: PNode; opc: TOpcode; a, b: TRegister; imm: BiggestInt) = # Takes the `b` register and the immediate `imm`, appies the operation `opc`, # and stores the output value into `a`. - # `imm` is signed and must be within [-127, 128] - if imm >= -127 and imm <= 128: + # `imm` is signed and must be within [-128, 127] + if imm >= -128 and imm <= 127: let ins = (opc.uint32 or (a.uint32 shl 8'u32) or (b.uint32 shl 16'u32) or (imm+byteExcess).uint32 shl 24'u32).TInstr @@ -121,8 +125,13 @@ proc gABI(c: PCtx; n: PNode; opc: TOpcode; a, b: TRegister; imm: BiggestInt) = proc gABx(c: PCtx; n: PNode; opc: TOpcode; a: TRegister = 0; bx: int) = # Applies `opc` to `bx` and stores it into register `a` - # `bx` must be signed and in the range [-32767, 32768] - if bx >= -32767 and bx <= 32768: + # `bx` must be signed and in the range [-32768, 32767] + when false: + if c.code.len == 43: + writeStackTrace() + echo "generating ", opc + + if bx >= -32768 and bx <= 32767: let ins = (opc.uint32 or a.uint32 shl 8'u32 or (bx+wordExcess).uint32 shl 16'u32).TInstr c.code.add(ins) @@ -704,6 +713,10 @@ proc genAddSubInt(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode) = c.genNarrow(n, dest) proc genConv(c: PCtx; n, arg: PNode; dest: var TDest; opc=opcConv) = + if n.typ.kind == arg.typ.kind and arg.typ.kind == tyProc: + # don't do anything for lambda lifting conversions: + gen(c, arg, dest) + return let tmp = c.genx(arg) if dest < 0: dest = c.getTemp(n.typ) c.gABC(n, opc, dest, tmp) @@ -970,7 +983,12 @@ proc genMagic(c: PCtx; n: PNode; dest: var TDest; m: TMagic) = of mNGetType: let tmp = c.genx(n.sons[1]) if dest < 0: dest = c.getTemp(n.typ) - c.gABC(n, opcNGetType, dest, tmp, if n[0].sym.name.s == "typeKind": 1 else: 0) + let rc = case n[0].sym.name.s: + of "getType": 0 + of "typeKind": 1 + of "getTypeInst": 2 + else: 3 # "getTypeImpl" + c.gABC(n, opcNGetType, dest, tmp, rc) c.freeTemp(tmp) #genUnaryABC(c, n, dest, opcNGetType) of mNStrVal: genUnaryABC(c, n, dest, opcNStrVal) @@ -1091,11 +1109,36 @@ proc requiresCopy(n: PNode): bool = proc unneededIndirection(n: PNode): bool = n.typ.skipTypes(abstractInst-{tyTypeDesc}).kind == tyRef +proc canElimAddr(n: PNode): PNode = + case n.sons[0].kind + of nkObjUpConv, nkObjDownConv, nkChckRange, nkChckRangeF, nkChckRange64: + var m = n.sons[0].sons[0] + if m.kind in {nkDerefExpr, nkHiddenDeref}: + # addr ( nkConv ( deref ( x ) ) ) --> nkConv(x) + result = copyNode(n.sons[0]) + result.add m.sons[0] + of nkHiddenStdConv, nkHiddenSubConv, nkConv: + var m = n.sons[0].sons[1] + if m.kind in {nkDerefExpr, nkHiddenDeref}: + # addr ( nkConv ( deref ( x ) ) ) --> nkConv(x) + result = copyNode(n.sons[0]) + result.add m.sons[0] + else: + if n.sons[0].kind in {nkDerefExpr, nkHiddenDeref}: + # addr ( deref ( x )) --> x + result = n.sons[0].sons[0] + proc genAddrDeref(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode; flags: TGenFlags) = # a nop for certain types let isAddr = opc in {opcAddrNode, opcAddrReg} - let newflags = if isAddr: flags+{gfAddrOf} else: flags + if isAddr and (let m = canElimAddr(n); m != nil): + gen(c, m, dest, flags) + return + + let af = if n[0].kind in {nkBracketExpr, nkDotExpr, nkCheckedFieldExpr}: {gfAddrOf, gfFieldAccess} + else: {gfAddrOf} + let newflags = if isAddr: flags+af else: flags # consider: # proc foo(f: var ref int) = # f = new(int) @@ -1110,7 +1153,7 @@ proc genAddrDeref(c: PCtx; n: PNode; dest: var TDest; opc: TOpcode; if gfAddrOf notin flags and fitsRegister(n.typ): c.gABC(n, opcNodeToReg, dest, dest) elif isAddr and isGlobal(n.sons[0]): - gen(c, n.sons[0], dest, flags+{gfAddrOf}) + gen(c, n.sons[0], dest, flags+af) else: let tmp = c.genx(n.sons[0], newflags) if dest < 0: dest = c.getTemp(n.typ) @@ -1187,7 +1230,7 @@ proc checkCanEval(c: PCtx; n: PNode) = not s.isOwnedBy(c.prc.sym) and s.owner != c.module and c.mode != emRepl: cannotEval(n) elif s.kind in {skProc, skConverter, skMethod, - skIterator, skClosureIterator} and sfForward in s.flags: + skIterator} and sfForward in s.flags: cannotEval(n) proc isTemp(c: PCtx; dest: TDest): bool = @@ -1299,10 +1342,11 @@ proc genGlobalInit(c: PCtx; n: PNode; s: PSym) = # var decls{.compileTime.}: seq[NimNode] = @[] let dest = c.getTemp(s.typ) c.gABx(n, opcLdGlobal, dest, s.position) - let tmp = c.genx(s.ast) - c.preventFalseAlias(n, opcWrDeref, dest, 0, tmp) - c.freeTemp(dest) - c.freeTemp(tmp) + if s.ast != nil: + let tmp = c.genx(s.ast) + c.preventFalseAlias(n, opcWrDeref, dest, 0, tmp) + c.freeTemp(dest) + c.freeTemp(tmp) proc genRdVar(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags) = let s = n.sym @@ -1425,12 +1469,12 @@ proc getNullValue(typ: PType, info: TLineInfo): PNode = of tyObject: result = newNodeIT(nkObjConstr, info, t) result.add(newNodeIT(nkEmpty, info, t)) - getNullValueAux(t.n, result) # initialize inherited fields: var base = t.sons[0] while base != nil: getNullValueAux(skipTypes(base, skipPtrs).n, result) base = base.sons[0] + getNullValueAux(t.n, result) of tyArray, tyArrayConstr: result = newNodeIT(nkBracket, info, t) for i in countup(0, int(lengthOrd(t)) - 1): @@ -1582,7 +1626,8 @@ proc matches(s: PSym; x: string): bool = var s = s var L = y.len-1 while L >= 0: - if s == nil or y[L].cmpIgnoreStyle(s.name.s) != 0: return false + if s == nil or (y[L].cmpIgnoreStyle(s.name.s) != 0 and y[L] != "*"): + return false s = s.owner dec L result = true @@ -1591,7 +1636,8 @@ proc matches(s: PSym; y: varargs[string]): bool = var s = s var L = y.len-1 while L >= 0: - if s == nil or y[L].cmpIgnoreStyle(s.name.s) != 0: return false + if s == nil or (y[L].cmpIgnoreStyle(s.name.s) != 0 and y[L] != "*"): + return false s = if sfFromGeneric in s.flags: s.owner.owner else: s.owner dec L result = true @@ -1614,7 +1660,7 @@ proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = case s.kind of skVar, skForVar, skTemp, skLet, skParam, skResult: genRdVar(c, n, dest, flags) - of skProc, skConverter, skMacro, skTemplate, skMethod, skIterators: + of skProc, skConverter, skMacro, skTemplate, skMethod, skIterator: # 'skTemplate' is only allowed for 'getAst' support: if procIsCallback(c, s): discard elif sfImportc in s.flags: c.importcSym(n.info, s) @@ -1712,9 +1758,9 @@ proc gen(c: PCtx; n: PNode; dest: var TDest; flags: TGenFlags = {}) = of declarativeDefs: unused(n, dest) of nkLambdaKinds: - let s = n.sons[namePos].sym - discard genProc(c, s) - genLit(c, n.sons[namePos], dest) + #let s = n.sons[namePos].sym + #discard genProc(c, s) + genLit(c, newSymNode(n.sons[namePos].sym), dest) of nkChckRangeF, nkChckRange64, nkChckRange: let tmp0 = c.genx(n.sons[0]) diff --git a/compiler/vmhooks.nim b/compiler/vmhooks.nim index 576b0565f..3456e893b 100644 --- a/compiler/vmhooks.nim +++ b/compiler/vmhooks.nim @@ -55,9 +55,16 @@ template getX(k, field) {.immediate, dirty.} = result = s[i+a.rb+1].field proc getInt*(a: VmArgs; i: Natural): BiggestInt = getX(rkInt, intVal) +proc getBool*(a: VmArgs; i: Natural): bool = getInt(a, i) != 0 proc getFloat*(a: VmArgs; i: Natural): BiggestFloat = getX(rkFloat, floatVal) proc getString*(a: VmArgs; i: Natural): string = doAssert i < a.rc-1 let s = cast[seq[TFullReg]](a.slots) doAssert s[i+a.rb+1].kind == rkNode result = s[i+a.rb+1].node.strVal + +proc getNode*(a: VmArgs; i: Natural): PNode = + doAssert i < a.rc-1 + let s = cast[seq[TFullReg]](a.slots) + doAssert s[i+a.rb+1].kind == rkNode + result = s[i+a.rb+1].node diff --git a/compiler/vmops.nim b/compiler/vmops.nim index e1a0dfef8..d0b3119e2 100644 --- a/compiler/vmops.nim +++ b/compiler/vmops.nim @@ -13,7 +13,7 @@ from math import sqrt, ln, log10, log2, exp, round, arccos, arcsin, arctan, arctan2, cos, cosh, hypot, sinh, sin, tan, tanh, pow, trunc, floor, ceil, fmod -from os import getEnv, existsEnv, dirExists, fileExists +from os import getEnv, existsEnv, dirExists, fileExists, walkDir template mathop(op) {.immediate, dirty.} = registerCallback(c, "stdlib.math." & astToStr(op), `op Wrapper`) @@ -24,22 +24,27 @@ template osop(op) {.immediate, dirty.} = template systemop(op) {.immediate, dirty.} = registerCallback(c, "stdlib.system." & astToStr(op), `op Wrapper`) -template wrap1f(op) {.immediate, dirty.} = +template wrap1f_math(op) {.immediate, dirty.} = proc `op Wrapper`(a: VmArgs) {.nimcall.} = setResult(a, op(getFloat(a, 0))) mathop op -template wrap2f(op) {.immediate, dirty.} = +template wrap2f_math(op) {.immediate, dirty.} = proc `op Wrapper`(a: VmArgs) {.nimcall.} = setResult(a, op(getFloat(a, 0), getFloat(a, 1))) mathop op -template wrap1s(op) {.immediate, dirty.} = +template wrap1s_os(op) {.immediate, dirty.} = proc `op Wrapper`(a: VmArgs) {.nimcall.} = setResult(a, op(getString(a, 0))) osop op -template wrap2svoid(op) {.immediate, dirty.} = +template wrap1s_system(op) {.immediate, dirty.} = + proc `op Wrapper`(a: VmArgs) {.nimcall.} = + setResult(a, op(getString(a, 0))) + systemop op + +template wrap2svoid_system(op) {.immediate, dirty.} = proc `op Wrapper`(a: VmArgs) {.nimcall.} = op(getString(a, 0), getString(a, 1)) systemop op @@ -48,33 +53,42 @@ proc getCurrentExceptionMsgWrapper(a: VmArgs) {.nimcall.} = setResult(a, if a.currentException.isNil: "" else: a.currentException.sons[3].skipColon.strVal) +proc staticWalkDirImpl(path: string, relative: bool): PNode = + result = newNode(nkBracket) + for k, f in walkDir(path, relative): + result.add newTree(nkPar, newIntNode(nkIntLit, k.ord), + newStrNode(nkStrLit, f)) + proc registerAdditionalOps*(c: PCtx) = - wrap1f(sqrt) - wrap1f(ln) - wrap1f(log10) - wrap1f(log2) - wrap1f(exp) - wrap1f(round) - wrap1f(arccos) - wrap1f(arcsin) - wrap1f(arctan) - wrap2f(arctan2) - wrap1f(cos) - wrap1f(cosh) - wrap2f(hypot) - wrap1f(sinh) - wrap1f(sin) - wrap1f(tan) - wrap1f(tanh) - wrap2f(pow) - wrap1f(trunc) - wrap1f(floor) - wrap1f(ceil) - wrap2f(fmod) + wrap1f_math(sqrt) + wrap1f_math(ln) + wrap1f_math(log10) + wrap1f_math(log2) + wrap1f_math(exp) + wrap1f_math(round) + wrap1f_math(arccos) + wrap1f_math(arcsin) + wrap1f_math(arctan) + wrap2f_math(arctan2) + wrap1f_math(cos) + wrap1f_math(cosh) + wrap2f_math(hypot) + wrap1f_math(sinh) + wrap1f_math(sin) + wrap1f_math(tan) + wrap1f_math(tanh) + wrap2f_math(pow) + wrap1f_math(trunc) + wrap1f_math(floor) + wrap1f_math(ceil) + wrap2f_math(fmod) - wrap1s(getEnv) - wrap1s(existsEnv) - wrap1s(dirExists) - wrap1s(fileExists) - wrap2svoid(writeFile) + wrap1s_os(getEnv) + wrap1s_os(existsEnv) + wrap1s_os(dirExists) + wrap1s_os(fileExists) + wrap2svoid_system(writeFile) + wrap1s_system(readFile) systemop getCurrentExceptionMsg + registerCallback c, "stdlib.*.staticWalkDir", proc (a: VmArgs) {.nimcall.} = + setResult(a, staticWalkDirImpl(getString(a, 0), getBool(a, 1))) diff --git a/compiler/wordrecg.nim b/compiler/wordrecg.nim index 0a0534118..3e0e05a94 100644 --- a/compiler/wordrecg.nim +++ b/compiler/wordrecg.nim @@ -66,6 +66,7 @@ type wWrite, wGensym, wInject, wDirty, wInheritable, wThreadVar, wEmit, wAsmNoStackFrame, wImplicitStatic, wGlobal, wCodegenDecl, wUnchecked, wGuard, wLocks, + wPartial, wAuto, wBool, wCatch, wChar, wClass, wConst_cast, wDefault, wDelete, wDouble, wDynamic_cast, @@ -151,7 +152,7 @@ const "computedgoto", "injectstmt", "experimental", "write", "gensym", "inject", "dirty", "inheritable", "threadvar", "emit", "asmnostackframe", "implicitstatic", "global", "codegendecl", "unchecked", - "guard", "locks", + "guard", "locks", "partial", "auto", "bool", "catch", "char", "class", "const_cast", "default", "delete", "double", |